8f3bc4a · typeable/wai

git.iko.soy/typeable/wai

warp supports the PROXY protocol

commit8f3bc4aa33c8e87e0beaa24c38f0424008edb673 authorEmanuel Borsboom <manny@fpcomplete.com> dateSun 21 Dec 2014, 04:44 (12 years ago) parent606bad0

5 files changed+106−11

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp.hs+35 warp/Network/Wai/Handler/Warp/Run.hs+54−10 warp/Network/Wai/Handler/Warp/Settings.hs+13 warp/Network/Wai/Handler/Warp/Types.hs+2 warp/warp.cabal+2−1

warp/Network/Wai/Handler/Warp.hs+35

@@ -44,6 +44,9 @@ module Network.Wai.Handler.Warp (

4444 , setServerName

4545 , setMaximumBodyFlush

4646 , setFork

47+ , setProxyProtocolNone

48+ , setProxyProtocolRequired

49+ , setProxyProtocolOptional

4750 -- ** Getters

4851 , getPort

4952 , getHost

@@ -241,3 +244,35 @@ setMaximumBodyFlush x y

241244-- Since 3.0.4

242245setFork :: (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> Settings -> Settings

243246setFork fork' s = s { settingsFork = fork' }

247+

248+-- | Do not use the PROXY protocol.

249+setProxyProtocolNone :: Settings -> Settings

250+setProxyProtocolNone y = y { settingsProxyProtocol = ProxyProtocolNone }

251+

252+-- | Require PROXY header.

253+--

254+-- This is for cases where a "dumb" TCP/SSL proxy is being used, which cannot

255+-- add an @X-Forwarded-For@ HTTP header field but has enabled support for the

256+-- PROXY protocol.

257+--

258+-- See <http://www.haproxy.org/download/1.5/doc/proxy-protocol.txt> and

259+-- <http://docs.aws.amazon.com/ElasticLoadBalancing/latest/DeveloperGuide/TerminologyandKeyConcepts.html#proxy-protocol>.

260+--

261+-- Only the human-readable header format (version 1) is supported. The binary

262+-- header format (version 2) is /not/ supported.

263+setProxyProtocolRequired :: Settings -> Settings

264+setProxyProtocolRequired y = y { settingsProxyProtocol = ProxyProtocolRequired }

265+

266+-- | Use the PROXY header if it exists, but also accept

267+-- connections without the header. See 'setProxyProtocolRequired'.

268+--

269+-- WARNING: This is contrary to the PROXY protocol specification and

270+-- using it can indicate a security problem with your

271+-- architecture if the web server is directly accessable

272+-- to the public, since it would allow easy IP address

273+-- spoofing. However, it can be useful in some cases,

274+-- such as if a load balancer health check uses regular

275+-- HTTP without the PROXY header, but proxied

276+-- connections /do/ include the PROXY header.

277+setProxyProtocolOptional :: Settings -> Settings

278+setProxyProtocolOptional y = y { settingsProxyProtocol = ProxyProtocolOptional }

warp/Network/Wai/Handler/Warp/Run.hs+54−10

@@ -13,10 +13,12 @@ import Control.Exception as E

1313import Control.Monad (when, unless, void)

1414import Data.ByteString (ByteString)

1515import qualified Data.ByteString as S

16+import Data.Char (chr)

17+import Data.IP (toHostAddress, toHostAddress6)

1618import Data.IORef (IORef, newIORef, readIORef, writeIORef)

1719import Data.Streaming.Network (bindPortTCP)

1820import Network (sClose, Socket)

19−import Network.Socket (accept, withSocketsDo, SockAddr)

21+import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6))

2022import qualified Network.Socket.ByteString as Sock

2123import Network.Wai

2224import Network.Wai.Handler.Warp.Buffer

@@ -24,6 +26,7 @@ import Network.Wai.Handler.Warp.Counter

2426import qualified Network.Wai.Handler.Warp.Date as D

2527import qualified Network.Wai.Handler.Warp.FdCache as F

2628import Network.Wai.Handler.Warp.Header

29+import Network.Wai.Handler.Warp.ReadInt

2730import Network.Wai.Handler.Warp.Recv

2831import Network.Wai.Handler.Warp.Request

2932import Network.Wai.Handler.Warp.Response

@@ -271,28 +274,69 @@ serveConnection :: Connection

271274 -> Settings

272275 -> Application

273276 -> IO ()

274−serveConnection conn ii addr isSecure' settings app = do

277+serveConnection conn ii origAddr isSecure' settings app = do

275278 istatus <- newIORef False

276279 src <- mkSource (connSource conn th istatus)

277− recvSendLoop istatus src `E.catch` \e -> do

278− sendErrorResponse istatus e

280+ addr <- getProxyProtocolAddr src

281+ recvSendLoop addr istatus src `E.catch` \e -> do

282+ sendErrorResponse addr istatus e

279283 throwIO (e :: SomeException)

280284

281285 where

286+ getProxyProtocolAddr src =

287+ case settingsProxyProtocol settings of

288+ ProxyProtocolNone ->

289+ return origAddr

290+ ProxyProtocolRequired -> do

291+ seg <- readSource src

292+ parseProxyProtocolHeader src seg

293+ ProxyProtocolOptional -> do

294+ seg <- readSource src

295+ if S.isPrefixOf "PROXY " seg

296+ then parseProxyProtocolHeader src seg

297+ else do leftoverSource src seg

298+ return origAddr

299+

300+ parseProxyProtocolHeader src seg = do

301+ let (header,seg') = S.break (== 0x0d) seg -- 0x0d == CR

302+ maybeAddr = case S.split 0x20 header of -- 0x20 == space

303+ ["PROXY","TCP4",clientAddr,_,clientPort,_] ->

304+ case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of

305+ [a] -> Just (SockAddrInet (readInt clientPort)

306+ (toHostAddress a))

307+ _ -> Nothing

308+ ["PROXY","TCP6",clientAddr,_,clientPort,_] ->

309+ case [x | (x, t) <- reads (decodeAscii clientAddr), null t] of

310+ [a] -> Just (SockAddrInet6 (readInt clientPort)

311+ 0

312+ (toHostAddress6 a)

313+ 0)

314+ _ -> Nothing

315+ ("PROXY":"UNKNOWN":_) ->

316+ Just origAddr

317+ _ ->

318+ Nothing

319+ case maybeAddr of

320+ Nothing -> throwIO (BadProxyHeader (decodeAscii header))

321+ Just a -> do leftoverSource src (S.drop 2 seg') -- drop CRLF

322+ return a

323+

324+ decodeAscii = map (chr . fromEnum) . S.unpack

325+

282326 th = threadHandle ii

283327

284− sendErrorResponse istatus e = do

328+ sendErrorResponse addr istatus e = do

285329 status <- readIORef istatus

286330 when status $ void $

287331 sendResponse

288332 (settingsServerName settings)

289− conn ii dummyreq defaultIndexRequestHeader (return S.empty) (errorResponse e)

333+ conn ii (dummyreq addr) defaultIndexRequestHeader (return S.empty) (errorResponse e)

290334

291− dummyreq = defaultRequest { remoteHost = addr }

335+ dummyreq addr = defaultRequest { remoteHost = addr }

292336

293337 errorResponse e = settingsOnExceptionResponse settings e

294338

295− recvSendLoop istatus fromClient = do

339+ recvSendLoop addr istatus fromClient = do

296340 (req', mremainingRef, idxhdr) <- recvRequest settings conn ii addr fromClient

297341 let req = req' { isSecure = isSecure' }

298342 -- Let the application run for as long as it wants

@@ -333,14 +377,14 @@ serveConnection conn ii addr isSecure' settings app = do

333377 Nothing -> do

334378 flushEntireBody (requestBody req)

335379 T.resume th

336− recvSendLoop istatus fromClient

380+ recvSendLoop addr istatus fromClient

337381 Just maxToRead -> do

338382 let tryKeepAlive = do

339383 -- flush the rest of the request body

340384 isComplete <- flushBody (requestBody req) maxToRead

341385 when isComplete $ do

342386 T.resume th

343− recvSendLoop istatus fromClient

387+ recvSendLoop addr istatus fromClient

344388 case mremainingRef of

345389 Just ref -> do

346390 remaining <- readIORef ref

warp/Network/Wai/Handler/Warp/Settings.hs+13

@@ -82,8 +82,20 @@ data Settings = Settings

8282 -- ^ See @setMaximumBodyFlush@.

8383 --

8484 -- Since 3.0.3

85+ , settingsProxyProtocol :: ProxyProtocol

86+ -- ^ Specify usage of the PROXY protocol.

87+ --

88+ -- Since 3.0.5.

8589 }

8690

91+-- | Specify usage of the PROXY protocol.

92+data ProxyProtocol = ProxyProtocolNone

93+ -- ^ See @setProxyProtocolNone@.

94+ | ProxyProtocolRequired

95+ -- ^ See @setProxyProtocolRequired@.

96+ | ProxyProtocolOptional

97+ -- ^ See @setProxyProtocolOptional@.

98+

8799-- | The default settings for the Warp server. See the individual settings for

88100-- the default value.

89101defaultSettings :: Settings

@@ -103,6 +115,7 @@ defaultSettings = Settings

103115 , settingsInstallShutdownHandler = const $ return ()

104116 , settingsServerName = S8.pack $ "Warp/" ++ showVersion Paths_warp.version

105117 , settingsMaximumBodyFlush = Just 8192

118+ , settingsProxyProtocol = ProxyProtocolNone

106119 }

107120

108121-- | Apply the logic provided by 'defaultExceptionHandler' to determine if an

warp/Network/Wai/Handler/Warp/Types.hs+2

@@ -47,6 +47,7 @@ data InvalidRequest = NotEnoughLines [String]

4747 | IncompleteHeaders

4848 | ConnectionClosedByPeer

4949 | OverLargeHeader

50+ | BadProxyHeader String

5051 deriving (Eq, Typeable)

5152

5253instance Show InvalidRequest where

@@ -56,6 +57,7 @@ instance Show InvalidRequest where

5657 show IncompleteHeaders = "Warp: Request headers did not finish transmission"

5758 show ConnectionClosedByPeer = "Warp: Client closed connection prematurely"

5859 show OverLargeHeader = "Warp: Request headers too large, possible memory attack detected. Closing connection."

60+ show (BadProxyHeader s) = "Warp: Invalid PROXY protocol header: " ++ show s

5961

6062instance Exception InvalidRequest

6163

warp/warp.cabal+2−1

@@ -1,5 +1,5 @@

11Name: warp

2−Version: 3.0.4.1

2+Version: 3.0.5

33Synopsis: A fast, light-weight web server for WAI applications.

44License: MIT

55License-file: LICENSE

@@ -35,6 +35,7 @@ Library

3535 , case-insensitive >= 0.2

3636 , ghc-prim

3737 , http-types >= 0.8.5

38+ , iproute >= 1.3.1

3839 , simple-sendfile >= 0.2.7 && < 0.3

3940 , unix-compat >= 0.2

4041 , void