wai-extra 3.1.17 → 3.1.18

raw patch · 6 files changed

+71/−16 lines, 6 files

Files

• ChangeLog.md +7/−0
• Network/Wai/Middleware/Approot.hs +3/−3
• Network/Wai/Parse.hs +30/−12
• Network/Wai/UrlMap.hs +8/−0
• test/Network/Wai/ParseSpec.hs +22/−0
• wai-extra.cabal +1/−1

@@ -1,5 +1,12 @@ # Changelog for wai-extra +## 3.1.18++* Fixed handling of quoted strings and semicolons in `parseRequestBodyEx` [#1038](https://github.com/yesodweb/wai/pull/1038).+  In particular, multipart form data containing filenames with semicolons and `\` escaped characters+  are now parsed correctly.+* Added instances `Foldable` and `Traversable` for `UrlMap'` [#992](https://github.com/yesodweb/wai/pull/992)+ ## 3.1.17  * Started deprecation of `data-default` [#1011](https://github.com/yesodweb/wai/pull/1011)

@@ -36,7 +36,7 @@ import Data.Typeable (Typeable) import qualified Data.Vault.Lazy as V import Network.Wai (Middleware, Request, vault)-import System.Environment (getEnvironment)+import System.Environment (lookupEnv) import System.IO.Unsafe (unsafePerformIO)  import Network.Wai.Request (guessApproot)@@ -75,8 +75,8 @@ -- Since 3.0.7 envFallbackNamed :: String -> IO Middleware envFallbackNamed name = do-    env <- getEnvironment-    pure $ case lookup name env of+    approot <- lookupEnv name+    pure $ case approot of         Just s -> hardcoded $ S8.pack s         Nothing -> fromRequest 

@@ -576,7 +576,7 @@             let x = do                     cd <- lookup contDisp ls'                     let ct = lookup contType ls'-                    let attrs = parseAttrs cd+                    let attrs = parseContentDispositionAttrs cd                     name <- lookup "name" attrs                     return (ct, name, lookup "filename" attrs)             case x of@@ -796,17 +796,35 @@     b <- final     return (b, seed) -parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]-parseAttrs = map go . S.split _semicolon-  where-    tw = S.dropWhile (== _space)-    dq s =-        if S.length s > 2 && S.head s == _quotedbl && S.last s == _quotedbl-            then S.tail $ S.init s-            else s-    go s =-        let (x, y) = breakDiscard _equal s-         in (tw x, dq $ tw y)+parseContentDispositionAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]+parseContentDispositionAttrs = parseTokenValues+ where+    nonTokenChars = [_semicolon, _equal]+    dropSpace = S.dropWhile (== _space)+    parseTokenValues input | S.null input = []+    parseTokenValues input =+        let (token, rest) = parseToken $ dropSpace input+         in case S.uncons rest of+            Just (c, rest')+                | c == _equal -> +                    let (value, rest'') = parseValue rest'+                     in (token, value) : parseTokenValues (S.drop 1 rest'')+                | otherwise -> (token, S.empty) : parseTokenValues rest'+            Nothing -> (token, S.empty) : parseTokenValues S.empty+    parseToken = S.break (`elem` nonTokenChars)+    parseValue input =+        case S.uncons $ dropSpace input of+            Just (c, rest) | c == _quotedbl -> parseQuotedString [] rest+            _ -> S.break (`elem` nonTokenChars) $ dropSpace input+    parseQuotedString acc input =+        let (prefix, rest) = S.break (`elem` [_quotedbl, _backslash]) input+         in case S.uncons rest of+            Just (c, rest')+                | c == _quotedbl -> (S.concat $ reverse (prefix:acc), rest')+                | c == _backslash ->+                    let (slashed, postSlash) = S.splitAt 1 rest'+                     in parseQuotedString (slashed:prefix:acc) postSlash+            _ -> (S.concat $ reverse (prefix:acc), rest)  killCRLF :: S.ByteString -> S.ByteString killCRLF bs

@@ -52,6 +52,14 @@     empty = UrlMap' empty     (UrlMap' xs) <|> (UrlMap' ys) = UrlMap' (xs <|> ys) +-- | @since 3.1.18+instance Foldable UrlMap' where+    foldr f z (UrlMap' xs) = foldr (f . snd) z xs++-- | @since 3.1.18+instance Traversable UrlMap' where+    traverse f (UrlMap' xs) = UrlMap' <$> traverse (traverse f) xs+ type UrlMap = UrlMap' Application  -- | Mount an application under a given path. The ToApplication typeclass gives

@@ -197,6 +197,16 @@         SRequest req _bod <- toRequest'' ctype content         parseRequestBodyEx (setMaxRequestParmsSize 10 def) lbsBackEnd req             `shouldThrow` anyException+    it "parsing filename with semi-colon" $ do+        SRequest req _bod <- toRequest'' ctype3 content6+        let expected = ([], [("yaml", FileInfo "semi; colon;" "application/octet-stream" "Photo blog using Hack.\n")])+        body <- parseRequestBodyEx def lbsBackEnd req+        body `shouldBe` expected+    it "parsing filename with semi-colon" $ do+        SRequest req _bod <- toRequest'' ctype3 content7+        let expected = ([], [("yaml", FileInfo "this will be dropped, !only this will be returned" "application/octet-stream" "Photo blog using Hack.\n")])+        body <- parseRequestBodyEx def lbsBackEnd req+        body `shouldBe` expected   where     content2 =         "--AaB03x\n"@@ -242,6 +252,18 @@             <> "Content-Type: application/octet-stream\r\n\r\n"             <> "Photo blog using Hack.\n\r\n"             <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n"+    content6 =+        "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n"+            <> "Content-Disposition: form-data; name=\"yaml\"; filename=\"semi; colon;\"\r\n"+            <> "Content-Type: application/octet-stream\r\n\r\n"+            <> "Photo blog using Hack.\n\r\n"+            <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n"+    content7 =+        "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n"+            <> "Content-Disposition: form-data; name=\"yaml\"; filename=\"this will be dropped, \\!only this will be returned\r\n"+            <> "Content-Type: application/octet-stream\r\n\r\n"+            <> "Photo blog using Hack.\n\r\n"+            <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n"  caseMultipartPlus :: Assertion caseMultipartPlus = do

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.1.17+Version:             3.1.18 Synopsis:            Provides some basic WAI handlers and middleware. description:   Provides basic WAI handler and middleware functionality: