cgi 3001.1.3 → 3001.1.4
raw patch · 3 files changed
+43/−66 lines, 3 filessetup-changed
Files
- Network/CGI.hs +39/−8
- Setup.hs +2/−56
- cgi.cabal +2/−2
Network/CGI.hs view
@@ -92,7 +92,8 @@ import Data.List (intersperse, sort, group) import Data.Maybe (fromMaybe) import qualified Data.Map as Map-import Network.URI (URI(..), URIAuth(..), nullURI, parseRelativeReference)+import Network.URI (URI(..), URIAuth(..), nullURI, parseRelativeReference, + escapeURIString, isUnescapedInURI) import System.IO (stdin, stdout) import System.IO.Error (isUserError, ioeGetErrorString) @@ -284,22 +285,36 @@ -- CGI program path. -- If the string returned by this function is not empty, -- it is guaranteed to start with a @\'\/\'@.+--+-- Note that this function returns an unencoded string.+-- Make sure to percent-encode any characters+-- that are not allowed in URI paths before using the result of+-- this function to construct a URI.+-- See 'progURI', 'queryURI' and 'requestURI' for a higher-level+-- interface. pathInfo :: MonadCGI m => m String pathInfo = liftM slash $ getVarWithDefault "PATH_INFO" "" where slash s = if not (null s) && head s /= '/' then '/':s else s --- | The path returned by 'pathInfo', but with any virtual-to-physical+-- | The path returned by 'pathInfo', but with virtual-to-physical -- mapping applied to it. pathTranslated :: MonadCGI m => m String pathTranslated = getVarWithDefault "PATH_TRANSLATED" "" --- | A virtual path to the script being executed, --- used for self-referencing URLs.+-- | A virtual path to the script being executed, +-- used for self-referencing URIs. +--+-- Note that this function returns an unencoded string.+-- Make sure to percent-encode any characters+-- that are not allowed in URI paths before using the result of+-- this function to construct a URI.+-- See 'progURI', 'queryURI' and 'requestURI' for a higher-level+-- interface. scriptName :: MonadCGI m => m String scriptName = getVarWithDefault "SCRIPT_NAME" "" -- | The information which follows the ? in the URL which referenced --- this program. This is the encoded query information.+-- this program. This is the percent-encoded query information. -- For most normal uses, 'getInput' and friends are probably -- more convenient. queryString :: MonadCGI m => m String@@ -359,6 +374,9 @@ -- If the server is rewriting request URIs, this URI can -- be different from the one requested by the client. -- See also 'requestURI'.+--+-- Characters in the components of the returned URI are escaped +-- when needed, as required by "Network.URI". progURI :: MonadCGI m => m URI progURI = do -- Use HTTP_HOST if available, otherwise SERVER_NAME@@ -384,29 +402,42 @@ uriPort = port } return $ nullURI { uriScheme = if https then "https:" else "http:", uriAuthority = Just auth,- uriPath = name }+ uriPath = escapePath name } -- | Like 'progURI', but the returned 'URI' also includes -- any extra path information, and any query parameters. -- If the server is rewriting request URIs, this URI can -- be different from the one requested by the client. -- See also 'requestURI'.+--+-- Characters in the components of the returned URI are escaped +-- when needed, as required by "Network.URI". queryURI :: MonadCGI m => m URI queryURI = do uri <- progURI path <- pathInfo qs <- liftM (\q -> if null q then q else '?':q) $ queryString- return $ uri { uriPath = uriPath uri ++ path, uriQuery = qs } + return $ uri { uriPath = uriPath uri ++ escapePath path, + uriQuery = qs } +-- | Does percent-encoding as needed for URI path components.+escapePath :: String -> String+escapePath = escapeURIString isUnescapedInURIPath+ where isUnescapedInURIPath c = isUnescapedInURI c && c `notElem` "?#"+ -- | Attempts to reconstruct the absolute URI requested by the client, -- including extra path information and query parameters. -- If no request URI rewriting is done, or if the web server does not -- provide the information needed to reconstruct the request URI, -- this function returns the same value as 'queryURI'.+--+-- Characters in the components of the returned URI are escaped +-- when needed, as required by "Network.URI". requestURI :: MonadCGI m => m URI requestURI = do uri <- queryURI- -- Apache sets REQUEST_URI to the original request URI+ -- Apache sets REQUEST_URI to the original request URI,+ -- with percent-encoding intact. mreq <- liftM (>>= parseRelativeReference) $ getVar "REQUEST_URI" return $ case mreq of Nothing -> uri
Setup.hs view
@@ -1,58 +1,4 @@--module Main (main) where+#!/usr/bin/env runghc -import Data.List import Distribution.Simple-import Distribution.PackageDescription-import Distribution.Setup-import Distribution.Simple.LocalBuildInfo-import System.Environment--main :: IO ()-main = do args <- getArgs- let (ghcArgs, args') = extractGhcArgs args- (_, args'') = extractConfigureArgs args'- hooks = defaultUserHooks {- buildHook = add_ghc_options ghcArgs- $ buildHook defaultUserHooks }- withArgs args'' $ defaultMainWithHooks hooks--extractGhcArgs :: [String] -> ([String], [String])-extractGhcArgs = extractPrefixArgs "--ghc-option="--extractConfigureArgs :: [String] -> ([String], [String])-extractConfigureArgs = extractPrefixArgs "--configure-option="--extractPrefixArgs :: String -> [String] -> ([String], [String])-extractPrefixArgs the_prefix args- = let f [] = ([], [])- f (x:xs) = case f xs of- (wantedArgs, otherArgs) ->- case removePrefix the_prefix x of- Just wantedArg ->- (wantedArg:wantedArgs, otherArgs)- Nothing ->- (wantedArgs, x:otherArgs)- in f args--removePrefix :: String -> String -> Maybe String-removePrefix "" ys = Just ys-removePrefix _ "" = Nothing-removePrefix (x:xs) (y:ys)- | x == y = removePrefix xs ys- | otherwise = Nothing--type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()--add_ghc_options :: [String] -> Hook a -> Hook a-add_ghc_options args f pd lbi uhs x- = do let lib' = case library pd of- Just lib ->- let bi = libBuildInfo lib- opts = options bi ++ [(GHC, args)]- bi' = bi { options = opts }- in lib { libBuildInfo = bi' }- Nothing -> error "Expected a library"- pd' = pd { library = Just lib' }- f pd' lbi uhs x-+main = defaultMain
cgi.cabal view
@@ -1,12 +1,12 @@ Name: cgi-Version: 3001.1.3+Version: 3001.1.4 Copyright: Bjorn Bringert, Andy Gill, Ian Lynagh, Erik Meijer, Sven Panne, Jeremy Shaw Maintainer: bjorn@bringert.net Author: Bjorn Bringert License: BSD3 License-file: LICENSE-Build-depends: base >= 2.0, network>=2.0, parsec >= 2.0, mtl >= 1.0, xhtml >= 3000.0.0+Build-depends: base >= 2.0, network>=2.0, parsec >= 2.0, mtl >= 1.0, xhtml >= 3000.0.0 Extensions: MultiParamTypeClasses Synopsis: A library for writing CGI programs Description: