cgi 3001.1.5.2 → 3001.1.6.0
raw patch · 5 files changed
+291/−275 lines, 5 filesnew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.CGI: getBody :: (MonadCGI m) => m String
+ Network.CGI: getBodyFPS :: (MonadCGI m) => m ByteString
+ Network.CGI: getInputsFPS :: (MonadCGI m) => m [(String, ByteString)]
Files
- Network/CGI.hs +17/−2
- Network/CGI/Header.hs +271/−0
- Network/CGI/Multipart.hs +1/−1
- Network/CGI/RFC822Headers.hs +0/−270
- cgi.cabal +2/−2
Network/CGI.hs view
@@ -60,7 +60,8 @@ , outputNotFound, outputMethodNotAllowed, outputInternalServerError -- * Input , getInput, getInputFPS, readInput- , getInputs, getInputNames+ , getBody, getBodyFPS+ , getInputs, getInputsFPS, getInputNames , getMultiInput, getMultiInputFPS , getInputFilename, getInputContentType -- * Environment@@ -104,7 +105,7 @@ import Network.CGI.Cookie (Cookie(..), showCookie, newCookie, findCookie) import qualified Network.CGI.Cookie as Cookie (deleteCookie)-import Network.CGI.RFC822Headers (ContentType(..), +import Network.CGI.Header (ContentType(..), parseContentType, showContentType) import Network.CGI.Monad import Network.CGI.Protocol@@ -524,6 +525,13 @@ getInputs = do is <- cgiGet cgiInputs return [ (n, BS.unpack (inputValue i)) | (n,i) <- is ] +-- | Get the names and values of all inputs.+-- Note: the same name may occur more than once in the output,+-- if there are several values for the name.+getInputsFPS :: MonadCGI m => m [(String,ByteString)]+getInputsFPS = do is <- cgiGet cgiInputs+ return [ (n, inputValue i) | (n,i) <- is ]+ -- | Get the names of all input variables. getInputNames :: MonadCGI m => m [String] getInputNames = (sortNub . map fst) `liftM` cgiGet cgiInputs@@ -534,6 +542,13 @@ getInput_ :: MonadCGI m => String -> m (Maybe Input) getInput_ n = lookup n `liftM` cgiGet cgiInputs +-- | Get the uninterpreted request body as a String+getBody :: MonadCGI m => m String+getBody = BS.unpack `liftM` cgiGet cgiRequestBody++-- | Get the uninterpreted request body as lazy ByteString+getBodyFPS :: MonadCGI m => m ByteString+getBodyFPS = cgiGet cgiRequestBody -- -- * Cookies
+ Network/CGI/Header.hs view
@@ -0,0 +1,271 @@+-- #hide++-----------------------------------------------------------------------------+-- |+-- Module : Network.CGI.Header+-- Copyright : (c) Peter Thiemann 2001,2002+-- (c) Bjorn Bringert 2005-2006+-- License : BSD-style+--+-- Maintainer : bjorn@bringert.net+-- Stability : experimental+-- Portability : non-portable+--+-- Parsing of HTTP headers (name, value pairs)+-- Partly based on code from WASHMail.+--+-----------------------------------------------------------------------------+module Network.CGI.Header (+ -- * Headers+ Header, + pHeader,+ pHeaders,+ parseHeaders,++ -- * Content-type+ ContentType(..), + getContentType,+ parseContentType,+ pContentType,+ showContentType,++ -- * Content-transfer-encoding+ ContentTransferEncoding(..),+ getContentTransferEncoding,+ parseContentTransferEncoding,++ -- * Content-disposition+ ContentDisposition(..),+ getContentDisposition, + parseContentDisposition,+ showContentDisposition,+ + -- * Utilities+ parseM) where++import Data.Char+import Data.List+import Text.ParserCombinators.Parsec++type Header = (String, String)++pHeaders :: Parser [Header]+pHeaders = many pHeader++parseHeaders :: Monad m => SourceName -> String -> m [Header]+parseHeaders s inp = parseM pHeaders s inp++pHeader :: Parser Header+pHeader = + do name <- many1 headerNameChar+ char ':'+ many ws1+ line <- lineString+ crLf+ extraLines <- many extraFieldLine+ return (map toLower name, concat (line:extraLines))++extraFieldLine :: Parser String+extraFieldLine = + do sp <- ws1+ line <- lineString+ crLf+ return (sp:line)++--+-- * Parameters (for Content-type etc.)+--++showParameters :: [(String,String)] -> String+showParameters = concatMap f+ where f (n,v) = "; " ++ n ++ "=\"" ++ concatMap esc v ++ "\""+ esc '\\' = "\\\\"+ esc '"' = "\\\""+ esc c | c `elem` ['\\','"'] = '\\':[c]+ | otherwise = [c]++p_parameter :: Parser (String,String)+p_parameter =+ do lexeme $ char ';'+ p_name <- lexeme $ p_token+ lexeme $ char '='+ -- Workaround for seemingly standardized web browser bug+ -- where nothing is escaped in the filename parameter+ -- of the content-disposition header in multipart/form-data+ let litStr = if p_name == "filename" + then buggyLiteralString+ else literalString+ p_value <- litStr <|> p_token+ return (map toLower p_name, p_value)+++-- +-- * Content type+--++-- | A MIME media type value.+-- The 'Show' instance is derived automatically.+-- Use 'showContentType' to obtain the standard+-- string representation.+-- See <http://www.ietf.org/rfc/rfc2046.txt> for more+-- information about MIME media types.+data ContentType = + ContentType {+ -- | The top-level media type, the general type+ -- of the data. Common examples are+ -- \"text\", \"image\", \"audio\", \"video\",+ -- \"multipart\", and \"application\".+ ctType :: String,+ -- | The media subtype, the specific data format.+ -- Examples include \"plain\", \"html\",+ -- \"jpeg\", \"form-data\", etc.+ ctSubtype :: String,+ -- | Media type parameters. On common example is+ -- the charset parameter for the \"text\" + -- top-level type, e.g. @(\"charset\",\"ISO-8859-1\")@.+ ctParameters :: [(String, String)]+ }+ deriving (Show, Read, Eq, Ord)++-- | Produce the standard string representation of a content-type,+-- e.g. \"text\/html; charset=ISO-8859-1\".+showContentType :: ContentType -> String+showContentType (ContentType x y ps) = x ++ "/" ++ y ++ showParameters ps++pContentType :: Parser ContentType+pContentType = + do many ws1+ c_type <- p_token+ lexeme $ char '/'+ c_subtype <- lexeme $ p_token+ c_parameters <- many p_parameter+ return $ ContentType (map toLower c_type) (map toLower c_subtype) c_parameters++-- | Parse the standard representation of a content-type.+-- If the input cannot be parsed, this function calls+-- 'fail' with a (hopefully) informative error message.+parseContentType :: Monad m => String -> m ContentType+parseContentType = parseM pContentType "Content-type"++getContentType :: Monad m => [Header] -> m ContentType+getContentType hs = lookupM "content-type" hs >>= parseContentType++--+-- * Content transfer encoding+--++data ContentTransferEncoding =+ ContentTransferEncoding String+ deriving (Show, Read, Eq, Ord)++pContentTransferEncoding :: Parser ContentTransferEncoding+pContentTransferEncoding =+ do many ws1+ c_cte <- p_token+ return $ ContentTransferEncoding (map toLower c_cte)++parseContentTransferEncoding :: Monad m => String -> m ContentTransferEncoding+parseContentTransferEncoding = + parseM pContentTransferEncoding "Content-transfer-encoding"++getContentTransferEncoding :: Monad m => [Header] -> m ContentTransferEncoding+getContentTransferEncoding hs = + lookupM "content-transfer-encoding" hs >>= parseContentTransferEncoding++--+-- * Content disposition+--++data ContentDisposition =+ ContentDisposition String [(String, String)]+ deriving (Show, Read, Eq, Ord)++pContentDisposition :: Parser ContentDisposition+pContentDisposition =+ do many ws1+ c_cd <- p_token+ c_parameters <- many p_parameter+ return $ ContentDisposition (map toLower c_cd) c_parameters++parseContentDisposition :: Monad m => String -> m ContentDisposition+parseContentDisposition = parseM pContentDisposition "Content-disposition"++getContentDisposition :: Monad m => [Header] -> m ContentDisposition+getContentDisposition hs = + lookupM "content-disposition" hs >>= parseContentDisposition++showContentDisposition :: ContentDisposition -> String+showContentDisposition (ContentDisposition t hs) = + t ++ concat ["; " ++ n ++ "=" ++ quote v | (n,v) <- hs]+ where quote x = "\"" ++ x ++ "\"" -- NOTE: silly, but de-facto standard++--+-- * Utilities+--++parseM :: Monad m => Parser a -> SourceName -> String -> m a+parseM p n inp =+ case parse p n inp of+ Left e -> fail (show e)+ Right x -> return x++lookupM :: (Monad m, Eq a, Show a) => a -> [(a,b)] -> m b+lookupM n = maybe (fail ("No such field: " ++ show n)) return . lookup n++-- +-- * Parsing utilities+--++-- | RFC 822 LWSP-char+ws1 :: Parser Char+ws1 = oneOf " \t"++lexeme :: Parser a -> Parser a+lexeme p = do x <- p; many ws1; return x++-- | RFC 822 CRLF (but more permissive)+crLf :: Parser String+crLf = try (string "\n\r" <|> string "\r\n") <|> string "\n" <|> string "\r"++-- | One line+lineString :: Parser String+lineString = many (noneOf "\n\r")++literalString :: Parser String+literalString = do char '\"'+ str <- many (noneOf "\"\\" <|> quoted_pair)+ char '\"'+ return str++-- No web browsers seem to implement RFC 2046 correctly,+-- since they do not escape double quotes and backslashes+-- in the filename parameter in multipart/form-data.+--+-- Note that this eats everything until the last double quote on the line.+buggyLiteralString :: Parser String+buggyLiteralString = + do char '\"'+ str <- manyTill anyChar (try lastQuote)+ return str+ where lastQuote = do char '\"' + notFollowedBy (try (many (noneOf "\"") >> char '\"'))++headerNameChar :: Parser Char+headerNameChar = noneOf "\n\r:"++especials, tokenchar :: [Char]+especials = "()<>@,;:\\\"/[]?.="+tokenchar = "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" \\ especials++p_token :: Parser String+p_token = many1 (oneOf tokenchar)++text_chars :: [Char]+text_chars = map chr ([1..9] ++ [11,12] ++ [14..127])++p_text :: Parser Char+p_text = oneOf text_chars++quoted_pair :: Parser Char+quoted_pair = do char '\\'+ p_text
Network/CGI/Multipart.hs view
@@ -38,7 +38,7 @@ import Data.Maybe import System.IO (Handle) -import Network.CGI.RFC822Headers+import Network.CGI.Header import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString)
− Network/CGI/RFC822Headers.hs
@@ -1,270 +0,0 @@--- #hide---------------------------------------------------------------------------------- |--- Module : Network.CGI.RFC822Headers--- Copyright : (c) Peter Thiemann 2001,2002--- (c) Bjorn Bringert 2005-2006--- License : BSD-style------ Maintainer : bjorn@bringert.net--- Stability : experimental--- Portability : non-portable------ Parsing of RFC822-style headers (name, value pairs)--- Partly based on code from WASHMail.----------------------------------------------------------------------------------module Network.CGI.RFC822Headers (- -- * Headers- Header, - pHeader,- pHeaders,- parseHeaders,-- -- * Content-type- ContentType(..), - getContentType,- parseContentType,- showContentType,-- -- * Content-transfer-encoding- ContentTransferEncoding(..),- getContentTransferEncoding,- parseContentTransferEncoding,-- -- * Content-disposition- ContentDisposition(..),- getContentDisposition, - parseContentDisposition,- showContentDisposition,- - -- * Utilities- parseM) where--import Data.Char-import Data.List-import Text.ParserCombinators.Parsec--type Header = (String, String)--pHeaders :: Parser [Header]-pHeaders = many pHeader--parseHeaders :: Monad m => SourceName -> String -> m [Header]-parseHeaders s inp = parseM pHeaders s inp--pHeader :: Parser Header-pHeader = - do name <- many1 headerNameChar- char ':'- many ws1- line <- lineString- crLf- extraLines <- many extraFieldLine- return (map toLower name, concat (line:extraLines))--extraFieldLine :: Parser String-extraFieldLine = - do sp <- ws1- line <- lineString- crLf- return (sp:line)------- * Parameters (for Content-type etc.)-----showParameters :: [(String,String)] -> String-showParameters = concatMap f- where f (n,v) = "; " ++ n ++ "=\"" ++ concatMap esc v ++ "\""- esc '\\' = "\\\\"- esc '"' = "\\\""- esc c | c `elem` ['\\','"'] = '\\':[c]- | otherwise = [c]--p_parameter :: Parser (String,String)-p_parameter =- do lexeme $ char ';'- p_name <- lexeme $ p_token- lexeme $ char '='- -- Workaround for seemingly standardized web browser bug- -- where nothing is escaped in the filename parameter- -- of the content-disposition header in multipart/form-data- let litStr = if p_name == "filename" - then buggyLiteralString- else literalString- p_value <- litStr <|> p_token- return (map toLower p_name, p_value)----- --- * Content type------- | A MIME media type value.--- The 'Show' instance is derived automatically.--- Use 'showContentType' to obtain the standard--- string representation.--- See <http://www.ietf.org/rfc/rfc2046.txt> for more--- information about MIME media types.-data ContentType = - ContentType {- -- | The top-level media type, the general type- -- of the data. Common examples are- -- \"text\", \"image\", \"audio\", \"video\",- -- \"multipart\", and \"application\".- ctType :: String,- -- | The media subtype, the specific data format.- -- Examples include \"plain\", \"html\",- -- \"jpeg\", \"form-data\", etc.- ctSubtype :: String,- -- | Media type parameters. On common example is- -- the charset parameter for the \"text\" - -- top-level type, e.g. @(\"charset\",\"ISO-8859-1\")@.- ctParameters :: [(String, String)]- }- deriving (Show, Read, Eq, Ord)---- | Produce the standard string representation of a content-type,--- e.g. \"text\/html; charset=ISO-8859-1\".-showContentType :: ContentType -> String-showContentType (ContentType x y ps) = x ++ "/" ++ y ++ showParameters ps--pContentType :: Parser ContentType-pContentType = - do many ws1- c_type <- p_token- lexeme $ char '/'- c_subtype <- lexeme $ p_token- c_parameters <- many p_parameter- return $ ContentType (map toLower c_type) (map toLower c_subtype) c_parameters---- | Parse the standard representation of a content-type.--- If the input cannot be parsed, this function calls--- 'fail' with a (hopefully) informative error message.-parseContentType :: Monad m => String -> m ContentType-parseContentType = parseM pContentType "Content-type"--getContentType :: Monad m => [Header] -> m ContentType-getContentType hs = lookupM "content-type" hs >>= parseContentType------- * Content transfer encoding-----data ContentTransferEncoding =- ContentTransferEncoding String- deriving (Show, Read, Eq, Ord)--pContentTransferEncoding :: Parser ContentTransferEncoding-pContentTransferEncoding =- do many ws1- c_cte <- p_token- return $ ContentTransferEncoding (map toLower c_cte)--parseContentTransferEncoding :: Monad m => String -> m ContentTransferEncoding-parseContentTransferEncoding = - parseM pContentTransferEncoding "Content-transfer-encoding"--getContentTransferEncoding :: Monad m => [Header] -> m ContentTransferEncoding-getContentTransferEncoding hs = - lookupM "content-transfer-encoding" hs >>= parseContentTransferEncoding------- * Content disposition-----data ContentDisposition =- ContentDisposition String [(String, String)]- deriving (Show, Read, Eq, Ord)--pContentDisposition :: Parser ContentDisposition-pContentDisposition =- do many ws1- c_cd <- p_token- c_parameters <- many p_parameter- return $ ContentDisposition (map toLower c_cd) c_parameters--parseContentDisposition :: Monad m => String -> m ContentDisposition-parseContentDisposition = parseM pContentDisposition "Content-disposition"--getContentDisposition :: Monad m => [Header] -> m ContentDisposition-getContentDisposition hs = - lookupM "content-disposition" hs >>= parseContentDisposition--showContentDisposition :: ContentDisposition -> String-showContentDisposition (ContentDisposition t hs) = - t ++ concat ["; " ++ n ++ "=" ++ quote v | (n,v) <- hs]- where quote x = "\"" ++ x ++ "\"" -- NOTE: silly, but de-facto standard------- * Utilities-----parseM :: Monad m => Parser a -> SourceName -> String -> m a-parseM p n inp =- case parse p n inp of- Left e -> fail (show e)- Right x -> return x--lookupM :: (Monad m, Eq a, Show a) => a -> [(a,b)] -> m b-lookupM n = maybe (fail ("No such field: " ++ show n)) return . lookup n---- --- * Parsing utilities------- | RFC 822 LWSP-char-ws1 :: Parser Char-ws1 = oneOf " \t"--lexeme :: Parser a -> Parser a-lexeme p = do x <- p; many ws1; return x---- | RFC 822 CRLF (but more permissive)-crLf :: Parser String-crLf = try (string "\n\r" <|> string "\r\n") <|> string "\n" <|> string "\r"---- | One line-lineString :: Parser String-lineString = many (noneOf "\n\r")--literalString :: Parser String-literalString = do char '\"'- str <- many (noneOf "\"\\" <|> quoted_pair)- char '\"'- return str---- No web browsers seem to implement RFC 2046 correctly,--- since they do not escape double quotes and backslashes--- in the filename parameter in multipart/form-data.------ Note that this eats everything until the last double quote on the line.-buggyLiteralString :: Parser String-buggyLiteralString = - do char '\"'- str <- manyTill anyChar (try lastQuote)- return str- where lastQuote = do char '\"' - notFollowedBy (try (many (noneOf "\"") >> char '\"'))--headerNameChar :: Parser Char-headerNameChar = noneOf "\n\r:"--especials, tokenchar :: [Char]-especials = "()<>@,;:\\\"/[]?.="-tokenchar = "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" \\ especials--p_token :: Parser String-p_token = many1 (oneOf tokenchar)--text_chars :: [Char]-text_chars = map chr ([1..9] ++ [11,12] ++ [14..127])--p_text :: Parser Char-p_text = oneOf text_chars--quoted_pair :: Parser Char-quoted_pair = do char '\\'- p_text
cgi.cabal view
@@ -1,5 +1,5 @@ Name: cgi-Version: 3001.1.5.2+Version: 3001.1.6.0 Copyright: Bjorn Bringert, Andy Gill, Ian Lynagh, Erik Meijer, Sven Panne, Jeremy Shaw Maintainer: bjorn@bringert.net@@ -24,7 +24,7 @@ Network.CGI.Compat Other-modules: Network.CGI.Multipart,- Network.CGI.RFC822Headers+ Network.CGI.Header Extensions: MultiParamTypeClasses ghc-options: -Wall