sscgi (empty) → 0.1.0
raw patch · 4 files changed
+181/−0 lines, 4 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, case-insensitive, containers, mtl, transformers
Files
- LICENSE +30/−0
- Network/SCGI.hs +116/−0
- Setup.hs +2/−0
- sscgi.cabal +33/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Chris Forno (jekor)++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Chris Forno (jekor) nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 COPYRIGHT+OWNER 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.
+ Network/SCGI.hs view
@@ -0,0 +1,116 @@+-- Copyright 2013 Chris Forno++module Network.SCGI (SCGI, runRequest, header, allHeaders, method, path, setHeader, Headers, Body, Status, Response(..)) where++import Control.Applicative ((<$>), (<*>), (<*))+import Control.Arrow (first)+import Control.Monad (liftM, liftM2)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (ReaderT, runReaderT, MonadReader, asks)+import Control.Monad.State (StateT, runStateT, MonadState, modify)+import Data.Attoparsec.ByteString.Char8 (Parser, IResult(..), parseOnly, parseWith, char, decimal, take, takeTill)+import Data.Attoparsec.Combinator (many1)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 ()+import Data.Char (toUpper)+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import Data.Map (Map)+import qualified Data.Map as M+import System.IO (Handle)++import Prelude hiding (take)++type Headers = Map (CI B.ByteString) B.ByteString+type Body = BL.ByteString+type Status = BL.ByteString+data Response = Response Status Body++newtype SCGI a = SCGI (ReaderT Headers (StateT Headers IO) a)+ deriving (Functor, Monad, MonadIO, MonadState Headers, MonadReader Headers)++runSCGI :: Headers -> SCGI Response -> IO (Response, Headers)+runSCGI headers (SCGI r) = runStateT (runReaderT r headers) M.empty++-- |Lookup a request header.+header :: B.ByteString -- ^ the header name (key)+ -> SCGI (Maybe B.ByteString) -- ^ the header value if found+header name = asks (M.lookup (CI.mk name))++-- |Return all request headers as a list in the format they were received from the web server.+allHeaders :: SCGI [(B.ByteString, B.ByteString)] -- ^ an association list of header: value pairs+allHeaders = asks (map (first CI.original) . M.toList)++-- |Get the request method (GET, POST, etc.). You could look the header up+-- yourself, but this normalizes the method name to uppercase.+method :: SCGI (Maybe B.ByteString) -- ^ the method if found+method = liftM (B8.map toUpper) `liftM` header "REQUEST_METHOD"++-- |Get the requested path. According to the spec, this can be complex, and+-- actual CGI implementations diverge from the spec. I've found this to work,+-- even though it doesn't seem correct or intuitive.+path :: SCGI (Maybe B.ByteString) -- ^ the path if found+path = do+ path1 <- header "SCRIPT_NAME"+ path2 <- header "PATH_INFO"+ return $ liftM2 B.append path1 path2++-- |Set a response header.+setHeader :: B.ByteString -- ^ the header name (key)+ -> B.ByteString -- ^ the header value+ -> SCGI ()+setHeader name value = modify (M.insert (CI.mk name) value)++-- |Run a request in the SCGI monad.+runRequest :: Handle -- ^ the handle connected to the web server (from 'accept')+ -> (Body -> SCGI Response) -- ^ the action to run in the SCGI monad+ -> IO () -- ^ nothing is returned, the result of the action is written back to the server+runRequest h f = do+ -- Note: This could potentially read any amount of data into memory.+ -- For now, I'm leaving it up to the SCGI implementation in the server to block large header payloads.+ --+ -- First, parse the netstring containing the headers. If we tried to avoid this step the syntax for+ -- the headers would be ambiguous.+ result <- parseWith (B.hGetSome h 4096) netstringParser ""+ case result of+ Done rest headerString ->+ case parseOnly (many1 headerParser) headerString of+ Left e -> error e+ Right headers -> do+ -- CONTENT_LENGTH is required by the SCGI spec. Without it, we+ -- wouldn't know when we'd reached the end of the request.+ --+ -- The header Map uses case-insensitive keys.+ let headerMap = M.fromList $ map (first CI.mk) headers+ len' = B8.readInt $ M.findWithDefault (error "CONTENT_LENGTH missing from request") "CONTENT_LENGTH" headerMap+ case len' of+ Just (len, _) -> do+ -- We have probably read past the end of the header. Take the+ -- rest of the unparsed string and what remains to be read+ -- (determined from the CONTENT_LENGTH) and make that the body.+ let c = fromIntegral (len - B.length rest)+ body <- (BL.fromChunks [rest] `BL.append`) `liftM` (if c > 0 then BL.hGet h c else return "")+ (Response status body', headers') <- runSCGI headerMap (f body)+ -- Every SCGI response must include a status line first.+ BL.hPutStr h $ BL.concat ["Status: ", status, "\r\n"]+ -- Output the headers returned by the SCGI action.+ mapM_ (\(k, v) -> B.hPutStr h $ B.concat [CI.original k, ": ", v, "\r\n"]) $ M.toList headers'+ BL.hPutStr h "\r\n"+ -- Finally, output the body.+ BL.hPutStr h body'+ _ -> error "Failed to parse CONTENT_LENGTH."+ _ -> error "Failed to parse SCGI request."++-- http://cr.yp.to/proto/netstrings.txt+netstringParser :: Parser B.ByteString+netstringParser = do+ count <- decimal <* char ':'+ take count <* char ','++headerParser :: Parser (B.ByteString, B.ByteString)+headerParser = (,) <$> cStringParser <*> cStringParser++cStringParser :: Parser B.ByteString+cStringParser = takeTill (== '\NUL') <* char '\NUL'
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ sscgi.cabal view
@@ -0,0 +1,33 @@+name: sscgi+version: 0.1.0+synopsis: Simple SCGI Library+description: This is a simple implementation of the SCGI protocol without support for the Network.CGI interface.+homepage: https://github.com/jekor/haskell-sscgi+bug-reports: https://github.com/jekor/haskell-sscgi/issues+license: BSD3+license-file: LICENSE+author: Chris Forno (jekor)+maintainer: jekor@jekor.com+stability: alpha+category: Network+build-type: Simple+cabal-version: >=1.8+tested-with: GHC == 7.4.1++source-repository head+ type: git+ location: git://github.com/jekor/haskell-sscgi.git++library+ exposed-modules: Network.SCGI+ -- other-modules: + build-depends: base >= 4 && < 6,+ attoparsec,+ bytestring,+ case-insensitive,+ containers,+ mtl,+ transformers+ extensions: GeneralizedNewtypeDeriving,+ OverloadedStrings+ ghc-options: -Wall -fno-warn-type-defaults