git.iko.soy/typeable/wai
on master help sign in
Merge pull request #435 from soenkehahn/soenkehahn/response-splitting

Sanitize header values to prevent response splitting

commitd289d1d72246872304950267507f8b91683fd4db authorKazu Yamamoto <kazu@iij.ad.jp> dateFri 18 Sep 2015, 12:01 (11 years ago) parentc477e9af962cea
3 files changed+51−25
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/Response.hs+22−22 warp/test/HTTP.hs+5 warp/test/ResponseSpec.hs+24−3
warp/Network/Wai/Handler/Warp/Response.hs+22−22
@@ -3,9 +3,11 @@
33{-# LANGUAGE TupleSections #-}
44{-# LANGUAGE RankNTypes #-}
55{-# LANGUAGE CPP #-}
6+{-# LANGUAGE ViewPatterns #-}
67
78module Network.Wai.Handler.Warp.Response (
89 sendResponse
10+ , sanitizeHeaderValue -- for testing
911 , fileRange -- for testing
1012 , warpVersion
1113 , defaultServerValue
@@ -27,13 +29,14 @@ import Control.Monad (unless, when)
2729import Data.Array ((!))
2830import Data.ByteString (ByteString)
2931import qualified Data.ByteString as S
32+import qualified Data.ByteString.Char8 as S8
3033import Data.ByteString.Builder (byteString, Builder)
3134import Data.ByteString.Builder.Extra (flush)
3235import qualified Data.ByteString.Char8 as B (pack)
3336import qualified Data.CaseInsensitive as CI
3437import Data.Function (on)
3538import Data.List (deleteBy)
36−import Data.Maybe (isJust, fromMaybe)
39+import Data.Maybe
3740#if MIN_VERSION_base(4,5,0)
3841# if __GLASGOW_HASKELL__ < 709
3942import Data.Monoid (mempty)
@@ -44,6 +47,7 @@ import Data.Monoid (mappend, mempty)
4447#endif
4548import Data.Streaming.Blaze (newBlazeRecv, reuseBufferStrategy)
4649import Data.Version (showVersion)
50+import Data.Word8 (_cr, _lf)
4751import qualified Network.HTTP.Types as H
4852import Network.Wai
4953import Network.Wai.Handler.Warp.Buffer (toBuilderBuffer)
@@ -143,26 +147,7 @@ sendResponse :: ByteString -- ^ default server value
143147 -> IO ByteString -- ^ source from client, for raw response
144148 -> Response -- ^ HTTP response including status code and response header.
145149 -> IO Bool -- ^ Returing True if the connection is persistent.
146−sendResponse defServer conn ii req reqidxhdr src response =
147− sendResponse' defServer conn ii req reqidxhdr src response'
148− where
149− doesContainCRLF :: [ByteString] -> Bool
150− doesContainCRLF = or . map (S.any (\w -> w == 10 || w == 13))
151− hsv = map snd $ responseHeaders response
152− response'
153− | doesContainCRLF hsv = response400
154− | otherwise = response
155− response400 = responseLBS H.badRequest400 [(H.hContentType, "text/plain; charset=utf-8")] "Bad Request"
156−
157−sendResponse' :: ByteString -- ^ default server value
158− -> Connection
159− -> InternalInfo
160− -> Request -- ^ HTTP request.
161− -> IndexedHeader -- ^ Indexed header of HTTP request.
162− -> IO ByteString -- ^ source from client, for raw response
163− -> Response -- ^ HTTP response including status code and response header.
164− -> IO Bool -- ^ Returing True if the connection is persistent.
165−sendResponse' defServer conn ii req reqidxhdr src response = do
150+sendResponse defServer conn ii req reqidxhdr src (sanitizeHeaders -> response) = do
166151 hs <- addServerAndDate hs0
167152 if hasBody s then do
168153 -- HEAD comes here even if it does not have body.
@@ -198,7 +183,22 @@ sendResponse' defServer conn ii req reqidxhdr src response = do
198183 ResponseStream {} -> isKeepAlive
199184 ResponseRaw {} -> False
200185
201−----------------------------------------------------------------
186+sanitizeHeaders :: Response -> Response
187+sanitizeHeaders = mapResponseHeaders (map (fmap sanitizeHeaderValue))
188+
189+sanitizeHeaderValue :: ByteString -> ByteString
190+sanitizeHeaderValue v
191+ | containsNewlines v = case S8.lines $ S.filter (/= _cr) v of
192+ x : xs -> S.intercalate "\r\n" (x : mapMaybe addSpaceIfMissing xs)
193+ [] -> ""
194+ | otherwise = v
195+ where
196+ containsNewlines = S.any (\w -> w == _cr || w == _lf)
197+ addSpaceIfMissing line = case S8.uncons line of
198+ Nothing -> Nothing
199+ Just (first, _) -> Just $ if first == ' ' || first == '\t'
200+ then line
201+ else " " <> line
202202
203203data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) Bool (IO ())
204204 | RspBuilder Builder Bool
warp/test/HTTP.hs+5
@@ -1,8 +1,11 @@
1+{-# LANGUAGE StandaloneDeriving #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
13module HTTP (
24 sendGET
35 , sendGETwH
46 , rspBody
57 , rspCode
8+ , rspHeaders
69 , getHeaderValue
710 , HeaderName(..)
811 ) where
@@ -27,3 +30,5 @@ getHeaderValue :: HasHeaders a => HeaderName -> a -> Maybe String
2730getHeaderValue key r = case retrieveHeaders key r of
2831 [] -> Nothing
2932 x:_ -> Just $ hdrValue x
33+
34+deriving instance Eq Header
warp/test/ResponseSpec.hs+24−3
@@ -85,11 +85,32 @@ testFileRange desc s rsphdr file mPart mRange ans = it desc $ do
8585spec :: Spec
8686spec = do
8787 describe "preventing response splitting attack" $ do
88− it "returns 400 if response headers contain illegal characters" $ do
89− let app _ f = f $ responseLBS status200 [("content-length", "20"),("foo", "foo\r\n\r\nbar\r\n")] "Hello"
88+ it "sanitizes header values" $ do
89+ let app _ respond = respond $ responseLBS status200 [("foo", "foo\r\nbar")] "Hello"
9090 withApp defaultSettings app $ \port -> do
9191 res <- sendGET $ "http://127.0.0.1:" ++ show port
92− rspCode res `shouldBe` (4,0,0)
92+ getHeaderValue (HdrCustom "foo") res `shouldBe`
93+ Just "foo bar" -- HTTP inserts two spaces for \r\n.
94+
95+ describe "sanitizeHeaderValue" $ do
96+ it "doesn't alter valid multiline header values" $ do
97+ sanitizeHeaderValue "foo\r\n bar" `shouldBe` "foo\r\n bar"
98+
99+ it "adds missing spaces after \r\n" $ do
100+ sanitizeHeaderValue "foo\r\nbar" `shouldBe` "foo\r\n bar"
101+
102+ it "discards empty lines" $ do
103+ sanitizeHeaderValue "foo\r\n\r\nbar" `shouldBe` "foo\r\n bar"
104+
105+ context "when sanitizing single occurences of \n" $ do
106+ it "replaces \n with \r\n" $ do
107+ sanitizeHeaderValue "foo\n bar" `shouldBe` "foo\r\n bar"
108+
109+ it "adds missing spaces after \n" $ do
110+ sanitizeHeaderValue "foo\nbar" `shouldBe` "foo\r\n bar"
111+
112+ it "discards single occurrences of \r" $ do
113+ sanitizeHeaderValue "foo\rbar" `shouldBe` "foobar"
93114
94115 describe "range requests" $ do
95116 testRange "2-3" "23" $ Just "2-3/16"