dc4697c · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Multiline HTTP headers (#76)

dc4697cMichael Snoyman14 years ago

warp/Network/Wai/Handler/Warp.hs+20−8

compare with master

unifiedsplit

@@ -58,6 +58,7 @@ module Network.Wai.Handler.Warp

58 , T.initialize

59#if TEST

60 , takeHeaders

61+ , parseFirst

61 , readInt

62 , readInt

62#endif

63#endif

63 ) where

64 ) where

@@ -487,7 +488,7 @@ takeUntil c bs =

487parseFirst :: ByteString

488parseFirst :: ByteString

488 -> ResourceT IO (ByteString, ByteString, ByteString, H.HttpVersion)

489 -> ResourceT IO (ByteString, ByteString, ByteString, H.HttpVersion)

489parseFirst s =

490parseFirst s =

490− case S.split 32 s of -- ' '

491+ case filter (not . S.null) $ S.split 32 s of -- ' '

491 [method, query, http'] -> do

492 [method, query, http'] -> do

492 let (hfirst, hsecond) = B.splitAt 5 http'

493 let (hfirst, hsecond) = B.splitAt 5 http'

493 if hfirst == "HTTP/"

494 if hfirst == "HTTP/"

@@ -649,11 +650,7 @@ fmap2 _ (C.Done i x) = C.Done i x

649parseHeaderNoAttr :: ByteString -> H.Header

650parseHeaderNoAttr :: ByteString -> H.Header

650parseHeaderNoAttr s =

651parseHeaderNoAttr s =

651 let (k, rest) = S.breakByte 58 s -- ':'

652 let (k, rest) = S.breakByte 58 s -- ':'

652− restLen = S.length rest

653+ rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest

653− -- FIXME check for colon without following space?

654− rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": "

655− then SU.unsafeDrop 2 rest

656− else rest

657 in (CI.mk k, rest')

654 in (CI.mk k, rest')

658

655

659connSource :: Connection -> T.Handle -> C.Source (ResourceT IO) ByteString

656connSource :: Connection -> T.Handle -> C.Source (ResourceT IO) ByteString

@@ -756,8 +753,15 @@ takeHeaders =

756 prepend' = prepend . S.append bs

753 prepend' = prepend . S.append bs

757 status = THStatus len' lines prepend'

754 status = THStatus len' lines prepend'

758 in C.NeedInput (push status) close

755 in C.NeedInput (push status) close

756+ -- Found a newline, but next line continues as a multiline header

757+ Just (end, True) ->

758+ let rest = S.drop (end + 1) bs

759+ prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs)

760+ len' = len + end

761+ status = THStatus len' lines prepend'

762+ in push status rest

759 -- Found a newline at position end.

763 -- Found a newline at position end.

760− Just end ->

764+ Just (end, False) ->

761 let start = end + 1 -- start of next chunk

765 let start = end + 1 -- start of next chunk

762 line

766 line

763 -- There were some bytes before the newline, get them

767 -- There were some bytes before the newline, get them

@@ -786,7 +790,15 @@ takeHeaders =

786 else C.NeedInput (push status) close

790 else C.NeedInput (push status) close

787 where

791 where

788 bsLen = S.length bs

792 bsLen = S.length bs

793+ mnl = do

789− mnl = S.elemIndex 10 bs

794+ nl <- S.elemIndex 10 bs

795+ -- check if there are two more bytes in the bs

796+ -- if so, see if the second of those is a horizontal space

797+ if bsLen > nl + 1

798+ then

799+ let c = S.index bs (nl + 1)

800+ in Just (nl, c == 32 || c == 9)

801+ else Just (nl, False)

790{-# INLINE takeHeaders #-}

802{-# INLINE takeHeaders #-}

791

803

792checkCR :: ByteString -> Int -> Int

804checkCR :: ByteString -> Int -> Int

warp/test/main.hs+62

@@ -147,6 +147,68 @@ main = hspecX $ do

147 it "ConnectionClosedByPeer" $ runTerminateTest ConnectionClosedByPeer "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r\nhello"

148 it "IncompleteHeaders" $ runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n"

149

150+ describe "special input" $ do

151+ it "multiline headers" $ do

152+ iheaders <- I.newIORef []

153+ port <- getPort

154+ tid <- forkIO $ run port $ \req -> do

155+ liftIO $ I.writeIORef iheaders $ requestHeaders req

156+ return $ responseLBS status200 [] ""

157+ threadDelay 1000

158+ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port

159+ let input = S.concat

160+ [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n"

161+ ]

162+ hPutStr handle input

163+ hFlush handle

164+ hClose handle

165+ threadDelay 1000

166+ killThread tid

167+ headers <- I.readIORef iheaders

168+ headers @?=

169+ [ ("foo", "bar baz\tbin")

170+ ]

171+ it "no space between colon and value" $ do

172+ iheaders <- I.newIORef []

173+ port <- getPort

174+ tid <- forkIO $ run port $ \req -> do

175+ liftIO $ I.writeIORef iheaders $ requestHeaders req

176+ return $ responseLBS status200 [] ""

177+ threadDelay 1000

178+ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port

179+ let input = S.concat

180+ [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"

181+ ]

182+ hPutStr handle input

183+ hFlush handle

184+ hClose handle

185+ threadDelay 1000

186+ killThread tid

187+ headers <- I.readIORef iheaders

188+ headers @?=

189+ [ ("foo", "bar")

190+ ]

191+ it "extra spaces in first line" $ do

192+ iheaders <- I.newIORef []

193+ port <- getPort

194+ tid <- forkIO $ run port $ \req -> do

195+ liftIO $ I.writeIORef iheaders $ requestHeaders req

196+ return $ responseLBS status200 [] ""

197+ threadDelay 1000

198+ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port

199+ let input = S.concat

200+ [ "GET / HTTP/1.1\r\nfoo: bar\r\n\r\n"

201+ ]

202+ hPutStr handle input

203+ hFlush handle

204+ hClose handle

205+ threadDelay 1000

206+ killThread tid

207+ headers <- I.readIORef iheaders

208+ headers @?=

209+ [ ("foo", "bar")

210+ ]

211+

150 describe "chunked bodies" $ do

212 describe "chunked bodies" $ do

151 it "works" $ do

213 it "works" $ do

152 ifront <- I.newIORef id

214 ifront <- I.newIORef id