Lucu 0.3.1 → 0.3.2

raw patch · 4 files changed

+54/−22 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Lucu.cabal +2/−2
• NEWS +7/−0
• Network/HTTP/Lucu/Parser.hs +38/−16
• examples/Multipart.hs +7/−4

@@ -8,7 +8,7 @@         messing around FastCGI. It is also intended to be run behind a         reverse-proxy so it doesn't have some facilities like logging,         client filtering or such like.-Version: 0.3.1+Version: 0.3.2 License: PublicDomain License-File: COPYING Author: PHO <pho at cielonegro dot org>@@ -92,7 +92,7 @@         Buildable: False     Main-Is: ImplantFile.hs     Extensions:-        UnboxedTuples+        BangPatterns, UnboxedTuples     ghc-options:         -Wall         -funbox-strict-fields

@@ -1,3 +1,10 @@+Changes from 0.3.1 to 0.3.2+---------------------------+* Network.HTTP.Lucu.Parser:+    - Reimplemented 'many', 'many1' and 'count' in tail-recursive+      way. This resolves a stack overflow when a large file is POSTed+      as a multipart/form-data.+ Changes from 0.3 to 0.3.1 ------------------------- * Network.HTTP.Lucu.Resource:

@@ -174,7 +174,8 @@                      IllegalInput -> do put saved -- 状態を復歸                                         runParser g                      ReachedEOF   -> if pstIsEOFFatal saved then-                                         return ReachedEOF+                                         do put saved+                                            return ReachedEOF                                      else                                          do put saved                                             runParser g@@ -221,27 +222,48 @@   many :: Parser a -> Parser [a]-many p = p `seq`-         do x  <- p-            xs <- many p-            return (x:xs)-         <|>-         return []+many !p = Parser $! many' p [] +-- This implementation is rather ugly but we need to make it+-- tail-recursive to avoid stack overflow.+many' :: Parser a -> [a] -> State ParserState (ParserResult [a])+many' !p !soFar+    = do saved  <- get+         result <- runParser p+         case result of+           Success a    -> many' p (a:soFar)+           IllegalInput -> do put saved+                              return $! Success $ reverse soFar+           ReachedEOF   -> if pstIsEOFFatal saved then+                               do put saved+                                  return ReachedEOF+                           else+                               do put saved+                                  return $! Success $ reverse soFar + many1 :: Parser a -> Parser [a]-many1 p = p `seq`-          do x  <- p-             xs <- many p-             return (x:xs)+many1 !p = do x  <- p+              xs <- many p+              return (x:xs)   count :: Int -> Parser a -> Parser [a]-count 0 _ = return []-count n p = n `seq` p `seq`-            do x  <- p-               xs <- count (n-1) p-               return (x:xs)+count !n !p = Parser $! count' n p []++-- This implementation is rather ugly but we need to make it+-- tail-recursive to avoid stack overflow.+count' :: Int -> Parser a -> [a] -> State ParserState (ParserResult [a])+count' 0  _  !soFar = return $! Success $ reverse soFar+count' !n !p !soFar = do saved  <- get+                         result <- runParser p+                         case result of+                           Success a    -> count' (n-1) p (a:soFar)+                           IllegalInput -> do put saved+                                              return IllegalInput+                           ReachedEOF   -> do put saved+                                              return ReachedEOF+  -- def may be a _|_ option :: a -> Parser a -> Parser a

@@ -20,16 +20,19 @@           = Just $ do setContentType $ read "text/html"                       output ("<title>Multipart Form Test</title>" ++                               "<form action=\"/\" method=\"post\" enctype=\"multipart/form-data\">" ++-                              "  Enter some value:" ++-                              "  <input type=\"text\" name=\"val\">" +++                              "  Upload some file:" +++                              "  <input type=\"text\" name=\"text\">" +++                              "  <input type=\"file\" name=\"file\">" ++                               "  <input type=\"submit\" value=\"Submit\">" ++                               "</form>")       , resHead   = Nothing       , resPost           = Just $ do form <- inputForm defaultLimit-                      let value = fromMaybe "" $ fmap snd $ find ((== "val") . fst) form+                      let text = fromMaybe "" $ fmap snd $ find ((== "text") . fst) form+                          file = fromMaybe "" $ fmap snd $ find ((== "file") . fst) form                       setContentType $ read "text/plain"-                      output ("You entered: " ++ value)+                      outputChunk ("You entered \"" ++ text ++ "\".\n")+                      output ("You uploaded a " ++ show (length file) ++ " bytes long file.\n")       , resPut    = Nothing       , resDelete = Nothing       }