c6c41ac · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Better protection in getLen function

c6c41acMichael Snoyman14 years ago

warp/Network/Wai/Handler/Warp.hs+27−13

compare with master

unifiedsplit

@@ -403,12 +403,15 @@ chunkedSource ipair = do

403 (src, mlen) <- liftIO $ I.readIORef ipair

404 go src mlen

405 where

406+ go' src front = do

407+ (src', (len, bs)) <- lift $ src C.$$+ front getLen

408+ let src''

409+ | S.null bs = src'

410+ | otherwise = C.yield bs >> src'

411+ go src'' $ HaveLen len

412+

406− go src NeedLen = do

413+ go src NeedLen = go' src id

407− (src', len) <- lift $ src C.$$+ getLen

408− go src' $ HaveLen len

409− go src NeedLenNewline = do

414+ go src NeedLenNewline = go' src (CB.take 2 >>)

410− (src', len) <- lift $ src C.$$+ (CB.take 2 >> getLen)

411− go src' $ HaveLen len

412 go src (HaveLen 0) = liftIO $ I.writeIORef ipair (src, HaveLen 0)

415 go src (HaveLen 0) = liftIO $ I.writeIORef ipair (src, HaveLen 0)

413 go src (HaveLen len) = do

416 go src (HaveLen len) = do

414 (src', mbs) <- lift $ src C.$$+ CL.head

417 (src', mbs) <- lift $ src C.$$+ CL.head

@@ -430,14 +433,25 @@ chunkedSource ipair = do

430 C.yield bs

433 C.yield bs

431 go src mlen

434 go src mlen

432

435

433− getLen :: MonadIO m => C.Sink ByteString m Word

436+ getLen :: Monad m => C.Sink ByteString m (Word, ByteString)

434 getLen = do

437 getLen = do

435− bss <- CB.takeWhile (/= 10) C.=$ CL.consume -- FIXME avoid attack

438+ mbs <- CL.head

436− _ <- CB.take 1

439+ case mbs of

437− return $

440+ Nothing -> return (0, S.empty)

441+ Just bs -> do

442+ (x, y) <-

443+ case S.breakByte 10 bs of

444+ (x, y)

445+ | S.null y -> do

446+ mbs2 <- CL.head

447+ case mbs2 of

448+ Nothing -> return (x, y)

449+ Just bs2 -> return $ S.breakByte 10 $ bs `S.append` bs2

450+ | otherwise -> return (x, y)

451+ let w =

438− S.foldl' (\i c -> i * 16 + fromIntegral (hexToWord c)) 0

452+ S.foldl' (\i c -> i * 16 + fromIntegral (hexToWord c)) 0

439− $ B.takeWhile isHexDigit

453+ $ B.takeWhile isHexDigit x

440− $ B.concat bss

454+ return (w, S.drop 1 y)

441

455

442 hexToWord w

456 hexToWord w

443 | w < 58 = w - 48

457 | w < 58 = w - 48

warp/test/main.hs+19

@@ -173,6 +173,25 @@ main = hspecX $ do

173 [ "Hello World\nBye"

174 , "Hello World"

175 ]

176+ it "lots of chunks" $ do

177+ ifront <- I.newIORef id

178+ port <- getPort

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

180+ bss <- requestBody req $$ Data.Conduit.List.consume

181+ liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())

182+ return $ responseLBS status200 [] ""

183+ threadDelay 1000

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

185+ let input = concat $ replicate 2 $

186+ ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++

187+ (replicate 500 "5\r\n12345\r\n") ++

188+ ["0\r\n"]

189+ mapM_ (\bs -> hPutStr handle bs >> hFlush handle) input

190+ hClose handle

191+ threadDelay 1000

192+ killThread tid

193+ front <- I.readIORef ifront

194+ front [] @?= replicate 2 (S.concat $ replicate 500 "12345")

176 it "in chunks" $ do

195 it "in chunks" $ do

177 ifront <- I.newIORef id

196 ifront <- I.newIORef id

178 port <- getPort

197 port <- getPort