diff --git a/Network/Wai/Handler/Warp.hs b/Network/Wai/Handler/Warp.hs --- a/Network/Wai/Handler/Warp.hs +++ b/Network/Wai/Handler/Warp.hs @@ -58,6 +58,7 @@ , T.initialize #if TEST , takeHeaders + , parseFirst , readInt #endif ) where @@ -161,7 +162,7 @@ data Connection = Connection { connSendMany :: [B.ByteString] -> IO () , connSendAll :: B.ByteString -> IO () - , connSendFile :: FilePath -> Integer -> Integer -> IO () -> IO () -- ^ offset, length + , connSendFile :: FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO () -- ^ offset, length , connClose :: IO () , connRecv :: IO B.ByteString } @@ -170,7 +171,7 @@ socketConnection s = Connection { connSendMany = Sock.sendMany s , connSendAll = Sock.sendAll s - , connSendFile = \fp off len act -> sendfile s fp (PartOfFile off len) act + , connSendFile = \fp off len act hdr -> sendfileWithHeader s fp (PartOfFile off len) act hdr , connClose = sClose s , connRecv = Sock.recv s bytesPerRead } @@ -487,9 +488,10 @@ parseFirst :: ByteString -> ResourceT IO (ByteString, ByteString, ByteString, H.HttpVersion) parseFirst s = - case S.split 32 s of -- ' ' - [method, query, http'] -> do - let (hfirst, hsecond) = B.splitAt 5 http' + case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- ' ' + (method:query:http'') -> do + let http' = S.concat http'' + (hfirst, hsecond) = B.splitAt 5 http' if hfirst == "HTTP/" then let (rpath, qstring) = S.breakByte 63 query -- '?' hv = @@ -584,13 +586,12 @@ [("Content-Type", "text/plain")] "File not found" Right (lengthyHeaders, cl) -> liftIO $ do - let headers' = headers version s lengthyHeaders - sendHeader $ headers' False + let headers' = L.toChunks . toLazyByteString $ headers version s lengthyHeaders False T.tickle th if hasBody s req then do case mpart of - Nothing -> connSendFile conn fp 0 cl (T.tickle th) - Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th) + Nothing -> connSendFile conn fp 0 cl (T.tickle th) headers' + Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th) headers' T.tickle th return isPersist else @@ -649,11 +650,7 @@ parseHeaderNoAttr :: ByteString -> H.Header parseHeaderNoAttr s = let (k, rest) = S.breakByte 58 s -- ':' - restLen = S.length rest - -- FIXME check for colon without following space? - rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": " - then SU.unsafeDrop 2 rest - else rest + rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest in (CI.mk k, rest') connSource :: Connection -> T.Handle -> C.Source (ResourceT IO) ByteString @@ -756,8 +753,15 @@ prepend' = prepend . S.append bs status = THStatus len' lines prepend' in C.NeedInput (push status) close + -- Found a newline, but next line continues as a multiline header + Just (end, True) -> + let rest = S.drop (end + 1) bs + prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs) + len' = len + end + status = THStatus len' lines prepend' + in push status rest -- Found a newline at position end. - Just end -> + Just (end, False) -> let start = end + 1 -- start of next chunk line -- There were some bytes before the newline, get them @@ -786,7 +790,15 @@ else C.NeedInput (push status) close where bsLen = S.length bs - mnl = S.elemIndex 10 bs + mnl = do + nl <- S.elemIndex 10 bs + -- check if there are two more bytes in the bs + -- if so, see if the second of those is a horizontal space + if bsLen > nl + 1 + then + let c = S.index bs (nl + 1) + in Just (nl, c == 32 || c == 9) + else Just (nl, False) {-# INLINE takeHeaders #-} checkCR :: ByteString -> Int -> Int diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -147,6 +147,86 @@ it "ConnectionClosedByPeer" $ runTerminateTest ConnectionClosedByPeer "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r\nhello" it "IncompleteHeaders" $ runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n" + describe "special input" $ do + it "multiline headers" $ do + iheaders <- I.newIORef [] + port <- getPort + tid <- forkIO $ run port $ \req -> do + liftIO $ I.writeIORef iheaders $ requestHeaders req + return $ responseLBS status200 [] "" + threadDelay 1000 + handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port + let input = S.concat + [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n" + ] + hPutStr handle input + hFlush handle + hClose handle + threadDelay 1000 + killThread tid + headers <- I.readIORef iheaders + headers @?= + [ ("foo", "bar baz\tbin") + ] + it "no space between colon and value" $ do + iheaders <- I.newIORef [] + port <- getPort + tid <- forkIO $ run port $ \req -> do + liftIO $ I.writeIORef iheaders $ requestHeaders req + return $ responseLBS status200 [] "" + threadDelay 1000 + handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port + let input = S.concat + [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n" + ] + hPutStr handle input + hFlush handle + hClose handle + threadDelay 1000 + killThread tid + headers <- I.readIORef iheaders + headers @?= + [ ("foo", "bar") + ] + it "extra spaces in first line" $ do + iheaders <- I.newIORef [] + port <- getPort + tid <- forkIO $ run port $ \req -> do + liftIO $ I.writeIORef iheaders $ requestHeaders req + return $ responseLBS status200 [] "" + threadDelay 1000 + handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port + let input = S.concat + [ "GET / HTTP/1.1\r\nfoo: bar\r\n\r\n" + ] + hPutStr handle input + hFlush handle + hClose handle + threadDelay 1000 + killThread tid + headers <- I.readIORef iheaders + headers @?= + [ ("foo", "bar") + ] + it "spaces in http version" $ do + iversion <- I.newIORef $ error "Version not parsed" + port <- getPort + tid <- forkIO $ run port $ \req -> do + liftIO $ I.writeIORef iversion $ httpVersion req + return $ responseLBS status200 [] "" + threadDelay 1000 + handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port + let input = S.concat + [ "GET / HTTP\t/ 1 . 1 \r\nfoo: bar\r\n\r\n" + ] + hPutStr handle input + hFlush handle + hClose handle + threadDelay 1000 + killThread tid + version <- I.readIORef iversion + version @?= http11 + describe "chunked bodies" $ do it "works" $ do ifront <- I.newIORef id diff --git a/warp.cabal b/warp.cabal --- a/warp.cabal +++ b/warp.cabal @@ -1,5 +1,5 @@ Name: warp -Version: 1.2.1.1 +Version: 1.2.2 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE @@ -26,7 +26,7 @@ , blaze-builder-conduit >= 0.4 && < 0.5 , lifted-base >= 0.1 && < 0.2 , blaze-builder >= 0.2.1.4 && < 0.4 - , simple-sendfile >= 0.2.2 && < 0.3 + , simple-sendfile >= 0.2.4 && < 0.3 , http-types >= 0.6 && < 0.7 , case-insensitive >= 0.2 , unix-compat >= 0.2