warp 1.2.1.1 → 1.2.2
raw patch · 3 files changed
+110/−18 lines, 3 filesdep ~simple-sendfile
Dependency ranges changed: simple-sendfile
Files
- Network/Wai/Handler/Warp.hs +28/−16
- test/main.hs +80/−0
- warp.cabal +2/−2
Network/Wai/Handler/Warp.hs view
@@ -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
test/main.hs view
@@ -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
warp.cabal view
@@ -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