hsp-cgi (empty) → 0.4

raw patch · 6 files changed

+237/−0 lines, 6 filesdep +basedep +containersdep +harpsetup-changed

Dependencies added: base, containers, harp, hsp, network

Files

HSP/CGI/CGIEnv.hs +126/−0
HSP/CGI/NumberGen.hs +16/−0
HSP/CGI/RunCGI.hs +41/−0
LICENSE +28/−0
Setup.hs +2/−0
hsp-cgi.cabal +24/−0

+ 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

+ 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

+ 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

+ LICENSE view

@@ -0,0 +1,28 @@+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ hsp-cgi.cabal view

@@ -0,0 +1,24 @@+Name:                   hsp-cgi+Version:                0.4+License:                BSD3+License-File:           LICENSE+Author:                 Niklas Broberg+Maintainer:             Niklas Broberg <nibro@cs.chalmers.se>++Stability:              Experimental+Category:               Language+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-Type:             Simple+Tested-With:            GHC==6.8.3++Exposed-Modules:        HSP.CGI.RunCGI+Other-Modules:		HSP.CGI.CGIEnv, HSP.CGI.NumberGen++GHC-Options:            -F -pgmFtrhsx -Wall+Extensions:             PatternGuards