@@ -29,8 +29,7 @@ import Data.Function (on)
2929import System.Directory (removeFile, getTemporaryDirectory)
3030import System.IO (hClose, openBinaryTempFile, Handle)
3131import Network.Wai
32−import Control.Applicative ((<$>))
33−import Data.Enumerator (($$), Iteratee)
32+import Data.Enumerator (Iteratee, yield)
3433import qualified Data.Enumerator as E
3534import Control.Monad.IO.Class (liftIO)
3635
@@ -166,29 +165,29 @@ type File y = (S.ByteString, FileInfo y)
166165
167166parseRequestBody :: Sink x y
168167 -> Request
169− -> IO ([Param], [File y])
168+ -> Iteratee S.ByteString IO ([Param], [File y])
170169parseRequestBody sink req = do
171− let ctype = do
172− ctype' <- lookup "Content-Type" $ requestHeaders req
173− if urlenc `S.isPrefixOf` ctype'
174− then Just Nothing
175− else if formBound `S.isPrefixOf` ctype'
176− then Just $ Just $ S.drop (S.length formBound) ctype'
177− else Nothing
178170 case ctype of
179171 Nothing -> return ([], [])
180172 Just Nothing -> do -- url-encoded
181173 -- NOTE: in general, url-encoded data will be in a single chunk.
182174 -- Therefore, I'm optimizing for the usual case by sticking with
183175 -- strict byte strings here.
184− bs <- E.run_ $ requestBody req $$ E.consume
176+ bs <- E.consume
185177 return (parseQueryString $ S.concat bs, [])
186178 Just (Just bound) -> -- multi-part
187179 let bound' = S8.pack "--" `S.append` bound
188− in error "FIXME" parsePieces sink bound' (S.empty, Just $ requestBody req)
180+ in parsePieces sink bound'
189181 where
190182 urlenc = S8.pack "application/x-www-form-urlencoded"
191183 formBound = S8.pack "multipart/form-data; boundary="
184+ ctype = do
185+ ctype' <- lookup "Content-Type" $ requestHeaders req
186+ if urlenc `S.isPrefixOf` ctype'
187+ then Just Nothing
188+ else if formBound `S.isPrefixOf` ctype'
189+ then Just $ Just $ S.drop (S.length formBound) ctype'
190+ else Nothing
192191
193192takeLine :: Iteratee S.ByteString IO (Maybe S.ByteString)
194193takeLine = do
@@ -305,54 +304,55 @@ sinkTillBound :: S.ByteString
305304 -> (x -> S.ByteString -> IO x)
306305 -> x
307306 -> Iteratee S.ByteString IO (x, Bool)
308−sinkTillBound bound iter seed = error "FIXME"
309−{-
310− case findBound bound bs of
307+sinkTillBound bound iter seed = do
308+ mbs <- E.head
309+ case mbs of
310+ Nothing -> return (seed, False)
311+ Just bs -> go bs
312+ where
313+ go bs =
314+ case findBound bound bs of
315+ FoundBound before after -> do
316+ let before' = killCRLF before
317+ seed' <- liftIO $ iter seed before'
318+ yield () $ E.Chunks [after]
319+ return (seed', True)
320+ PartialBound -> do
321+ mbs <- E.head
322+ case mbs of
323+ Nothing -> do
324+ seed' <- liftIO $ iter seed bs
325+ return (seed', False)
326+ Just bs2 -> do
327+ let bs' = bs `S.append` bs2
328+ yield () $ E.Chunks [bs']
329+ sinkTillBound bound iter seed
330+ NoBound -> do
331+ mbs <- E.head
332+ case mbs of
333+ Nothing -> do
334+ seed' <- liftIO $ iter seed bs
335+ sinkTillBound bound iter seed'
336+ Just bs' -> do
337+ -- this funny bit is to catch when there's a
338+ -- newline at the end of the previous chunk
339+ (seed', bs'') <-
340+ if not (S8.null bs) && S8.last bs `elem` "\n\r"
341+ then do
342+ let (front, back) =
343+ S.splitAt (S.length bs - 2) bs
344+ seed' <- liftIO $ iter seed front
345+ return (seed', back `S.append` bs')
346+ else do
347+ seed' <- liftIO $ iter seed bs
348+ return (seed', bs')
349+ yield () $ E.Chunks [bs'']
350+ sinkTillBound bound iter seed'
351+ {-
311352 NoBound -> do
312353 case msrc of
313− Nothing -> do
314− seed' <- iter seed bs
315− return (seed', False, (S.empty, Nothing))
316− Just (Source src) -> do
317− res <- src
318− case res of
319− Nothing -> do
320− seed' <- iter seed bs
321− return (seed', False, (S.empty, Nothing))
322− Just (bs', src') -> do
323− -- this funny bit is to catch when there's a
324− -- newline at the end of the previous chunk
325− (seed', bs'') <-
326− if not (S8.null bs) && S8.last bs `elem` "\n\r"
327− then do
328− let (front, back) =
329− S.splitAt (S.length bs - 2) bs
330− seed' <- iter seed front
331− return (seed', back `S.append` bs')
332− else do
333− seed' <- iter seed bs
334− return (seed', bs')
335− sinkTillBound bound (bs'', Just src') iter seed'
336− FoundBound before after -> do
337− let before' = killCRLF before
338− seed' <- iter seed before'
339− return (seed', True, (after, msrc))
340− PartialBound -> do
341− -- not so efficient, but hopefully the unusual case
342− case msrc of
343− Nothing -> do
344− seed' <- iter seed bs
345− return (seed', False, (S.empty, Nothing))
346− Just (Source src) -> do
347− res <- src
348− case res of
349− Nothing -> do
350− seed' <- iter seed bs
351− return (seed', False, (S.empty, Nothing))
352354 Just (bs', src') -> do
353− let bs'' = bs `S.append` bs'
354− sinkTillBound bound (bs'', Just src') iter seed
355−-}
355+ -}
356356
357357parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]
358358parseAttrs = map go . S.split 59 -- semicolon