warp 3.3.0 → 3.3.1
raw patch · 6 files changed
+85/−72 lines, 6 files
Files
- ChangeLog.md +6/−0
- Network/Wai/Handler/Warp/Recv.hs +12/−3
- Network/Wai/Handler/Warp/Run.hs +18/−7
- test/ResponseSpec.hs +10/−14
- test/RunSpec.hs +38/−47
- warp.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,9 @@+## 3.3.1++* Using gracefullClose of network 3.1.1 or later if available.+* If the first line of an HTTP request is really invalid,+ don't send an error response+ ## 3.3.0 * Switching from the original implementation to HTTP/2 server library.
Network/Wai/Handler/Warp/Recv.hs view
@@ -17,7 +17,12 @@ import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (Ptr, castPtr, plusPtr) import GHC.Conc (threadWaitRead)-import Network.Socket (Socket, fdSocket)+import Network.Socket (Socket)+#if MIN_VERSION_network(3,1,0)+import Network.Socket (withFdSocket)+#else+import Network.Socket (fdSocket)+#endif import System.Posix.Types (Fd(..)) import Network.Wai.Handler.Warp.Buffer@@ -91,7 +96,9 @@ receive :: Socket -> BufferPool -> Recv receive sock pool = withBufferPool pool $ \ (ptr, size) -> do-#if MIN_VERSION_network(3,0,0)+#if MIN_VERSION_network(3,1,0)+ withFdSocket sock $ \fd -> do+#elif MIN_VERSION_network(3,0,0) fd <- fdSocket sock #else let fd = fdSocket sock@@ -101,7 +108,9 @@ receiveBuf :: Socket -> RecvBuf receiveBuf sock buf0 siz0 = do-#if MIN_VERSION_network(3,0,0)+#if MIN_VERSION_network(3,1,0)+ withFdSocket sock $ \fd -> do+#elif MIN_VERSION_network(3,0,0) fd <- fdSocket sock #else let fd = fdSocket sock
Network/Wai/Handler/Warp/Run.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} module Network.Wai.Handler.Warp.Run where@@ -22,6 +23,9 @@ import GHC.IO.Exception (IOException(..)) import qualified Network.HTTP2 as H2 import Network.Socket (Socket, close, accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6), setSocketOption, SocketOption(..))+#if MIN_VERSION_network(3,1,1)+import Network.Socket (gracefulClose)+#endif import qualified Network.Socket.ByteString as Sock import Network.Wai import Network.Wai.Internal (ResponseReceived (ResponseReceived))@@ -63,7 +67,11 @@ connSendMany = Sock.sendMany s , connSendAll = sendall , connSendFile = sendFile s writeBuf bufferSize sendall+#if MIN_VERSION_network(3,1,1)+ , connClose = gracefulClose s 5000+#else , connClose = close s+#endif , connFree = freeBuffer writeBuf , connRecv = receive s bufferPool , connRecvBuf = receiveBuf s@@ -343,13 +351,16 @@ leftoverSource src bs addr <- getProxyProtocolAddr src http1 True addr istatus src `E.catch` \e ->- case fromException e of- -- See comment below referencing- -- https://github.com/yesodweb/wai/issues/618- Just NoKeepAliveRequest -> return ()- Nothing -> do- _ <- sendErrorResponse (dummyreq addr) istatus e- throwIO e+ case () of+ ()+ -- See comment below referencing+ -- https://github.com/yesodweb/wai/issues/618+ | Just NoKeepAliveRequest <- fromException e -> return ()+ -- No valid request+ | Just (BadFirstLine _) <- fromException e -> return ()+ | otherwise -> do+ _ <- sendErrorResponse (dummyreq addr) istatus e+ throwIO e where getProxyProtocolAddr src =
test/ResponseSpec.hs view
@@ -10,7 +10,7 @@ import Network.Wai hiding (responseHeaders) import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp.Response-import RunSpec (withApp, msClose, msWrite, msRead, connectTo)+import RunSpec (withApp, msWrite, msRead, withMySocket) import Test.Hspec main :: IO ()@@ -20,15 +20,13 @@ -> String -- ^ expected output -> Maybe String -- ^ expected content-range value -> Spec-testRange range out crange = it title $ withApp defaultSettings app $ \port -> do- handle <- connectTo port- msWrite handle "GET / HTTP/1.0\r\n"- msWrite handle "Range: bytes="- msWrite handle range- msWrite handle "\r\n\r\n"+testRange range out crange = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do+ msWrite ms "GET / HTTP/1.0\r\n"+ msWrite ms "Range: bytes="+ msWrite ms range+ msWrite ms "\r\n\r\n" threadDelay 10000- bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead handle 1024- msClose handle+ bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024 last bss `shouldBe` out let hs = mapMaybe toHeader bss lookup "Content-Range" hs `shouldBe` fmap ("bytes " ++) crange@@ -46,12 +44,10 @@ -> Integer -- ^ byte count -> String -- ^ expected output -> Spec-testPartial size offset count out = it title $ withApp defaultSettings app $ \port -> do- handle <- connectTo port- msWrite handle "GET / HTTP/1.0\r\n\r\n"+testPartial size offset count out = it title $ withApp defaultSettings app $ withMySocket $ \ms -> do+ msWrite ms "GET / HTTP/1.0\r\n\r\n" threadDelay 10000- bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead handle 1024- msClose handle+ bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ msRead ms 1024 out `shouldBe` last bss let hs = mapMaybe toHeader bss lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss)
test/RunSpec.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module RunSpec (main, spec, withApp, connectTo, MySocket, msWrite, msRead, msClose) where+module RunSpec (main, spec, withApp, MySocket, msWrite, msRead, withMySocket) where import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)@@ -37,7 +37,7 @@ data MySocket = MySocket { msSocket :: !Socket- , _msBuffer :: !(I.IORef ByteString)+ , msBuffer :: !(I.IORef ByteString) } msWrite :: MySocket -> ByteString -> IO ()@@ -70,10 +70,17 @@ msClose = Network.Socket.close . msSocket connectTo :: Int -> IO MySocket-connectTo port = MySocket- <$> (fst <$> getSocketTCP "127.0.0.1" port)- <*> I.newIORef mempty+connectTo port = do+ s <- fst <$> getSocketTCP "127.0.0.1" port+ ref <- I.newIORef mempty+ return MySocket {+ msSocket = s+ , msBuffer = ref+ } +withMySocket :: (MySocket -> IO a) -> Int -> IO a+withMySocket body port = bracket (connectTo port) msClose body+ incr :: MonadIO m => Counter -> m () incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount -> ((case ecount of@@ -150,8 +157,7 @@ -> IO () runTest expected app chunks = do ref <- I.newIORef (Right 0)- withApp defaultSettings (app ref) $ \port -> do- ms <- connectTo port+ withApp defaultSettings (app ref) $ withMySocket $ \ms -> do forM_ chunks $ \chunk -> msWrite ms chunk _ <- timeout 100000 $ replicateM_ expected $ msRead ms 4096 res <- I.readIORef ref@@ -168,10 +174,9 @@ runTerminateTest expected input = do ref <- I.newIORef Nothing let onExc _ = I.writeIORef ref . Just- withApp (setOnException onExc defaultSettings) dummyApp $ \port -> do- handle <- connectTo port- msWrite handle input- msClose handle+ withApp (setOnException onExc defaultSettings) dummyApp $ withMySocket $ \ms -> do+ msWrite ms input+ msClose ms -- explicitly threadDelay 1000 res <- I.readIORef ref show res `shouldBe` show (Just expected)@@ -242,13 +247,11 @@ let app req f = do liftIO $ I.writeIORef iheaders $ requestHeaders req f $ responseLBS status200 [] ""- withApp defaultSettings app $ \port -> do- handle <- connectTo port+ withApp defaultSettings app $ withMySocket $ \ms -> do let input = S.concat [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n" ]- msWrite handle input- msClose handle+ msWrite ms input threadDelay 1000 headers <- I.readIORef iheaders headers `shouldBe`@@ -259,13 +262,11 @@ let app req f = do liftIO $ I.writeIORef iheaders $ requestHeaders req f $ responseLBS status200 [] ""- withApp defaultSettings app $ \port -> do- handle <- connectTo port+ withApp defaultSettings app $ withMySocket $ \ms -> do let input = S.concat [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n" ]- msWrite handle input- msClose handle+ msWrite ms input threadDelay 1000 headers <- I.readIORef iheaders headers `shouldBe`@@ -281,16 +282,14 @@ liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ()) atomically $ modifyTVar countVar (+ 1) f $ responseLBS status200 [] ""- withApp defaultSettings app $ \port -> do- handle <- connectTo port+ withApp defaultSettings app $ withMySocket $ \ms -> do let input = S.concat [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n" , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n" , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n" , "b\r\nHello World\r\n0\r\n\r\n" ]- msWrite handle input- msClose handle+ msWrite ms input atomically $ do count <- readTVar countVar check $ count == 2@@ -307,14 +306,12 @@ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ()) atomically $ modifyTVar countVar (+ 1) f $ responseLBS status200 [] ""- withApp defaultSettings app $ \port -> do- handle <- connectTo port+ withApp defaultSettings app $ withMySocket $ \ms -> do let input = concat $ replicate 2 $ ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++ (replicate 50 "5\r\n12345\r\n") ++ ["0\r\n\r\n"]- mapM_ (msWrite handle) input- msClose handle+ mapM_ (msWrite ms) input atomically $ do count <- readTVar countVar check $ count == 2@@ -330,16 +327,14 @@ liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ()) atomically $ modifyTVar countVar (+ 1) f $ responseLBS status200 [] ""- withApp defaultSettings app $ \port -> do- handle <- connectTo port+ withApp defaultSettings app $ withMySocket $ \ms -> do let input = S.concat [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n" , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n" , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n" , "b\r\nHello World\r\n0\r\n\r\n" ]- mapM_ (msWrite handle) $ map S.singleton $ S.unpack input- msClose handle+ mapM_ (msWrite ms) $ map S.singleton $ S.unpack input atomically $ do count <- readTVar countVar check $ count == 2@@ -360,20 +355,18 @@ E.throwIO (e :: E.SomeException) liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ()) f $ responseLBS status200 [] ""- withApp (setTimeout 1 defaultSettings) app $ \port -> do+ withApp (setTimeout 1 defaultSettings) app $ withMySocket $ \ms -> do let bs1 = S.replicate 2048 88 bs2 = "This is short" bs = S.append bs1 bs2- handle <- connectTo port- msWrite handle "POST / HTTP/1.1\r\n"- msWrite handle "content-length: "- msWrite handle $ S8.pack $ show $ S.length bs- msWrite handle "\r\n\r\n"+ msWrite ms "POST / HTTP/1.1\r\n"+ msWrite ms "content-length: "+ msWrite ms $ S8.pack $ show $ S.length bs+ msWrite ms "\r\n\r\n" threadDelay 100000- msWrite handle bs1+ msWrite ms bs1 threadDelay 100000- msWrite handle bs2- msClose handle+ msWrite ms bs2 threadDelay 5000000 front <- I.readIORef ifront S.concat (front []) `shouldBe` bs@@ -389,8 +382,7 @@ loop loop doubleBS = S.concatMap $ \w -> S.pack [w, w]- withApp defaultSettings app $ \port -> do- ms <- connectTo port+ withApp defaultSettings app $ withMySocket $ \ms -> do msWrite ms "POST / HTTP/1.1\r\n\r\n12345" timeout 100000 (msRead ms 10) >>= (`shouldBe` Just "1122334455") msWrite ms "67890"@@ -418,15 +410,14 @@ atomically $ modifyTVar countVar (+ 1) loop loop- withApp defaultSettings app $ \port -> do- (sock, _addr) <- getSocketTCP "127.0.0.1" port- sendAll sock "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"+ withApp defaultSettings app $ withMySocket $ \ms -> do+ msWrite ms "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n" threadDelay 10000- sendAll sock "5\r\nhello\r\n0\r\n\r\n"+ msWrite ms "5\r\nhello\r\n0\r\n\r\n" atomically $ do count <- readTVar countVar check $ count >= 1- bs <- safeRecv sock 4096+ bs <- safeRecv (msSocket ms) 4096 -- must not use msRead S.takeWhile (/= 13) bs `shouldBe` "HTTP/1.1 200 OK" it "streaming response with length" $ do
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 3.3.0+Version: 3.3.1 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE