warp 3.0.4.1 → 3.0.5
raw patch · 6 files changed
+120/−11 lines, 6 filesdep +iproute
Dependencies added: iproute
Files
- ChangeLog.md +7/−0
- Network/Wai/Handler/Warp.hs +41/−0
- Network/Wai/Handler/Warp/Run.hs +54/−10
- Network/Wai/Handler/Warp/Settings.hs +13/−0
- Network/Wai/Handler/Warp/Types.hs +2/−0
- warp.cabal +3/−1
ChangeLog.md view
@@ -1,3 +1,10 @@+## 3.0.5++Support for PROXY protocol, such as used by Amazon ELB TCP. This is useful+since, for example, Amazon ELB HTTP does *not* have support for Websockets.+More information on the protocol [is available from+Amazon](http://docs.aws.amazon.com/ElasticLoadBalancing/latest/DeveloperGuide/TerminologyandKeyConcepts.html#proxy-protocol).+ ## 3.0.4 Added `setFork`.
Network/Wai/Handler/Warp.hs view
@@ -44,6 +44,9 @@ , setServerName , setMaximumBodyFlush , setFork+ , setProxyProtocolNone+ , setProxyProtocolRequired+ , setProxyProtocolOptional -- ** Getters , getPort , getHost@@ -241,3 +244,41 @@ -- Since 3.0.4 setFork :: (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> Settings -> Settings setFork fork' s = s { settingsFork = fork' }++-- | Do not use the PROXY protocol.+--+-- Since 3.0.5+setProxyProtocolNone :: Settings -> Settings+setProxyProtocolNone y = y { settingsProxyProtocol = ProxyProtocolNone }++-- | Require PROXY header.+--+-- This is for cases where a "dumb" TCP/SSL proxy is being used, which cannot+-- add an @X-Forwarded-For@ HTTP header field but has enabled support for the+-- PROXY protocol.+--+-- See <http://www.haproxy.org/download/1.5/doc/proxy-protocol.txt> and+-- <http://docs.aws.amazon.com/ElasticLoadBalancing/latest/DeveloperGuide/TerminologyandKeyConcepts.html#proxy-protocol>.+--+-- Only the human-readable header format (version 1) is supported. The binary+-- header format (version 2) is /not/ supported.+--+-- Since 3.0.5+setProxyProtocolRequired :: Settings -> Settings+setProxyProtocolRequired y = y { settingsProxyProtocol = ProxyProtocolRequired }++-- | Use the PROXY header if it exists, but also accept+-- connections without the header. See 'setProxyProtocolRequired'.+--+-- WARNING: This is contrary to the PROXY protocol specification and+-- using it can indicate a security problem with your+-- architecture if the web server is directly accessable+-- to the public, since it would allow easy IP address+-- spoofing. However, it can be useful in some cases,+-- such as if a load balancer health check uses regular+-- HTTP without the PROXY header, but proxied+-- connections /do/ include the PROXY header.+--+-- Since 3.0.5+setProxyProtocolOptional :: Settings -> Settings+setProxyProtocolOptional y = y { settingsProxyProtocol = ProxyProtocolOptional }
Network/Wai/Handler/Warp/Run.hs view
@@ -13,10 +13,12 @@ import Control.Monad (when, unless, void) import Data.ByteString (ByteString) import qualified Data.ByteString as S+import Data.Char (chr)+import Data.IP (toHostAddress, toHostAddress6) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Streaming.Network (bindPortTCP) import Network (sClose, Socket)-import Network.Socket (accept, withSocketsDo, SockAddr)+import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6)) import qualified Network.Socket.ByteString as Sock import Network.Wai import Network.Wai.Handler.Warp.Buffer@@ -24,6 +26,7 @@ import qualified Network.Wai.Handler.Warp.Date as D import qualified Network.Wai.Handler.Warp.FdCache as F import Network.Wai.Handler.Warp.Header+import Network.Wai.Handler.Warp.ReadInt import Network.Wai.Handler.Warp.Recv import Network.Wai.Handler.Warp.Request import Network.Wai.Handler.Warp.Response@@ -271,28 +274,69 @@ -> Settings -> Application -> IO ()-serveConnection conn ii addr isSecure' settings app = do+serveConnection conn ii origAddr isSecure' settings app = do istatus <- newIORef False src <- mkSource (connSource conn th istatus)- recvSendLoop istatus src `E.catch` \e -> do- sendErrorResponse istatus e+ addr <- getProxyProtocolAddr src+ recvSendLoop addr istatus src `E.catch` \e -> do+ sendErrorResponse addr istatus e throwIO (e :: SomeException) where+ getProxyProtocolAddr src =+ case settingsProxyProtocol settings of+ ProxyProtocolNone ->+ return origAddr+ ProxyProtocolRequired -> do+ seg <- readSource src+ parseProxyProtocolHeader src seg+ ProxyProtocolOptional -> do+ seg <- readSource src+ if S.isPrefixOf "PROXY " seg+ then parseProxyProtocolHeader src seg+ else do leftoverSource src seg+ return origAddr++ parseProxyProtocolHeader src seg = do+ let (header,seg') = S.break (== 0x0d) seg -- 0x0d == CR+ maybeAddr = case S.split 0x20 header of -- 0x20 == space+ ["PROXY","TCP4",clientAddr,_,clientPort,_] ->+ case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of+ [a] -> Just (SockAddrInet (readInt clientPort)+ (toHostAddress a))+ _ -> Nothing+ ["PROXY","TCP6",clientAddr,_,clientPort,_] ->+ case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of+ [a] -> Just (SockAddrInet6 (readInt clientPort)+ 0+ (toHostAddress6 a)+ 0)+ _ -> Nothing+ ("PROXY":"UNKNOWN":_) ->+ Just origAddr+ _ ->+ Nothing+ case maybeAddr of+ Nothing -> throwIO (BadProxyHeader (decodeAscii header))+ Just a -> do leftoverSource src (S.drop 2 seg') -- drop CRLF+ return a++ decodeAscii = map (chr . fromEnum) . S.unpack+ th = threadHandle ii - sendErrorResponse istatus e = do+ sendErrorResponse addr istatus e = do status <- readIORef istatus when status $ void $ sendResponse (settingsServerName settings)- conn ii dummyreq defaultIndexRequestHeader (return S.empty) (errorResponse e)+ conn ii (dummyreq addr) defaultIndexRequestHeader (return S.empty) (errorResponse e) - dummyreq = defaultRequest { remoteHost = addr }+ dummyreq addr = defaultRequest { remoteHost = addr } errorResponse e = settingsOnExceptionResponse settings e - recvSendLoop istatus fromClient = do+ recvSendLoop addr istatus fromClient = do (req', mremainingRef, idxhdr) <- recvRequest settings conn ii addr fromClient let req = req' { isSecure = isSecure' } -- Let the application run for as long as it wants@@ -333,14 +377,14 @@ Nothing -> do flushEntireBody (requestBody req) T.resume th- recvSendLoop istatus fromClient+ recvSendLoop addr istatus fromClient Just maxToRead -> do let tryKeepAlive = do -- flush the rest of the request body isComplete <- flushBody (requestBody req) maxToRead when isComplete $ do T.resume th- recvSendLoop istatus fromClient+ recvSendLoop addr istatus fromClient case mremainingRef of Just ref -> do remaining <- readIORef ref
Network/Wai/Handler/Warp/Settings.hs view
@@ -82,8 +82,20 @@ -- ^ See @setMaximumBodyFlush@. -- -- Since 3.0.3+ , settingsProxyProtocol :: ProxyProtocol+ -- ^ Specify usage of the PROXY protocol.+ --+ -- Since 3.0.5. } +-- | Specify usage of the PROXY protocol.+data ProxyProtocol = ProxyProtocolNone+ -- ^ See @setProxyProtocolNone@.+ | ProxyProtocolRequired+ -- ^ See @setProxyProtocolRequired@.+ | ProxyProtocolOptional+ -- ^ See @setProxyProtocolOptional@.+ -- | The default settings for the Warp server. See the individual settings for -- the default value. defaultSettings :: Settings@@ -103,6 +115,7 @@ , settingsInstallShutdownHandler = const $ return () , settingsServerName = S8.pack $ "Warp/" ++ showVersion Paths_warp.version , settingsMaximumBodyFlush = Just 8192+ , settingsProxyProtocol = ProxyProtocolNone } -- | Apply the logic provided by 'defaultExceptionHandler' to determine if an
Network/Wai/Handler/Warp/Types.hs view
@@ -47,6 +47,7 @@ | IncompleteHeaders | ConnectionClosedByPeer | OverLargeHeader+ | BadProxyHeader String deriving (Eq, Typeable) instance Show InvalidRequest where@@ -56,6 +57,7 @@ show IncompleteHeaders = "Warp: Request headers did not finish transmission" show ConnectionClosedByPeer = "Warp: Client closed connection prematurely" show OverLargeHeader = "Warp: Request headers too large, possible memory attack detected. Closing connection."+ show (BadProxyHeader s) = "Warp: Invalid PROXY protocol header: " ++ show s instance Exception InvalidRequest
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 3.0.4.1+Version: 3.0.5 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -35,6 +35,7 @@ , case-insensitive >= 0.2 , ghc-prim , http-types >= 0.8.5+ , iproute >= 1.3.1 , simple-sendfile >= 0.2.7 && < 0.3 , unix-compat >= 0.2 , void@@ -117,6 +118,7 @@ , ghc-prim , HTTP , http-types >= 0.8.4+ , iproute >= 1.3.1 , lifted-base >= 0.1 , simple-sendfile >= 0.2.4 && < 0.3 , transformers >= 0.2.2