cgi 3001.1.5.1 → 3001.1.5.2

raw patch · 3 files changed

+129/−5 lines, 3 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Network/CGI.hs +13/−3
• Network/CGI/Compat.hs +113/−0
• cgi.cabal +3/−2

@@ -61,7 +61,7 @@   -- * Input   , getInput, getInputFPS, readInput   , getInputs, getInputNames-  , getMultiInput+  , getMultiInput, getMultiInputFPS   , getInputFilename, getInputContentType   -- * Environment   , getVar, getVarWithDefault, getVars@@ -83,6 +83,8 @@   , setCookie, deleteCookie   -- * URL encoding   , formEncode, urlEncode, formDecode, urlDecode+  -- * Compatibility with the old API+  , module Network.CGI.Compat   ) where  import Control.Exception (Exception(..))@@ -106,6 +108,7 @@                                   parseContentType, showContentType) import Network.CGI.Monad import Network.CGI.Protocol+import Network.CGI.Compat  import Text.XHtml (Html, renderHtml, header, (<<), thetitle, (+++),                     body, h1, paragraph, hr, address)@@ -479,8 +482,15 @@                  String -- ^ The name of the variable.               -> m [String] -- ^ The values of the variable,                             -- or the empty list if the variable was not set.-getMultiInput n = do is <- cgiGet cgiInputs-                     return [BS.unpack (inputValue v) | (p,v) <- is, p == n]+getMultiInput = liftM (map BS.unpack) . getMultiInputFPS++-- | Same as 'getMultiInput' but using 'ByteString's.+getMultiInputFPS :: MonadCGI m => +                    String -- ^ The name of the variable.+                 -> m [ByteString] -- ^ The values of the variable,+                            -- or the empty list if the variable was not set.+getMultiInputFPS n = do is <- cgiGet cgiInputs+                        return [inputValue v | (p,v) <- is, p == n]  -- | Get the file name of an input. getInputFilename :: MonadCGI m =>

@@ -0,0 +1,113 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Network.CGI.Compat+-- Copyright   :  (c) The University of Glasgow 2001+--                (c) Bjorn Bringert 2004-2006+--                (c) Ian Lynagh 2005+--                (c) Jeremy Shaw 2005+-- License     :  BSD-style+--+-- Maintainer  :  bjorn@bringert.net+-- Stability   :  experimental+-- Portability :  non-portable (uses Control.Monad.State)+--+-- Compatibility functions for the old Network.CGI API.+--+-----------------------------------------------------------------------------++module Network.CGI.Compat (+    Html, wrapper, pwrapper, connectToCGIScript+  ) where++import Control.Concurrent (forkIO)+import Control.Exception as Exception (Exception,throw,catch,finally)+import Control.Monad (unless)+import Control.Monad.Trans (MonadIO, liftIO)+import qualified Data.Map as Map+import Network (PortID, Socket, listenOn, connectTo)+import Network.Socket as Socket (SockAddr(SockAddrInet), accept, socketToHandle)+import System.IO (Handle, hPutStrLn, stdin, stdout,+                  hGetLine, hClose, IOMode(ReadWriteMode))+import System.IO.Error (isEOFError)++import qualified Data.ByteString.Lazy.Char8 as BS+import Data.ByteString.Lazy.Char8 (ByteString)++import Text.XHtml (Html, renderHtml)++import Network.CGI.Protocol+++{-# DEPRECATED wrapper, pwrapper, connectToCGIScript "Use the new interface." #-}++-- | Compatibility wrapper for the old CGI interface.+--   Output the output from a function from CGI environment and+--   input variables to an HTML document.+wrapper :: ([(String,String)] -> IO Html) -> IO ()+wrapper = run stdin stdout++-- | Compatibility wrapper for the old CGI interface.+--   Runs a simple CGI server.+--   Note: if using Windows, you might need to wrap 'Network.withSocketsDo' around main.+pwrapper :: PortID  -- ^ The port to run the server on.+         -> ([(String,String)] -> IO Html)+         -> IO ()+pwrapper pid f = do sock <- listenOn pid+                    acceptConnections fn sock+ where fn h = run h h f++acceptConnections :: (Handle -> IO ()) -> Socket -> IO ()+acceptConnections fn sock = do+  (h, SockAddrInet _ _) <- accept' sock+  forkIO (fn h `finally` (hClose h))+  acceptConnections fn sock++accept' :: Socket                 -- Listening Socket+       -> IO (Handle,SockAddr)        -- StdIO Handle for read/write+accept' sock = do+ (sock', addr) <- Socket.accept sock+ handle        <- socketToHandle sock' ReadWriteMode+ return (handle,addr)++run :: MonadIO m => Handle -> Handle -> ([(String,String)] -> IO Html) -> m ()+run inh outh f = +    do env <- getCGIVars+       hRunCGI env inh outh f'+  where f' req = do let vs = Map.toList (cgiVars req) +                        is = [ (n,BS.unpack (inputValue i)) | (n,i) <- cgiInputs req ]+                    html <- liftIO (f (vs++is))+                    return ([], CGIOutput $ BS.pack $ renderHtml html)++-- | Note: if using Windows, you might need to wrap 'Network.withSocketsDo' around main.+connectToCGIScript :: String -> PortID -> IO ()+connectToCGIScript host portId+     = do env <- getCGIVars+          input <- BS.hGetContents stdin+          let str = getRequestInput env input+          h <- connectTo host portId+                 `Exception.catch`+                   (\ e -> abort "Cannot connect to CGI daemon." e)+          BS.hPut h str >> hPutStrLn h ""+          (sendBack h `finally` hClose h)+               `Prelude.catch` (\e -> unless (isEOFError e) (ioError e))++-- | Returns the query string, or the request body if it is+--   a POST request, or the empty string if there is an error.+getRequestInput :: [(String,String)] -- ^ CGI environment variables.+                -> ByteString            -- ^ Request body.+                -> ByteString            -- ^ Query string.+getRequestInput env req =+   case lookup "REQUEST_METHOD" env of+      Just "POST" -> takeInput env req+      _ -> maybe BS.empty BS.pack (lookup "QUERY_STRING" env)++abort :: String -> Exception -> IO a+abort msg e =+    do putStrLn ("Content-type: text/html\n\n" +++                   "<html><body>" ++ msg ++ "</body></html>")+       throw e++sendBack :: Handle -> IO ()+sendBack h = do s <- hGetLine h+                putStrLn s+                sendBack h

@@ -1,5 +1,5 @@ Name: cgi-Version: 3001.1.5.1+Version: 3001.1.5.2 Copyright: Bjorn Bringert, Andy Gill, Ian Lynagh, Erik Meijer,             Sven Panne, Jeremy Shaw Maintainer: bjorn@bringert.net@@ -20,7 +20,8 @@     Network.CGI,     Network.CGI.Monad,     Network.CGI.Protocol,-    Network.CGI.Cookie+    Network.CGI.Cookie,+    Network.CGI.Compat   Other-modules:     Network.CGI.Multipart,     Network.CGI.RFC822Headers