diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,5 +1,6 @@ -Copyright 2001-2005, The University Court of the University of -Glasgow, Bjorn Bringert, Andy Gill, Ian Lynagh, Erik Meijer, Sven Panne +Copyright 2001-2010, The University Court of the University of +Glasgow, Bjorn Bringert, Andy Gill, Anders Kaseorg, Ian Lynagh, Erik +Meijer, Sven Panne, Jeremy Shaw All rights reserved. diff --git a/Network/CGI.hs b/Network/CGI.hs --- a/Network/CGI.hs +++ b/Network/CGI.hs @@ -8,7 +8,7 @@ -- (c) Jeremy Shaw 2005 -- License : BSD-style -- --- Maintainer : bjorn@bringert.net +-- Maintainer : Anders Kaseorg -- Stability : experimental -- Portability : non-portable (uses Control.Monad.State) -- @@ -104,7 +104,6 @@ import Network.URI (URI(..), URIAuth(..), nullURI, parseRelativeReference, escapeURIString, isUnescapedInURI) import System.IO (stdin, stdout) -import System.IO.Error (isUserError, ioeGetErrorString) import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) @@ -117,7 +116,7 @@ import Network.CGI.Protocol import Network.CGI.Compat -import Text.XHtml (Html, renderHtml, header, (<<), thetitle, (+++), +import Text.XHtml (renderHtml, header, (<<), thetitle, (+++), body, h1, paragraph, hr, address) diff --git a/Network/CGI/Accept.hs b/Network/CGI/Accept.hs --- a/Network/CGI/Accept.hs +++ b/Network/CGI/Accept.hs @@ -7,8 +7,6 @@ , negotiate ) where -import Control.Monad -import Data.Char import Data.Function import Data.List import Data.Maybe @@ -36,9 +34,9 @@ instance HeaderValue a => HeaderValue (Accept a) where parseHeaderValue = fmap Accept $ sepBy p (lexeme (char ',')) where p = do a <- parseHeaderValue - q <- option 1 $ do lexeme $ char ';' - lexeme $ char 'q' - lexeme $ char '=' + q <- option 1 $ do _ <- lexeme $ char ';' + _ <- lexeme $ char 'q' + _ <- lexeme $ char '=' lexeme pQuality return (a,q) pQuality = (char '0' >> option "0" (char '.' >> many digit) >>= \ds -> return (read ("0." ++ ds ++ "0"))) diff --git a/Network/CGI/Compat.hs b/Network/CGI/Compat.hs --- a/Network/CGI/Compat.hs +++ b/Network/CGI/Compat.hs @@ -7,7 +7,7 @@ -- (c) Jeremy Shaw 2005 -- License : BSD-style -- --- Maintainer : bjorn@bringert.net +-- Maintainer : Anders Kaseorg -- Stability : experimental -- Portability : non-portable (uses Control.Monad.State) -- @@ -59,7 +59,7 @@ acceptConnections :: (Handle -> IO ()) -> Socket -> IO () acceptConnections fn sock = do (h, SockAddrInet _ _) <- accept' sock - forkIO (fn h `finally` (hClose h)) + _ <- forkIO (fn h `finally` (hClose h)) acceptConnections fn sock accept' :: Socket -- Listening Socket diff --git a/Network/CGI/Cookie.hs b/Network/CGI/Cookie.hs --- a/Network/CGI/Cookie.hs +++ b/Network/CGI/Cookie.hs @@ -5,7 +5,7 @@ -- (c) Ian Lynagh 2005 -- License : BSD-style -- --- Maintainer : Bjorn Bringert +-- Maintainer : Anders Kaseorg -- Stability : experimental -- Portability : portable -- diff --git a/Network/CGI/Header.hs b/Network/CGI/Header.hs --- a/Network/CGI/Header.hs +++ b/Network/CGI/Header.hs @@ -7,7 +7,7 @@ -- (c) Bjorn Bringert 2005-2006 -- License : BSD-style -- --- Maintainer : bjorn@bringert.net +-- Maintainer : Anders Kaseorg -- Stability : experimental -- Portability : non-portable -- @@ -45,9 +45,7 @@ import Control.Monad import Data.Char -import Data.Function import Data.List -import Data.Maybe import Data.Monoid import Text.ParserCombinators.Parsec @@ -79,10 +77,10 @@ pHeader :: Parser (HeaderName, String) pHeader = do name <- many1 headerNameChar - char ':' - many ws1 + _ <- char ':' + _ <- many ws1 line <- lineString - crLf + _ <- crLf extraLines <- many extraFieldLine return (HeaderName name, concat (line:extraLines)) @@ -90,7 +88,7 @@ extraFieldLine = do sp <- ws1 line <- lineString - crLf + _ <- crLf return (sp:line) getHeaderValue :: (Monad m, HeaderValue a) => String -> Headers -> m a @@ -110,7 +108,7 @@ p_parameter :: Parser (String,String) p_parameter = try $ - do lexeme $ char ';' + do _ <- lexeme $ char ';' p_name <- lexeme $ p_token -- Don't allow parameters named q. This is needed for parsing Accept-X -- headers. From RFC 2616 14.1: @@ -123,7 +121,7 @@ -- parameters in Accept. Future media types are discouraged from -- registering any parameter named "q". when (p_name == "q") pzero - lexeme $ char '=' + _ <- 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 @@ -173,9 +171,9 @@ instance HeaderValue ContentType where parseHeaderValue = - do many ws1 + do _ <- many ws1 c_type <- p_token - char '/' + _ <- char '/' c_subtype <- lexeme $ p_token c_parameters <- many p_parameter return $ ContentType (map toLower c_type) (map toLower c_subtype) c_parameters @@ -204,7 +202,7 @@ instance HeaderValue ContentTransferEncoding where parseHeaderValue = - do many ws1 + do _ <- many ws1 c_cte <- p_token return $ ContentTransferEncoding (map toLower c_cte) prettyHeaderValue (ContentTransferEncoding s) = s @@ -222,7 +220,7 @@ instance HeaderValue ContentDisposition where parseHeaderValue = - do many ws1 + do _ <- many ws1 c_cd <- p_token c_parameters <- many p_parameter return $ ContentDisposition (map toLower c_cd) c_parameters @@ -261,7 +259,7 @@ ws1 = oneOf " \t" lexeme :: Parser a -> Parser a -lexeme p = do x <- p; many ws1; return x +lexeme p = do x <- p; _ <- many ws1; return x -- | RFC 822 CRLF (but more permissive) crLf :: Parser String @@ -272,9 +270,9 @@ lineString = many (noneOf "\n\r") literalString :: Parser String -literalString = do char '\"' +literalString = do _ <- char '\"' str <- many (noneOf "\"\\" <|> quoted_pair) - char '\"' + _ <- char '\"' return str -- No web browsers seem to implement RFC 2046 correctly, @@ -284,10 +282,10 @@ -- Note that this eats everything until the last double quote on the line. buggyLiteralString :: Parser String buggyLiteralString = - do char '\"' + do _ <- char '\"' str <- manyTill anyChar (try lastQuote) return str - where lastQuote = do char '\"' + where lastQuote = do _ <- char '\"' notFollowedBy (try (many (noneOf "\"") >> char '\"')) headerNameChar :: Parser Char @@ -307,5 +305,5 @@ p_text = oneOf text_chars quoted_pair :: Parser Char -quoted_pair = do char '\\' +quoted_pair = do _ <- char '\\' p_text diff --git a/Network/CGI/Monad.hs b/Network/CGI/Monad.hs --- a/Network/CGI/Monad.hs +++ b/Network/CGI/Monad.hs @@ -5,7 +5,7 @@ -- Copyright : (c) Bjorn Bringert 2006 -- License : BSD-style -- --- Maintainer : bjorn@bringert.net +-- Maintainer : Anders Kaseorg -- Stability : experimental -- Portability : non-portable -- @@ -54,7 +54,7 @@ typeOf _ = mkTyConApp (mkTyCon "Network.CGI.Monad.CGIT") [typeOf1 (undefined :: m a), typeOf (undefined :: a)] -instance Monad m => Functor (CGIT m) where +instance (Functor m, Monad m) => Functor (CGIT m) where fmap f c = CGIT (fmap f (unCGIT c)) instance Monad m => Monad (CGIT m) where diff --git a/Network/CGI/Multipart.hs b/Network/CGI/Multipart.hs --- a/Network/CGI/Multipart.hs +++ b/Network/CGI/Multipart.hs @@ -7,7 +7,7 @@ -- (c) Bjorn Bringert 2005-2006 -- License : BSD-style -- --- Maintainer : bjorn@bringert.net +-- Maintainer : Anders Kaseorg -- Stability : experimental -- Portability : non-portable -- diff --git a/Network/CGI/Protocol.hs b/Network/CGI/Protocol.hs --- a/Network/CGI/Protocol.hs +++ b/Network/CGI/Protocol.hs @@ -4,7 +4,7 @@ -- Copyright : (c) Bjorn Bringert 2006 -- License : BSD-style -- --- Maintainer : bjorn@bringert.net +-- Maintainer : Anders Kaseorg -- Stability : experimental -- Portability : non-portable -- @@ -39,7 +39,7 @@ import Data.Maybe (fromMaybe, listToMaybe, isJust) import Network.URI (unEscapeString,escapeURIString,isUnescapedInURI) import System.Environment (getEnvironment) -import System.IO (Handle, hPutStrLn, stderr, hFlush) +import System.IO (Handle, hPutStrLn, stderr, hFlush, hSetBinaryMode) import qualified Data.ByteString.Lazy.Char8 as BS import Data.ByteString.Lazy.Char8 (ByteString) @@ -104,7 +104,8 @@ -> (CGIRequest -> m (Headers, CGIResult)) -- ^ CGI action -> m () hRunCGI env hin hout f = - do inp <- liftIO $ BS.hGetContents hin + do liftIO $ hSetBinaryMode hin True + inp <- liftIO $ BS.hGetContents hin outp <- runCGIEnvFPS env inp f liftIO $ BS.hPut hout outp liftIO $ hFlush hout diff --git a/cgi.cabal b/cgi.cabal --- a/cgi.cabal +++ b/cgi.cabal @@ -1,5 +1,5 @@ Name: cgi -Version: 3001.1.7.3 +Version: 3001.1.7.4 Copyright: Bjorn Bringert, Andy Gill, Anders Kaseorg, Ian Lynagh, Erik Meijer, Sven Panne, Jeremy Shaw Category: Network