hsp-cgi 0.4 → 0.4.4
raw patch · 7 files changed
+188/−187 lines, 7 filesdep ~hsp
Dependency ranges changed: hsp
Files
- HSP/CGI/CGIEnv.hs +0/−126
- HSP/CGI/NumberGen.hs +0/−16
- HSP/CGI/RunCGI.hs +0/−41
- hsp-cgi.cabal +5/−4
- src/HSP/CGI/CGIEnv.hs +126/−0
- src/HSP/CGI/NumberGen.hs +16/−0
- src/HSP/CGI/RunCGI.hs +41/−0
− HSP/CGI/CGIEnv.hs
@@ -1,126 +0,0 @@-module HSP.CGI.CGIEnv (- CGIEnv,- CGIVariable,- getCGIReq- ) where--import System.Environment (getEnv)-import System.IO.Error (isDoesNotExistError)-import Control.Exception (Exception(..), catch, throw)-import Network.URI (unEscapeString)-import Prelude hiding (catch)--import qualified Data.Map as M--import HSP.Env.Request--type CGIEnv = ([CGIVariable],RequestBody)-type CGIVariable = (VariableName, Value)-type VariableName = String-type Value = String-type RequestBody = String--getCGIReq :: IO Request-getCGIReq = fmap newCGIReq getCGIVars- --getCGIVars :: IO CGIEnv-getCGIVars = do f <- mapM getCGIVar cgiVars- s <- getContents- return (f,s)--getCGIVar :: VariableName -> IO CGIVariable-getCGIVar name- = do vv <- getEnv name `catch` handleException- return $ (name, vv)- where- handleException :: Exception -> IO Value- handleException (IOException e)- | isDoesNotExistError e = return ""- handleException e = throw e--cgiVars :: [VariableName]-cgiVars- = [ - -- environment variables as specified by CGI/1.1- "SERVER_SOFTWARE"- , "SERVER_NAME"- , "GATEWAY_INTERFACE"- , "SERVER_PROTOCOL"- , "SERVER_PORT"- , "REQUEST_METHOD"- , "PATH_INFO"- , "PATH_TRANSLATED"- , "SCRIPT_NAME"- , "QUERY_STRING"- , "REMOTE_HOST"- , "REMOTE_ADDR"- , "AUTH_TYPE"- , "REMOTE_USER"- , "REMOTE_IDENT"- , "CONTENT_TYPE"- , "CONTENT_LENGTH"- -- environment variables for general HTTP headers, rfc2616- , "HTTP_CACHE_CONTROL"- , "HTTP_CONNECTION"- , "HTTP_DATE"- , "HTTP_PRAGMA"- , "HTTP_TRAILER"- , "HTTP_TRANSFER_ENCODING"- , "HTTP_UPGRADE"- , "HTTP_VIA"- , "HTTP_WARNING"- -- environment variables for request HTTP headers, rfc2616- , "HTTP_ACCEPT"- , "HTTP_ACCEPT_CHARSET"- , "HTTP_ACCEPT_ENCODING"- , "HTTP_ACCECPT_LANGUAGE"- , "HTTP_AUTHORIZATION"- , "HTTP_EXPECT"- , "HTTP_FROM"- , "HTTP_HOST"- , "HTTP_IF_MATCH"- , "HTTP_IF_MODIFIED_SINCE"- , "HTTP_IF_NONE_MATCH"- , "HTTP_IF_RANGE"- , "HTTP_IF_UNMODIFIED_SINCE"- , "HTTP_MAX_FORWARDS"- , "HTTP_PROXY_AUTHORIZATION"- , "HTTP_RANGE"- , "HTTP_REFERER"- , "HTTP_TE"- , "HTTP_USER_AGENT"- -- environment variable for request HTTP header "Cookie", rfc 2109- , "HTTP_COOKIE"- ]--newCGIReq :: CGIEnv -> Request-newCGIReq cgienv@(rvars,_) =- let vars = case lookup "REQUEST_METHOD" rvars of- Just "POST" -> newCGIPostReq cgienv- _ -> newCGIGetReq rvars- in Request { - getParameterL = (\s -> maybe [] id $ M.lookup s vars),- getHeaders = fst cgienv }--newCGIGetReq :: [CGIVariable] -> M.Map String [String]-newCGIGetReq cgienv =- case lookup "QUERY_STRING" cgienv of- Just qs -> M.fromListWith (++) $ qsToVars qs- Nothing -> M.empty--newCGIPostReq :: CGIEnv -> M.Map String [String]-newCGIPostReq (cgienv,rbody) =- case lookup "CONTENT_LENGTH" cgienv of- -- if content length is not a valid int an exception is thrown- Just l -> M.fromListWith (++) $ qsToVars $ take (read l) rbody- Nothing -> M.empty--qsToVars :: String -> [(String, [String])]-qsToVars [/ ks@_+, '=', vs@_*, (/ '&', kss@:_+, '=', vss@:_* /)* /] - = zip (ks:kss) $ map (\s -> [unEscape s]) (vs:vss) -- TODO: List values?-qsToVars "" = []-qsToVars _ = [] -- TODO: What if there's an error?--unEscape :: String -> String-unEscape s = unEscapeString $ map (\ch -> if ch == '+' then ' ' else ch) s
− HSP/CGI/NumberGen.hs
@@ -1,16 +0,0 @@-module HSP.CGI.NumberGen - ( - mkNumberGen - - ) where - -import HSP.Env.NumberGen - -import Data.IORef - -mkNumberGen :: IO NumberGen -mkNumberGen = do - ref <- newIORef 0 - let inc x = (x+1, x) - gen = atomicModifyIORef ref inc - return $ NumberGen gen
− HSP/CGI/RunCGI.hs
@@ -1,41 +0,0 @@-module HSP.CGI.RunCGI (runCGI) where--import Prelude hiding (catch)--import System.IO (stdout, hPutStr)-import Control.Exception -- (Exception, catch, finally)--import HSP hiding (catch)-import HSP.Env.Request (Request)-import HSP.CGI.CGIEnv (getCGIReq)-import HSP.CGI.NumberGen (mkNumberGen)---runCGI :: HSP XML -> IO ()-runCGI page - = (getCGIReq >>= evalCGI page >>= sendCGIResponse)- `catch` handleError- `finally` return ()---evalCGI :: HSP XML -> Request -> IO CGIResponse-evalCGI page req = do- gen <- mkNumberGen- runHSP page (HSPEnv req gen) >>= return . cgiResponse . renderXML---type CGIResponse = String--cgiResponse :: String -> CGIResponse-cgiResponse body =- "Content-length: " ++ show (length body) ++- "\nContent-type: text/html" ++- "\n\n" ++- body--sendCGIResponse :: CGIResponse -> IO ()-sendCGIResponse = hPutStr stdout--handleError :: Exception -> IO ()-handleError ex = case ex of- _ -> sendCGIResponse $ "Error: " ++ show ex
hsp-cgi.cabal view
@@ -1,24 +1,25 @@ Name: hsp-cgi-Version: 0.4+Version: 0.4.4 License: BSD3 License-File: LICENSE Author: Niklas Broberg Maintainer: Niklas Broberg <nibro@cs.chalmers.se> Stability: Experimental-Category: Language+Category: Web, Network Synopsis: Facilitates running Haskell Server Pages web pages as CGI programs. Description: Haskell Server Pages (HSP) is an extension of vanilla Haskell, targetted at the task of writing dynamic server-side web pages. This module provides facilities to allow such pages to be run as CGI programs. Homepage: http://code.google.com/p/hsp -Build-Depends: base>3, hsp>=0.4, network, containers, harp+Build-Depends: base>3, hsp>=0.4.4, network, containers, harp Build-Type: Simple Tested-With: GHC==6.8.3 +Hs-Source-Dirs: src Exposed-Modules: HSP.CGI.RunCGI-Other-Modules: HSP.CGI.CGIEnv, HSP.CGI.NumberGen+Other-Modules: HSP.CGI.CGIEnv, HSP.CGI.NumberGen GHC-Options: -F -pgmFtrhsx -Wall Extensions: PatternGuards
+ src/HSP/CGI/CGIEnv.hs view
@@ -0,0 +1,126 @@+module HSP.CGI.CGIEnv (+ CGIEnv,+ CGIVariable,+ getCGIReq+ ) where++import System.Environment (getEnv)+import System.IO.Error (isDoesNotExistError)+import Control.Exception (Exception(..), catch, throw)+import Network.URI (unEscapeString)+import Prelude hiding (catch)++import qualified Data.Map as M++import HSP.Env.Request++type CGIEnv = ([CGIVariable],RequestBody)+type CGIVariable = (VariableName, Value)+type VariableName = String+type Value = String+type RequestBody = String++getCGIReq :: IO Request+getCGIReq = fmap newCGIReq getCGIVars+ ++getCGIVars :: IO CGIEnv+getCGIVars = do f <- mapM getCGIVar cgiVars+ s <- getContents+ return (f,s)++getCGIVar :: VariableName -> IO CGIVariable+getCGIVar name+ = do vv <- getEnv name `catch` handleException+ return $ (name, vv)+ where+ handleException :: Exception -> IO Value+ handleException (IOException e)+ | isDoesNotExistError e = return ""+ handleException e = throw e++cgiVars :: [VariableName]+cgiVars+ = [ + -- environment variables as specified by CGI/1.1+ "SERVER_SOFTWARE"+ , "SERVER_NAME"+ , "GATEWAY_INTERFACE"+ , "SERVER_PROTOCOL"+ , "SERVER_PORT"+ , "REQUEST_METHOD"+ , "PATH_INFO"+ , "PATH_TRANSLATED"+ , "SCRIPT_NAME"+ , "QUERY_STRING"+ , "REMOTE_HOST"+ , "REMOTE_ADDR"+ , "AUTH_TYPE"+ , "REMOTE_USER"+ , "REMOTE_IDENT"+ , "CONTENT_TYPE"+ , "CONTENT_LENGTH"+ -- environment variables for general HTTP headers, rfc2616+ , "HTTP_CACHE_CONTROL"+ , "HTTP_CONNECTION"+ , "HTTP_DATE"+ , "HTTP_PRAGMA"+ , "HTTP_TRAILER"+ , "HTTP_TRANSFER_ENCODING"+ , "HTTP_UPGRADE"+ , "HTTP_VIA"+ , "HTTP_WARNING"+ -- environment variables for request HTTP headers, rfc2616+ , "HTTP_ACCEPT"+ , "HTTP_ACCEPT_CHARSET"+ , "HTTP_ACCEPT_ENCODING"+ , "HTTP_ACCECPT_LANGUAGE"+ , "HTTP_AUTHORIZATION"+ , "HTTP_EXPECT"+ , "HTTP_FROM"+ , "HTTP_HOST"+ , "HTTP_IF_MATCH"+ , "HTTP_IF_MODIFIED_SINCE"+ , "HTTP_IF_NONE_MATCH"+ , "HTTP_IF_RANGE"+ , "HTTP_IF_UNMODIFIED_SINCE"+ , "HTTP_MAX_FORWARDS"+ , "HTTP_PROXY_AUTHORIZATION"+ , "HTTP_RANGE"+ , "HTTP_REFERER"+ , "HTTP_TE"+ , "HTTP_USER_AGENT"+ -- environment variable for request HTTP header "Cookie", rfc 2109+ , "HTTP_COOKIE"+ ]++newCGIReq :: CGIEnv -> Request+newCGIReq cgienv@(rvars,_) =+ let vars = case lookup "REQUEST_METHOD" rvars of+ Just "POST" -> newCGIPostReq cgienv+ _ -> newCGIGetReq rvars+ in Request { + getParameterL = (\s -> maybe [] id $ M.lookup s vars),+ getHeaders = fst cgienv }++newCGIGetReq :: [CGIVariable] -> M.Map String [String]+newCGIGetReq cgienv =+ case lookup "QUERY_STRING" cgienv of+ Just qs -> M.fromListWith (++) $ qsToVars qs+ Nothing -> M.empty++newCGIPostReq :: CGIEnv -> M.Map String [String]+newCGIPostReq (cgienv,rbody) =+ case lookup "CONTENT_LENGTH" cgienv of+ -- if content length is not a valid int an exception is thrown+ Just l -> M.fromListWith (++) $ qsToVars $ take (read l) rbody+ Nothing -> M.empty++qsToVars :: String -> [(String, [String])]+qsToVars [ ks@_+, '=', vs@_*, (| '&', kss@:_+, '=', vss@:_* |)* ] + = zip (ks:kss) $ map (\s -> [unEscape s]) (vs:vss) -- TODO: List values?+qsToVars "" = []+qsToVars _ = [] -- TODO: What if there's an error?++unEscape :: String -> String+unEscape s = unEscapeString $ map (\ch -> if ch == '+' then ' ' else ch) s
+ src/HSP/CGI/NumberGen.hs view
@@ -0,0 +1,16 @@+module HSP.CGI.NumberGen + ( + mkNumberGen + + ) where + +import HSP.Env.NumberGen + +import Data.IORef + +mkNumberGen :: IO NumberGen +mkNumberGen = do + ref <- newIORef 0 + let inc x = (x+1, x) + gen = atomicModifyIORef ref inc + return $ NumberGen gen
+ src/HSP/CGI/RunCGI.hs view
@@ -0,0 +1,41 @@+module HSP.CGI.RunCGI (runCGI) where++import Prelude hiding (catch)++import System.IO (stdout, hPutStr)+import Control.Exception -- (Exception, catch, finally)++import HSP hiding (catch)+import HSP.Env.Request (Request)+import HSP.CGI.CGIEnv (getCGIReq)+import HSP.CGI.NumberGen (mkNumberGen)+++runCGI :: HSP XML -> IO ()+runCGI page + = (getCGIReq >>= evalCGI page >>= sendCGIResponse)+ `catch` handleError+ `finally` return ()+++evalCGI :: HSP XML -> Request -> IO CGIResponse+evalCGI page req = do+ gen <- mkNumberGen+ runHSP page (HSPEnv req gen) >>= return . cgiResponse . renderXML+++type CGIResponse = String++cgiResponse :: String -> CGIResponse+cgiResponse body =+ "Content-length: " ++ show (length body) +++ "\nContent-type: text/html" +++ "\n\n" +++ body++sendCGIResponse :: CGIResponse -> IO ()+sendCGIResponse = hPutStr stdout++handleError :: Exception -> IO ()+handleError ex = case ex of+ _ -> sendCGIResponse $ "Error: " ++ show ex