1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
|
-- Prints the values of all CGI variables and inputs.
import Network.CGI
( CGI, CGIResult, runCGI, output, setHeader, getMultiInput
, serverName, serverPort, getInputFilename, requestMethod, pathInfo
, pathTranslated, scriptName, remoteHost, remoteAddr, remoteUser
, queryString, authType, requestContentType, requestContentLength
, requestHeader, progURI, queryURI, requestURI, getVars, getInputNames
)
import Data.List (intercalate)
prInput :: String -> CGI String
prInput i =
do
vs <- getMultiInput i
let v = intercalate "," $ map show vs
f <- getInputFilename i
return $ case f of
Just n -> i ++ ": File\nfilename=" ++ n
++ "\ncontents=" ++ v
Nothing -> i ++ ": " ++ v
envFuns :: CGI [(String, String)]
envFuns = sequence
[
f "serverName" serverName,
f "serverPort" (fmap show serverPort),
f "requestMethod" requestMethod,
f "pathInfo" pathInfo,
f "pathTranslated" pathTranslated,
f "scriptName" scriptName,
f "queryString" queryString,
f "remoteHost" remoteHost,
f "remoteAddr" remoteAddr,
f "authType" authType,
f "remoteUser" remoteUser,
f "requestContentType" requestContentType ,
f "requestContentLength" requestContentLength,
f "requestHeader \"User-Agent\"" (requestHeader "User-Agent"),
f "progURI" progURI,
f "queryURI" queryURI,
f "requestURI" requestURI
]
where f n = fmap ((,) n . show)
prVars :: [(String, String)] -> String
prVars vs = unlines [k ++ ": " ++ x | (k,x) <- vs ]
cgiMain :: CGI CGIResult
cgiMain = do fs <- envFuns
vs <- getVars
is <- getInputNames
i <- mapM prInput is
setHeader "Content-type" "text/plain"
output ("Environment:\n" ++ prVars fs
++ "\nCGI Environment Variables:\n" ++ prVars vs
++ "\nInputs:\n" ++ unlines i)
main :: IO ()
main = runCGI cgiMain
|