happstack-server 7.3.3 → 7.3.4

raw patch · 4 files changed

+22/−7 lines, 4 files

Files

• happstack-server.cabal +1/−1
• src/Happstack/Server/Internal/Listen.hs +0/−2
• src/Happstack/Server/Internal/MessageWrap.hs +20/−3
• src/Happstack/Server/Internal/Types.hs +1/−1

@@ -1,5 +1,5 @@ Name:                happstack-server-Version:             7.3.3+Version:             7.3.4 Synopsis:            Web related tools and services. Description:         Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course <http://happstack.com/docs/crashcourse/index.html> License:             BSD3

@@ -45,7 +45,6 @@         (sClose)         (\sock -> do             setSocketOption sock ReuseAddr 1-            setSocketOption sock NoDelay 1             bindSocket sock (SockAddrInet (fromIntegral portm) iNADDR_ANY)             Socket.listen sock (max 1024 maxListenQueue)             return sock@@ -62,7 +61,6 @@         (sClose)         (\sock -> do             setSocketOption sock ReuseAddr 1-            setSocketOption sock NoDelay 1             bindSocket sock (SockAddrInet (fromIntegral portm) hostAddr)             Socket.listen sock (max 1024 maxListenQueue)             return sock

@@ -83,7 +83,18 @@           (name,val)=split (=='=') pairString           rest=if null qString' then [] else formDecode qString' --- FIXME: no size limits on application/x-www-form-urlencoded yet+-- | Decodes application\/x-www-form-urlencoded inputs.+-- TODO: should any of the [] be error conditions?+formDecodeBS :: L.ByteString -> [(String, Input)]+formDecodeBS qString | L.null qString = []+formDecodeBS qString =+    if L.null pairString+       then rest            -- skip in case of consecutive ampersands "...&&..."+       else (SURI.unEscapeQS (L.unpack name), simpleInput $ SURI.unEscapeQS (L.unpack $ L.drop 1 val)) : rest+    where (pairString,qString') = L.break (== '&') qString+          (name,val) = L.break (== '=') pairString+          rest = formDecodeBS (L.drop 1 qString')+ -- FIXME: is usend L.unpack really the right thing to do decodeBody :: BodyPolicy            -> Maybe ContentType@@ -92,14 +103,20 @@ decodeBody bp ctype inp     = case ctype of         Just (ContentType "application" "x-www-form-urlencoded" _) ->-            return (formDecode (L.unpack (L.take (maxRAM bp) inp)), Nothing)+            return decodedUrlEncodedForm         Just (ContentType "multipart" "form-data" ps) ->             multipartDecode ((inputWorker bp) (maxDisk bp) (maxRAM bp) (maxHeader bp)) ps inp         Just ct ->             return ([], Just $ "decodeBody: unsupported content-type: " ++ show ct) -- unknown content-type, the user will have to                      -- deal with it by looking at the raw content         -- No content-type given, assume x-www-form-urlencoded-        Nothing -> return (formDecode (L.unpack (L.take (maxRAM bp) inp)), Nothing)+        Nothing -> return decodedUrlEncodedForm+  where+     (upToMaxRAM,overMaxRAM) = L.splitAt (maxRAM bp) inp+     decodedUrlEncodedForm = (formDecodeBS upToMaxRAM,+                              if L.null overMaxRAM+                              then Nothing+                              else Just ("x-www-form-urlencoded content longer than BodyPolicy.maxRAM=" ++ show (maxRAM bp) ++ " bytes"))  -- | Decodes multipart\/form-data input. multipartDecode :: InputWorker

@@ -318,7 +318,7 @@ mkHeaders :: [(String,String)] -> Headers mkHeaders hdrs     = M.fromListWith join [ (P.pack (map toLower key), HeaderPair (P.pack key) [P.pack value]) | (key,value) <- hdrs ]-    where join (HeaderPair key vs1) (HeaderPair _ vs2) = HeaderPair key (vs1++vs2)+    where join (HeaderPair key vs1) (HeaderPair _ vs2) = HeaderPair key (vs2++vs1)  -------------------------------------------------------------- -- Retrieving header information