diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2009 Dan Knapp + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the "Software"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/Network/FastCGI.hs b/Network/FastCGI.hs new file mode 100644 --- /dev/null +++ b/Network/FastCGI.hs @@ -0,0 +1,1925 @@ +{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable #-} +module Network.FastCGI ( + -- * The monad + FastCGI, + MonadFastCGI, + FastCGIState, + getFastCGIState, + + -- * Accepting requests + acceptLoop, + + -- * Logging + fLog, + + -- * Request information + -- | It is common practice for web servers to make their own extensions to + -- the CGI/1.1 set of defined variables. For example, @REMOTE_PORT@ is + -- not defined by the specification, but often seen in the wild. + -- Furthermore, it is also common for user agents to make their own + -- extensions to the HTTP/1.1 set of defined headers. Therefore, there + -- are two levels of call available. Defined variables and headers may + -- be interrogated directly, and in addition, there are higher-level + -- calls which give convenient names and types to the same information. + -- + -- Cookies may also be manipulated through HTTP headers directly; the + -- functions here are provided only as a convenience. + getRequestVariable, + getAllRequestVariables, + Header(..), + getRequestHeader, + getAllRequestHeaders, + Cookie(..), + getCookie, + getAllCookies, + getCookieValue, + getDocumentRoot, + getGatewayInterface, + getPathInfo, + getPathTranslated, + getQueryString, + getRedirectStatus, + getRedirectURI, + getRemoteAddress, + getRemotePort, + getRemoteHost, + getRemoteIdent, + getRemoteUser, + getRequestMethod, + getRequestURI, + getScriptFilename, + getScriptName, + getServerAddress, + getServerName, + getServerPort, + getServerProtocol, + getServerSoftware, + getAuthenticationType, + getContentLength, + getContentType, + + -- * Request content data + -- | At the moment the handler is invoked, all request headers have been + -- received, but content data has not necessarily been. Requests to read + -- content data block the handler (but not other concurrent handlers) + -- until there is enough data in the buffer to satisfy them, or until + -- timeout where applicable. + fGet, + fGetNonBlocking, + fGetContents, + fIsReadable, + + -- * Response information and content data + -- | When the handler is first invoked, neither response headers nor + -- content data have been sent to the client. Setting of response + -- headers is lazy, merely setting internal variables, until something + -- forces them to be output. For example, attempting to send content + -- data will force response headers to be output first. It is not + -- necessary to close the output stream explicitly, but it may be + -- desirable, for example to continue processing after returning results + -- to the user. + -- + -- There is no reason that client scripts cannot use any encoding they + -- wish, including the chunked encoding, if they have set appropriate + -- headers. This package, however, does not explicitly support that, + -- because client scripts can easily implement it for themselves. + -- + -- At the start of each request, the response status is set to @200 OK@ + -- and the only response header set is @Content-Type: text/html@. These + -- may be overridden by later calls, at any time before headers have + -- been sent. + -- + -- Cookies may also be manipulated through HTTP headers directly; the + -- functions here are provided only as a convenience. + setResponseStatus, + getResponseStatus, + setResponseHeader, + unsetResponseHeader, + getResponseHeader, + setCookie, + unsetCookie, + mkSimpleCookie, + mkCookie, + permanentRedirect, + seeOtherRedirect, + sendResponseHeaders, + responseHeadersSent, + fPut, + fPutStr, + fCloseOutput, + fIsWritable, + + -- * Exceptions + -- Because it is not possible for user code to enter the FastCGI monad + -- from outside it, catching exceptions in IO will not work. Therefore + -- a full set of exception primitives designed to work with any + -- 'MonadFastCGI' instance is provided. + FastCGIException(..), + fThrow, + fCatch, + fBlock, + fUnblock, + fBracket, + fFinally, + fTry, + fHandle, + fOnException + ) + where + +import Control.Concurrent +import qualified Control.Exception as Exception +import Control.Monad.Reader +import Data.Bits +import qualified Data.ByteString as BS +import qualified Data.ByteString.UTF8 as BS (toString, fromString) +import Data.Char +import Data.List +import qualified Data.Map as Map +import Data.Maybe +import Data.Typeable +import Data.Word +import Foreign.C.Error +import GHC.IO.Exception (IOErrorType(..)) +import qualified Network.Socket as Network hiding (send, sendTo, recv, recvFrom) +import qualified Network.Socket.ByteString as Network +import Prelude hiding (catch) +import System.Environment +import System.IO.Error (ioeGetErrorType) +import qualified System.IO.Error as System + + +-- | An opaque type representing the state of a single connection from the web server. +data FastCGIState = FastCGIState { + webServerAddresses :: Maybe [Network.HostAddress], + socket :: Network.Socket, + peer :: Network.SockAddr, + requestChannelMapMVar :: MVar (Map.Map Int (Chan Record)), + request :: Maybe Request + } + + +data Request = Request { + requestID :: Int, + requestChannel :: Chan Record, + paramsStreamBufferMVar :: MVar BS.ByteString, + stdinStreamBufferMVar :: MVar BS.ByteString, + stdinStreamClosedMVar :: MVar Bool, + requestEndedMVar :: MVar Bool, + requestVariableMapMVar :: MVar (Map.Map String String), + requestHeaderMapMVar :: MVar (Map.Map Header String), + requestCookieMapMVar :: MVar (Map.Map String Cookie), + responseStatusMVar :: MVar Int, + responseHeaderMapMVar :: MVar (Map.Map Header String), + responseHeadersSentMVar :: MVar Bool, + responseCookieMapMVar :: MVar (Map.Map String Cookie) + } + + +data Cookie = Cookie { + cookieName :: String, + cookieValue :: String, + cookieVersion :: Int, + cookiePath :: Maybe String, + cookieDomain :: Maybe String, + cookieMaxAge :: Maybe Int, + cookieSecure :: Bool, + cookieComment :: Maybe String + } deriving (Show) + + +-- | The monad within which each single connection from the web server is handled. +type FastCGI = ReaderT FastCGIState IO + + +-- | The class of monads within which the FastCGI calls are valid. You may wish to +-- create your own monad implementing this class. +class (MonadIO m) => MonadFastCGI m where + -- | Returns the opaque 'FastCGIState' object representing the state of the + -- FastCGI client. + -- Should not be called directly by user code, except implementations of + -- 'MonadFastCGI'; exported so that + -- user monads can implement the interface. + getFastCGIState + :: m FastCGIState + -- | Throws an exception in the monad. + -- Should not be called directly by user code; exported so that + -- user monads can implement the interface. See 'fThrow'. + implementationThrowFastCGI + :: (Exception.Exception e) + => e -- ^ The exception to throw + -> m a + -- | Perform an action in the monad, with a given exception-handler action bound. + -- Should not be called directly by user code; exported so that + -- user monads can implement the interface. See 'fCatch'. + implementationCatchFastCGI + :: (Exception.Exception e) + => m a -- ^ The action to run with the exception handler binding in scope. + -> (e -> m a) -- ^ The exception handler to bind. + -> m a + -- | Block exceptions within an action. + -- Should not be called directly by user code; exported so that + -- user monads can implement the interface. See 'fBlock'. + implementationBlockFastCGI + :: m a -- ^ The action to run with exceptions blocked. + -> m a + -- | Unblock exceptions within an action. + -- Should not be called directly by user code; exported so that + -- user monads can implement the interface. See 'fUnblock'. + implementationUnblockFastCGI + :: m a -- ^ The action to run with exceptions unblocked. + -> m a + + +instance MonadFastCGI FastCGI where + getFastCGIState = ask + implementationThrowFastCGI exception = liftIO $ Exception.throwIO exception + implementationCatchFastCGI action handler = do + state <- getFastCGIState + liftIO $ Exception.catch (runReaderT action state) + (\exception -> do + runReaderT (handler exception) state) + implementationBlockFastCGI action = do + state <- getFastCGIState + liftIO $ Exception.block (runReaderT action state) + implementationUnblockFastCGI action = do + state <- getFastCGIState + liftIO $ Exception.unblock (runReaderT action state) + + +data Record = Record { + recordType :: RecordType, + recordRequestID :: Int, + recordContent :: BS.ByteString + } deriving (Show) + + +data RecordType = BeginRequestRecord + | AbortRequestRecord + | EndRequestRecord + | ParamsRecord + | StdinRecord + | StdoutRecord + | StderrRecord + | DataRecord + | GetValuesRecord + | GetValuesResultRecord + | UnknownTypeRecord + | OtherRecord Int + deriving (Eq, Show) +instance Enum RecordType where + toEnum 1 = BeginRequestRecord + toEnum 2 = AbortRequestRecord + toEnum 3 = EndRequestRecord + toEnum 4 = ParamsRecord + toEnum 5 = StdinRecord + toEnum 6 = StdoutRecord + toEnum 7 = StderrRecord + toEnum 8 = DataRecord + toEnum 9 = GetValuesRecord + toEnum 10 = GetValuesResultRecord + toEnum 11 = UnknownTypeRecord + toEnum code = OtherRecord code + fromEnum BeginRequestRecord = 1 + fromEnum AbortRequestRecord = 2 + fromEnum EndRequestRecord = 3 + fromEnum ParamsRecord = 4 + fromEnum StdinRecord = 5 + fromEnum StdoutRecord = 6 + fromEnum StderrRecord = 7 + fromEnum DataRecord = 8 + fromEnum GetValuesRecord = 9 + fromEnum GetValuesResultRecord = 10 + fromEnum UnknownTypeRecord = 11 + + +-- | Takes a forking primitive, such as 'forkIO' or 'forkOS', and a handler, and +-- concurrently accepts requests from the web server, forking with the primitive +-- and invoking the handler in the forked thread inside the 'FastCGI' monad for each +-- one. +-- +-- It is valid to use a custom forking primitive, such as one that attempts to pool +-- OS threads, but the primitive must actually provide concurrency - otherwise there +-- will be a deadlock. There is no support for single-threaded operation. +-- +-- Note that although there is no mechanism to substitute another type of monad for +-- FastCGI, you can enter your own monad within the handler, much as you would enter +-- your own monad within IO. You simply have to implement the 'MonadFastCGI' class. +-- +-- Any exceptions not caught within the handler are caught by 'concurrentAcceptLoop', +-- and cause the termination of that handler, but not of the accept loop. +-- Furthermore, the exception is logged through the FastCGI protocol if at all +-- possible. +-- +-- In the event that the program was not invoked according to the FastCGI protocol, +-- returns. +acceptLoop + :: (IO () -> IO ThreadId) + -- ^ A forking primitive, typically either 'forkIO' or 'forkOS'. + -> (FastCGI ()) + -- ^ A handler which is invoked once for each incoming connection. + -> IO () + -- ^ Never actually returns. +acceptLoop fork handler = do + maybeListenSocket <- createListenSocket + webServerAddresses <- computeWebServerAddresses + case maybeListenSocket of + Nothing -> return () + Just listenSocket -> do + let acceptLoop' = do + (socket, peer) <- Network.accept listenSocket + requestChannelMapMVar <- newMVar $ Map.empty + let state = FastCGIState { + webServerAddresses = webServerAddresses, + socket = socket, + peer = peer, + requestChannelMapMVar = requestChannelMapMVar, + request = Nothing + } + flip runReaderT state $ do + addressValid <- validateWebServerAddress + case addressValid of + False -> do + FastCGIState { peer = peer } <- getFastCGIState + fLog $ "Ignoring connection from invalid address: " + ++ (show peer) + True -> outsideRequestLoop fork handler + acceptLoop' + acceptLoop' + + +createListenSocket :: IO (Maybe Network.Socket) +createListenSocket = do + listenSocket <- Network.mkSocket 0 + Network.AF_INET + Network.Stream + Network.defaultProtocol + Network.Listening + -- Notice that we do AF_INET even though AF_UNSPEC would be more honest, because + -- we need to call getPeerName which needs to know how big a sockaddr to allow for. + -- This should work even though the socket could, for all we know, be an ipv6 socket + -- with a larger sockaddr, because that check hopefully happens after the check for + -- the case we care about, which is that the socket is not connected and therefore + -- has no peer name. + System.catch (do + Network.getPeerName listenSocket + return Nothing) + (\error -> do + if ioeGetErrorType error == InvalidArgument + then do + -- Since we need to know the specific error code, not just the + -- logical mapping of it, we need to actually drill down and check + -- errno. Otherwise we can't distinguish "it doesn't have a peer + -- name because it's a listening socket" from "it doesn't have a + -- peer name because it's not a socket at all". + errno <- getErrno + if errno == eNOTCONN + then return $ Just listenSocket + else return Nothing + else return Nothing) + + +computeWebServerAddresses :: IO (Maybe [Network.HostAddress]) +computeWebServerAddresses = do + environment <- getEnvironment + System.catch (do + string <- getEnv "FCGI_WEB_SERVER_ADDRS" + let split [] = [] + split string = case elemIndex ',' string of + Nothing -> [string] + Just index -> + let (first, rest) = splitAt index string + in first : (split $ drop 1 rest) + splitString = split string + addresses <- mapM Network.inet_addr splitString + return $ Just addresses) + (\error -> do + if System.isDoesNotExistError error + then return Nothing + else System.ioError error) + + +validateWebServerAddress :: (MonadFastCGI m) => m Bool +validateWebServerAddress = do + FastCGIState { webServerAddresses = maybeWebServerAddresses, peer = peer } + <- getFastCGIState + case maybeWebServerAddresses of + Nothing -> return True + Just webServerAddresses + -> return $ flip any webServerAddresses + (\webServerAddress -> case peer of + Network.SockAddrInet _ peerAddress + -> webServerAddress == peerAddress + _ -> False) + + +outsideRequestLoop :: (IO () -> IO ThreadId) -> (FastCGI ()) -> FastCGI () +outsideRequestLoop fork handler = do + maybeRecord <- recvRecord + case maybeRecord of + Nothing -> do + FastCGIState { socket = socket } <- getFastCGIState + liftIO $ Exception.catch (Network.sClose socket) + (\error -> do + return $ error :: IO Exception.IOException + return ()) + return () + Just record -> do + case recordType record of + BeginRequestRecord -> do + state <- getFastCGIState + requestChannel <- liftIO $ newChan + requestChannelMap <- liftIO $ takeMVar $ requestChannelMapMVar state + paramsStreamBufferMVar <- liftIO $ newMVar $ BS.empty + stdinStreamBufferMVar <- liftIO $ newMVar $ BS.empty + stdinStreamClosedMVar <- liftIO $ newMVar $ False + requestEndedMVar <- liftIO $ newMVar $ False + requestVariableMapMVar <- liftIO $ newMVar $ Map.empty + requestHeaderMapMVar <- liftIO $ newMVar $ Map.empty + requestCookieMapMVar <- liftIO $ newMVar $ Map.empty + responseStatusMVar <- liftIO $ newMVar $ 200 + responseHeaderMapMVar + <- liftIO $ newMVar $ Map.fromList [(HttpContentType, "text/html")] + responseHeadersSentMVar <- liftIO $ newMVar $ False + responseCookieMapMVar <- liftIO $ newMVar $ Map.empty + let requestChannelMap' = Map.insert (recordRequestID record) + requestChannel + requestChannelMap + request = Request { + requestID = recordRequestID record, + requestChannel = requestChannel, + paramsStreamBufferMVar = paramsStreamBufferMVar, + stdinStreamBufferMVar = stdinStreamBufferMVar, + stdinStreamClosedMVar = stdinStreamClosedMVar, + requestEndedMVar = requestEndedMVar, + requestVariableMapMVar = requestVariableMapMVar, + requestHeaderMapMVar = requestHeaderMapMVar, + requestCookieMapMVar = requestCookieMapMVar, + responseStatusMVar = responseStatusMVar, + responseHeaderMapMVar = responseHeaderMapMVar, + responseHeadersSentMVar = responseHeadersSentMVar, + responseCookieMapMVar = responseCookieMapMVar + } + state' = state { request = Just request } + liftIO $ putMVar (requestChannelMapMVar state) requestChannelMap' + liftIO $ fork $ do + Exception.catch (runReaderT (insideRequestLoop handler) state') + (\error -> flip runReaderT state' $ do + fLog $ "Uncaught exception: " + ++ (show (error :: Exception.SomeException))) + return () + OtherRecord unknownCode -> do + sendRecord $ Record { + recordType = UnknownTypeRecord, + recordRequestID = 0, + recordContent = BS.pack [fromIntegral unknownCode, + 0, 0, 0, 0, 0, 0, 0] + } + GetValuesRecord -> do + fLog $ "Get values record: " ++ (show record) + _ -> do + state <- getFastCGIState + requestChannelMap <- liftIO $ readMVar $ requestChannelMapMVar state + let requestID = recordRequestID record + maybeRequestChannel = Map.lookup requestID requestChannelMap + case maybeRequestChannel of + Nothing -> + fLog $ "Ignoring record for unknown request ID " ++ (show requestID) + Just requestChannel -> liftIO $ writeChan requestChannel record + outsideRequestLoop fork handler + + +insideRequestLoop :: (FastCGI ()) -> FastCGI () +insideRequestLoop handler = do + FastCGIState { request = Just request } <- getFastCGIState + record <- liftIO $ readChan $ requestChannel request + case recordType record of + ParamsRecord -> do + case BS.length $ recordContent record of + 0 -> do + handler + sendResponseHeaders + requestEnded <- liftIO $ readMVar $ requestEndedMVar request + if not requestEnded + then terminateRequest + else return () + _ -> do + buffer <- liftIO $ takeMVar $ paramsStreamBufferMVar request + let bufferWithNewData = BS.append buffer $ recordContent record + takeUntilEmpty bufferTail = do + let maybeNameValuePair = takeNameValuePair bufferTail + case maybeNameValuePair of + Nothing -> liftIO $ putMVar (paramsStreamBufferMVar request) bufferTail + Just ((name, value), bufferTail') -> do + let name' = BS.toString name + value' = BS.toString value + processRequestVariable name' value' + takeUntilEmpty bufferTail' + takeUntilEmpty bufferWithNewData + insideRequestLoop handler + _ -> do + fLog $ "Ignoring record of unexpected type " + ++ (show $ recordType record) + + +processRequestVariable :: String -> String -> FastCGI () +processRequestVariable name value = do + state <- getFastCGIState + requestVariableMap + <- liftIO $ takeMVar $ requestVariableMapMVar $ fromJust $ request state + let requestVariableMap' = Map.insert name value requestVariableMap + liftIO $ putMVar (requestVariableMapMVar $ fromJust $ request state) + requestVariableMap' + let maybeHeader = requestVariableNameToHeader name + case maybeHeader of + Nothing -> return () + Just header -> do + processRequestHeader header value + + +processRequestHeader :: Header -> String -> FastCGI () +processRequestHeader header value = do + state <- getFastCGIState + requestHeaderMap + <- liftIO $ takeMVar $ requestHeaderMapMVar $ fromJust $ request state + let requestHeaderMap' = Map.insert header value requestHeaderMap + liftIO $ putMVar (requestHeaderMapMVar $ fromJust $ request state) requestHeaderMap' + case header of + HttpCookie -> do + processCookies value + _ -> return () + + +processCookies :: String -> FastCGI () +processCookies value = do + state <- getFastCGIState + requestCookieMap + <- liftIO $ takeMVar $ requestCookieMapMVar $ fromJust $ request state + let updateCookieMap cookieMap (cookie:rest) + = updateCookieMap (Map.insert (cookieName cookie) cookie cookieMap) + rest + updateCookieMap cookieMap [] = cookieMap + requestCookieMap' = updateCookieMap requestCookieMap $ parseCookies value + liftIO $ putMVar (requestCookieMapMVar $ fromJust $ request state) requestCookieMap' + + +parseCookies :: String -> [Cookie] +parseCookies value = + let findSeparator string + = let quotePoint = if (length string > 0) && (string !! 0 == '"') + then 1 + (findBalancingQuote $ drop 1 string) + else 0 + maybeSemicolonPoint + = case (findIndex (\c -> (c == ';') || (c == ',')) + $ drop quotePoint string) + of Nothing -> Nothing + Just index -> Just $ index + quotePoint + in maybeSemicolonPoint + findBalancingQuote string + = let consume accumulator ('\\' : c : rest) = consume (accumulator + 2) rest + consume accumulator ('"' : rest) = accumulator + consume accumulator (c : rest) = consume (accumulator + 1) rest + consume accumulator "" = accumulator + in consume 0 string + split [] = [] + split string = case findSeparator string of + Nothing -> [string] + Just index -> + let (first, rest) = splitAt index string + in first : (split $ drop 1 rest) + splitNameValuePair string = case elemIndex '=' (filterNameValuePair string) of + Nothing -> (string, "") + Just index -> let (first, rest) + = splitAt index + (filterNameValuePair + string) + in (first, filterValue (drop 1 rest)) + filterNameValuePair string + = reverse $ dropWhile isSpace $ reverse $ dropWhile isSpace string + filterValue string = if (length string > 0) && ((string !! 0) == '"') + then take (findBalancingQuote $ drop 1 string) + $ drop 1 string + else string + pairs = map splitNameValuePair $ split value + (version, pairs') = case pairs of + ("$Version", versionString) : rest + -> case parseInt versionString of + Nothing -> (0, rest) + Just version -> (version, rest) + _ -> (0, pairs) + takeCookie pairs = case pairs of + (name, value) : pairs' + | (length name > 0) && (take 1 name /= "$") + -> let (maybePath, maybeDomain, pairs'') + = takePathAndDomain pairs' + in (Cookie { + cookieName = name, + cookieValue = value, + cookieVersion = version, + cookiePath = maybePath, + cookieDomain = maybeDomain, + cookieMaxAge = Nothing, + cookieSecure = False, + cookieComment = Nothing + } + : takeCookie pairs'') + _ : pairs' -> takeCookie pairs' + [] -> [] + takePathAndDomain pairs = let (maybePath, pairs') + = case pairs of ("$Path", path) : rest + -> (Just path, rest) + _ -> (Nothing, pairs) + (maybeDomain, pairs'') + = case pairs' of ("$Domain", domain) : rest + -> (Just domain, rest) + _ -> (Nothing, pairs') + in (maybePath, maybeDomain, pairs'') + in takeCookie pairs' + + +printCookies :: [Cookie] -> String +printCookies cookies = + let printCookie cookie + = intercalate ";" $ map printNameValuePair $ nameValuePairs cookie + printNameValuePair (name, Nothing) = name + printNameValuePair (name, Just value) + = name ++ "=\"" ++ escape value ++ "\"" + escape "" = "" + escape ('\\':rest) = "\\\\" ++ escape rest + escape ('\"':rest) = "\\\"" ++ escape rest + escape (c:rest) = [c] ++ escape rest + nameValuePairs cookie = [(cookieName cookie, Just $ cookieValue cookie)] + ++ (case cookieComment cookie of + Nothing -> [] + Just comment -> [("Comment", Just comment)]) + ++ (case cookieDomain cookie of + Nothing -> [] + Just domain -> [("Domain", Just domain)]) + ++ (case cookieMaxAge cookie of + Nothing -> [] + Just maxAge -> [("Max-Age", Just $ show maxAge)]) + ++ (case cookiePath cookie of + Nothing -> [] + Just path -> [("Path", Just $ show path)]) + ++ (case cookieSecure cookie of + False -> [] + True -> [("Secure", Nothing)]) + ++ [("Version", Just $ show $ cookieVersion cookie)] + in intercalate "," $ map printCookie cookies + + +parseInt :: String -> Maybe Int +parseInt string = + if (length string > 0) && (all isDigit string) + then Just $ let accumulate "" accumulator = accumulator + accumulate (n:rest) accumulator + = accumulate rest $ accumulator * 10 + digitToInt n + in accumulate string 0 + else Nothing + + +recvRecord :: (MonadFastCGI m) => m (Maybe Record) +recvRecord = do + FastCGIState { socket = socket } <- getFastCGIState + byteString <- liftIO $ recvAll socket 8 + case BS.length byteString of + 8 -> do + let recordVersion = BS.index byteString 0 + recordTypeCode = fromIntegral $ BS.index byteString 1 + recordRequestIDB1 = BS.index byteString 2 + recordRequestIDB0 = BS.index byteString 3 + recordRequestID = (fromIntegral recordRequestIDB1) * 256 + + (fromIntegral recordRequestIDB0) + recordContentLengthB1 = BS.index byteString 4 + recordContentLengthB0 = BS.index byteString 5 + recordContentLength = (fromIntegral recordContentLengthB1) * 256 + + (fromIntegral recordContentLengthB0) + recordPaddingLength = BS.index byteString 6 + if recordVersion /= 1 + then do + fLog $ "Record header of unrecognized version: " + ++ (show recordVersion) + return Nothing + else do + let recordType = toEnum recordTypeCode + recordContent <- liftIO $ recvAll socket recordContentLength + liftIO $ recvAll socket $ fromIntegral recordPaddingLength + return $ Just $ Record { + recordType = recordType, + recordRequestID = recordRequestID, + recordContent = recordContent + } + _ -> return Nothing + + +sendRecord :: (MonadFastCGI m) => Record -> m () +sendRecord record = do + FastCGIState { socket = socket } <- getFastCGIState + let recordRequestIDB0 = fromIntegral $ recordRequestID record `mod` 256 + recordRequestIDB1 = fromIntegral $ (recordRequestID record `div` 256) `mod` 256 + recordContentLength = BS.length $ recordContent record + recordContentLengthB0 = fromIntegral $ recordContentLength `mod` 256 + recordContentLengthB1 = fromIntegral $ (recordContentLength `div` 256) `mod` 256 + headerByteString = BS.pack [1, + fromIntegral $ fromEnum $ recordType record, + recordRequestIDB1, + recordRequestIDB0, + recordContentLengthB1, + recordContentLengthB0, + 0, + 0] + byteString = BS.append headerByteString $ recordContent record + liftIO $ Network.sendAll socket byteString + + +recvAll :: Network.Socket -> Int -> IO BS.ByteString +recvAll socket totalSize = do + if totalSize == 0 + then return BS.empty + else do + byteString <- Network.recv socket totalSize + case BS.length byteString of + 0 -> return byteString + receivedSize | receivedSize == totalSize -> return byteString + | otherwise -> do + restByteString + <- recvAll socket $ totalSize - receivedSize + return $ BS.append byteString restByteString + + +takeLength :: BS.ByteString -> Maybe (Int, BS.ByteString) +takeLength byteString + = if BS.length byteString < 1 + then Nothing + else let firstByte = BS.index byteString 0 + threeMoreComing = (firstByte .&. 0x80) == 0x80 + in if threeMoreComing + then if BS.length byteString < 4 + then Nothing + else let secondByte = BS.index byteString 1 + thirdByte = BS.index byteString 2 + fourthByte = BS.index byteString 3 + decoded = ((fromIntegral $ firstByte .&. 0x7F) + `shiftL` 24) + + (fromIntegral secondByte `shiftL` 16) + + (fromIntegral thirdByte `shiftL` 8) + + (fromIntegral fourthByte) + in Just (decoded, BS.drop 4 byteString) + else Just (fromIntegral firstByte, BS.drop 1 byteString) + + +takeNameValuePair :: BS.ByteString + -> Maybe ((BS.ByteString, BS.ByteString), BS.ByteString) +takeNameValuePair byteString + = let maybeNameLength = takeLength byteString + in case maybeNameLength of + Nothing -> Nothing + Just (nameLength, byteString') + -> let maybeValueLength = takeLength byteString' + in case maybeValueLength of + Nothing -> Nothing + Just (valueLength, byteString'') + -> let name = BS.take nameLength byteString'' + byteString''' = BS.drop nameLength byteString'' + value = BS.take valueLength byteString''' + byteString'''' = BS.drop valueLength byteString''' + in Just ((name, value), byteString'''') + + +-- | Logs a message using the web server's logging facility. +fLog :: (MonadFastCGI m) => String -> m () +fLog message = do + FastCGIState { request = maybeRequest } <- getFastCGIState + case maybeRequest of + Nothing -> do + -- As you can see, the description is actually incomplete. If there's no request + -- in progress, we use syslog instead. But since the user can never call us + -- outside a request, that would only be confusing if documented. + -- liftIO $ withSyslog "direct-fastcgi" [PID] USER $ syslog Error message + return () + Just request -> do + if length message > 0 + then sendRecord $ Record { + recordType = StderrRecord, + recordRequestID = requestID request, + recordContent = BS.fromString message + } + else return () + + +-- | Headers are classified by HTTP/1.1 as request headers, response headers, or +-- entity headers. +data Header + -- | Request headers + = HttpAccept + | HttpAcceptCharset + | HttpAcceptEncoding + | HttpAcceptLanguage + | HttpAuthorization + | HttpExpect + | HttpFrom + | HttpHost + | HttpIfMatch + | HttpIfModifiedSince + | HttpIfNoneMatch + | HttpIfRange + | HttpIfUnmodifiedSince + | HttpMaxForwards + | HttpProxyAuthorization + | HttpRange + | HttpReferer + | HttpTE + | HttpUserAgent + -- | Response headers + | HttpAcceptRanges + | HttpAge + | HttpETag + | HttpLocation + | HttpProxyAuthenticate + | HttpRetryAfter + | HttpServer + | HttpVary + | HttpWWWAuthenticate + -- | Entity headers + | HttpAllow + | HttpContentEncoding + | HttpContentLanguage + | HttpContentLength + | HttpContentLocation + | HttpContentMD5 + | HttpContentRange + | HttpContentType + | HttpExpires + | HttpLastModified + | HttpExtensionHeader String + -- | Nonstandard headers + | HttpConnection + | HttpCookie + | HttpSetCookie + deriving (Eq, Ord) + + +instance Show Header where + show header = fromHeader header + + +data HeaderType = RequestHeader + | ResponseHeader + | EntityHeader + deriving (Eq, Show) + + +headerType :: Header -> HeaderType +headerType HttpAccept = RequestHeader +headerType HttpAcceptCharset = RequestHeader +headerType HttpAcceptEncoding = RequestHeader +headerType HttpAcceptLanguage = RequestHeader +headerType HttpAuthorization = RequestHeader +headerType HttpExpect = RequestHeader +headerType HttpFrom = RequestHeader +headerType HttpHost = RequestHeader +headerType HttpIfMatch = RequestHeader +headerType HttpIfModifiedSince = RequestHeader +headerType HttpIfNoneMatch = RequestHeader +headerType HttpIfRange = RequestHeader +headerType HttpIfUnmodifiedSince = RequestHeader +headerType HttpMaxForwards = RequestHeader +headerType HttpProxyAuthorization = RequestHeader +headerType HttpRange = RequestHeader +headerType HttpReferer = RequestHeader +headerType HttpTE = RequestHeader +headerType HttpUserAgent = RequestHeader +headerType HttpAcceptRanges = ResponseHeader +headerType HttpAge = ResponseHeader +headerType HttpETag = ResponseHeader +headerType HttpLocation = ResponseHeader +headerType HttpProxyAuthenticate = ResponseHeader +headerType HttpRetryAfter = ResponseHeader +headerType HttpServer = ResponseHeader +headerType HttpVary = ResponseHeader +headerType HttpWWWAuthenticate = ResponseHeader +headerType HttpAllow = EntityHeader +headerType HttpContentEncoding = EntityHeader +headerType HttpContentLanguage = EntityHeader +headerType HttpContentLength = EntityHeader +headerType HttpContentLocation = EntityHeader +headerType HttpContentMD5 = EntityHeader +headerType HttpContentRange = EntityHeader +headerType HttpContentType = EntityHeader +headerType HttpExpires = EntityHeader +headerType HttpLastModified = EntityHeader +headerType (HttpExtensionHeader _) = EntityHeader +headerType HttpConnection = RequestHeader +headerType HttpCookie = RequestHeader +headerType HttpSetCookie = ResponseHeader + + +fromHeader :: Header -> String +fromHeader HttpAccept = "Accept" +fromHeader HttpAcceptCharset = "Accept-Charset" +fromHeader HttpAcceptEncoding = "Accept-Encoding" +fromHeader HttpAcceptLanguage = "Accept-Language" +fromHeader HttpAuthorization = "Authorization" +fromHeader HttpExpect = "Expect" +fromHeader HttpFrom = "From" +fromHeader HttpHost = "Host" +fromHeader HttpIfMatch = "If-Match" +fromHeader HttpIfModifiedSince = "If-Modified-Since" +fromHeader HttpIfNoneMatch = "If-None-Match" +fromHeader HttpIfRange = "If-Range" +fromHeader HttpIfUnmodifiedSince = "If-Unmodified-Since" +fromHeader HttpMaxForwards = "Max-Forwards" +fromHeader HttpProxyAuthorization = "Proxy-Authorization" +fromHeader HttpRange = "Range" +fromHeader HttpReferer = "Referer" +fromHeader HttpTE = "TE" +fromHeader HttpUserAgent = "User-Agent" +fromHeader HttpAcceptRanges = "Accept-Ranges" +fromHeader HttpAge = "Age" +fromHeader HttpETag = "ETag" +fromHeader HttpLocation = "Location" +fromHeader HttpProxyAuthenticate = "Proxy-Authenticate" +fromHeader HttpRetryAfter = "Retry-After" +fromHeader HttpServer = "Server" +fromHeader HttpVary = "Vary" +fromHeader HttpWWWAuthenticate = "WWW-Authenticate" +fromHeader HttpAllow = "Allow" +fromHeader HttpContentEncoding = "Content-Encoding" +fromHeader HttpContentLanguage = "Content-Language" +fromHeader HttpContentLength = "Content-Length" +fromHeader HttpContentLocation = "Content-Location" +fromHeader HttpContentMD5 = "Content-MD5" +fromHeader HttpContentRange = "Content-Range" +fromHeader HttpContentType = "Content-Type" +fromHeader HttpExpires = "Expires" +fromHeader HttpLastModified = "Last-Modified" +fromHeader (HttpExtensionHeader name) = name +fromHeader HttpConnection = "Connection" +fromHeader HttpCookie = "Cookie" +fromHeader HttpSetCookie = "Set-Cookie" + + +toHeader :: String -> Header +toHeader "Accept" = HttpAccept +toHeader "Accept-Charset" = HttpAcceptCharset +toHeader "Accept-Encoding" = HttpAcceptEncoding +toHeader "Accept-Language" = HttpAcceptLanguage +toHeader "Authorization" = HttpAuthorization +toHeader "Expect" = HttpExpect +toHeader "From" = HttpFrom +toHeader "Host" = HttpHost +toHeader "If-Match" = HttpIfMatch +toHeader "If-Modified-Since" = HttpIfModifiedSince +toHeader "If-None-Match" = HttpIfNoneMatch +toHeader "If-Range" = HttpIfRange +toHeader "If-Unmodified-Since" = HttpIfUnmodifiedSince +toHeader "Max-Forwards" = HttpMaxForwards +toHeader "Proxy-Authorization" = HttpProxyAuthorization +toHeader "Range" = HttpRange +toHeader "Referer" = HttpReferer +toHeader "TE" = HttpTE +toHeader "User-Agent" = HttpUserAgent +toHeader "Accept-Ranges" = HttpAcceptRanges +toHeader "Age" = HttpAge +toHeader "ETag" = HttpETag +toHeader "Location" = HttpLocation +toHeader "Proxy-Authenticate" = HttpProxyAuthenticate +toHeader "Retry-After" = HttpRetryAfter +toHeader "Server" = HttpServer +toHeader "Vary" = HttpVary +toHeader "WWW-Authenticate" = HttpWWWAuthenticate +toHeader "Allow" = HttpAllow +toHeader "Content-Encoding" = HttpContentEncoding +toHeader "Content-Language" = HttpContentLanguage +toHeader "Content-Length" = HttpContentLength +toHeader "Content-Location" = HttpContentLocation +toHeader "Content-MD5" = HttpContentMD5 +toHeader "Content-Range" = HttpContentRange +toHeader "Content-Type" = HttpContentType +toHeader "Expires" = HttpExpires +toHeader "Last-Modified" = HttpLastModified +toHeader "Connection" = HttpConnection +toHeader "Cookie" = HttpCookie +toHeader "Set-Cookie" = HttpSetCookie +toHeader name = HttpExtensionHeader name + + +requestVariableNameIsHeader :: String -> Bool +requestVariableNameIsHeader name = (length name > 5) && (take 5 name == "HTTP_") + + +requestVariableNameToHeaderName :: String -> Maybe String +requestVariableNameToHeaderName name + = if requestVariableNameIsHeader name + then let split [] = [] + split string = case elemIndex '_' string of + Nothing -> [string] + Just index -> + let (first, rest) = splitAt index string + in first : (split $ drop 1 rest) + titleCase word = [toUpper $ head word] ++ (map toLower $ tail word) + headerName = intercalate "-" $ map titleCase $ split $ drop 5 name + in Just headerName + else Nothing + + +requestVariableNameToHeader :: String -> Maybe Header +requestVariableNameToHeader "HTTP_ACCEPT" = Just HttpAccept +requestVariableNameToHeader "HTTP_ACCEPT_CHARSET" = Just HttpAcceptCharset +requestVariableNameToHeader "HTTP_ACCEPT_ENCODING" = Just HttpAcceptEncoding +requestVariableNameToHeader "HTTP_ACCEPT_LANGUAGE" = Just HttpAcceptLanguage +requestVariableNameToHeader "HTTP_AUTHORIZATION" = Just HttpAuthorization +requestVariableNameToHeader "HTTP_EXPECT" = Just HttpExpect +requestVariableNameToHeader "HTTP_FROM" = Just HttpFrom +requestVariableNameToHeader "HTTP_HOST" = Just HttpHost +requestVariableNameToHeader "HTTP_IF_MATCH" = Just HttpIfMatch +requestVariableNameToHeader "HTTP_IF_MODIFIED_SINCE" = Just HttpIfModifiedSince +requestVariableNameToHeader "HTTP_IF_NONE_MATCH" = Just HttpIfNoneMatch +requestVariableNameToHeader "HTTP_IF_RANGE" = Just HttpIfRange +requestVariableNameToHeader "HTTP_IF_UNMODIFIED_SINCE" = Just HttpIfUnmodifiedSince +requestVariableNameToHeader "HTTP_MAX_FORWARDS" = Just HttpMaxForwards +requestVariableNameToHeader "HTTP_PROXY_AUTHORIZATION" = Just HttpProxyAuthorization +requestVariableNameToHeader "HTTP_RANGE" = Just HttpRange +requestVariableNameToHeader "HTTP_REFERER" = Just HttpReferer +requestVariableNameToHeader "HTTP_TE" = Just HttpTE +requestVariableNameToHeader "HTTP_USER_AGENT" = Just HttpUserAgent +requestVariableNameToHeader "HTTP_ALLOW" = Just HttpAllow +requestVariableNameToHeader "HTTP_CONTENT_ENCODING" = Just HttpContentEncoding +requestVariableNameToHeader "HTTP_CONTENT_LANGUAGE" = Just HttpContentLanguage +requestVariableNameToHeader "HTTP_CONTENT_LENGTH" = Just HttpContentLength +requestVariableNameToHeader "HTTP_CONTENT_LOCATION" = Just HttpContentLocation +requestVariableNameToHeader "HTTP_CONTENT_MD5" = Just HttpContentMD5 +requestVariableNameToHeader "HTTP_CONTENT_RANGE" = Just HttpContentRange +requestVariableNameToHeader "HTTP_CONTENT_TYPE" = Just HttpContentType +requestVariableNameToHeader "HTTP_EXPIRES" = Just HttpExpires +requestVariableNameToHeader "HTTP_LAST_MODIFIED" = Just HttpLastModified +requestVariableNameToHeader "HTTP_CONNECTION" = Just HttpConnection +requestVariableNameToHeader "HTTP_COOKIE" = Just HttpCookie +requestVariableNameToHeader name + = if requestVariableNameIsHeader name + then Just $ HttpExtensionHeader $ fromJust $ requestVariableNameToHeaderName name + else Nothing + + +isValidInResponse :: Header -> Bool +isValidInResponse header = (headerType header == ResponseHeader) + || (headerType header == EntityHeader) + + +-- | Queries the value from the web server of the CGI/1.1 request variable with the +-- given name for this request. +getRequestVariable + :: (MonadFastCGI m) + => String -- ^ The name of the request variable to query. + -> m (Maybe String) -- ^ The value of the request variable, if the web server + -- provided one. +getRequestVariable name = do + state <- getFastCGIState + requestVariableMap + <- liftIO $ readMVar $ requestVariableMapMVar $ fromJust $ request state + return $ Map.lookup name requestVariableMap + + +-- | Returns an association list of name-value pairs of all the CGI/1.1 request +-- variables from the web server. +getAllRequestVariables + :: (MonadFastCGI m) => m [(String, String)] +getAllRequestVariables = do + state <- getFastCGIState + requestVariableMap + <- liftIO $ readMVar $ requestVariableMapMVar $ fromJust $ request state + return $ Map.assocs requestVariableMap + + +-- | Queries the value from the user agent of the given HTTP/1.1 header. +getRequestHeader + :: (MonadFastCGI m) + => Header -- ^ The header to query. Must be a request or entity header. + -> m (Maybe String) -- ^ The value of the header, if the user agent provided one. +getRequestHeader header = do + state <- getFastCGIState + requestHeaderMap + <- liftIO $ readMVar $ requestHeaderMapMVar $ fromJust $ request state + return $ Map.lookup header requestHeaderMap + + +-- | Returns an association list of name-value pairs of all the HTTP/1.1 request or +-- entity headers from the user agent. +getAllRequestHeaders :: (MonadFastCGI m) => m [(Header, String)] +getAllRequestHeaders = do + state <- getFastCGIState + requestHeaderMap + <- liftIO $ readMVar $ requestHeaderMapMVar $ fromJust $ request state + return $ Map.assocs requestHeaderMap + + +-- | Returns a 'Cookie' object for the given name, if the user agent provided one +-- in accordance with RFC 2109. +getCookie + :: (MonadFastCGI m) + => String -- ^ The name of the cookie to look for. + -> m (Maybe Cookie) -- ^ The cookie, if the user agent provided it. +getCookie name = do + state <- getFastCGIState + requestCookieMap + <- liftIO $ readMVar $ requestCookieMapMVar $ fromJust $ request state + return $ Map.lookup name requestCookieMap + + +-- | Returns all 'Cookie' objects provided by the user agent in accordance +-- RFC 2109. +getAllCookies :: (MonadFastCGI m) => m [Cookie] +getAllCookies = do + state <- getFastCGIState + requestCookieMap + <- liftIO $ readMVar $ requestCookieMapMVar $ fromJust $ request state + return $ Map.elems requestCookieMap + + +-- | A convenience method; as 'getCookie', but returns only the value of the cookie +-- rather than a 'Cookie' object. +getCookieValue + :: (MonadFastCGI m) + => String -- ^ The name of the cookie to look for. + -> m (Maybe String) -- ^ The value of the cookie, if the user agent provided it. +getCookieValue name = do + state <- getFastCGIState + requestCookieMap + <- liftIO $ readMVar $ requestCookieMapMVar $ fromJust $ request state + return $ case Map.lookup name requestCookieMap of + Nothing -> Nothing + Just cookie -> Just $ cookieValue cookie + + +-- | Return the document root, as provided by the web server, if it was provided. +getDocumentRoot :: (MonadFastCGI m) => m (Maybe String) +getDocumentRoot = do + getRequestVariable "DOCUMENT_ROOT" + + +-- | Return the gateway interface, as provided by the web server, if it was provided. +getGatewayInterface :: (MonadFastCGI m) => m (Maybe String) +getGatewayInterface = do + getRequestVariable "GATEWAY_INTERFACE" + + +-- | Return the path info, as provided by the web server, if it was provided. +getPathInfo :: (MonadFastCGI m) => m (Maybe String) +getPathInfo = do + getRequestVariable "PATH_INFO" + + +-- | Return the path-translated value, as provided by the web server, if it was provided. +getPathTranslated :: (MonadFastCGI m) => m (Maybe String) +getPathTranslated = do + getRequestVariable "PATH_TRANSLATED" + + +-- | Return the query string, as provided by the web server, if it was provided. +getQueryString :: (MonadFastCGI m) => m (Maybe String) +getQueryString = do + getRequestVariable "QUERY_STRING" + + +-- | Return the redirect status, as provided by the web server, if it was provided. +getRedirectStatus :: (MonadFastCGI m) => m (Maybe Int) +getRedirectStatus = do + value <- getRequestVariable "REDIRECT_STATUS" + return $ case value of + Nothing -> Nothing + Just value -> parseInt value + + +-- | Return the redirect URI, as provided by the web server, if it was provided. +getRedirectURI :: (MonadFastCGI m) => m (Maybe String) +getRedirectURI = do + getRequestVariable "REDIRECT_URI" + + +-- | Return the remote address, as provided by the web server, if it was provided. +getRemoteAddress :: (MonadFastCGI m) => m (Maybe Network.HostAddress) +getRemoteAddress = do + value <- getRequestVariable "REMOTE_ADDR" + case value of + Nothing -> return Nothing + Just value -> do + fCatch (do + value' <- liftIO $ Network.inet_addr value + return $ Just value') + (\exception -> do + return (exception :: System.IOError) + return Nothing) + + +-- | Return the remote port, as provided by the web server, if it was provided. +getRemotePort :: (MonadFastCGI m) => m (Maybe Int) +getRemotePort = do + value <- getRequestVariable "REMOTE_PORT" + return $ case value of + Nothing -> Nothing + Just value -> parseInt value + + +-- | Return the remote hostname, as provided by the web server, if it was provided. +getRemoteHost :: (MonadFastCGI m) => m (Maybe String) +getRemoteHost = do + getRequestVariable "REMOTE_HOST" + + +-- | Return the remote ident value, as provided by the web server, if it was provided. +getRemoteIdent :: (MonadFastCGI m) => m (Maybe String) +getRemoteIdent = do + getRequestVariable "REMOTE_IDENT" + + +-- | Return the remote user name, as provided by the web server, if it was provided. +getRemoteUser :: (MonadFastCGI m) => m (Maybe String) +getRemoteUser = do + getRequestVariable "REMOTE_USER" + + +-- | Return the request method, as provided by the web server, if it was provided. +getRequestMethod :: (MonadFastCGI m) => m (Maybe String) +getRequestMethod = do + getRequestVariable "REQUEST_METHOD" + + +-- | Return the request URI, as provided by the web server, if it was provided. +getRequestURI :: (MonadFastCGI m) => m (Maybe String) +getRequestURI = do + getRequestVariable "REQUEST_URI" + + +-- | Return the script filename, as provided by the web server, if it was provided. +getScriptFilename :: (MonadFastCGI m) => m (Maybe String) +getScriptFilename = do + getRequestVariable "SCRIPT_FILENAME" + + +-- | Return the script name, as provided by the web server, if it was provided. +getScriptName :: (MonadFastCGI m) => m (Maybe String) +getScriptName = do + getRequestVariable "SCRIPT_NAME" + + +-- | Return the server address, as provided by the web server, if it was provided. +getServerAddress :: (MonadFastCGI m) => m (Maybe Network.HostAddress) +getServerAddress = do + value <- getRequestVariable "SERVER_ADDR" + case value of + Nothing -> return Nothing + Just value -> do + fCatch (do + value' <- liftIO $ Network.inet_addr value + return $ Just value') + (\exception -> do + return (exception :: System.IOError) + return Nothing) + + +-- | Return the server name, as provided by the web server, if it was provided. +getServerName :: (MonadFastCGI m) => m (Maybe String) +getServerName = do + getRequestVariable "SERVER_NAME" + + +-- | Return the server port, as provided by the web server, if it was provided. +getServerPort :: (MonadFastCGI m) => m (Maybe Int) +getServerPort = do + value <- getRequestVariable "SERVER_PORT" + return $ case value of + Nothing -> Nothing + Just value -> parseInt value + + +-- | Return the server protocol, as provided by the web server, if it was provided. +getServerProtocol :: (MonadFastCGI m) => m (Maybe String) +getServerProtocol = do + getRequestVariable "SERVER_PROTOCOL" + + +-- | Return the server software name and version, as provided by the web server, if +-- it was provided. +getServerSoftware :: (MonadFastCGI m) => m (Maybe String) +getServerSoftware = do + getRequestVariable "SERVER_SOFTWARE" + + +-- | Return the authentication type, as provided by the web server, if it was provided. +getAuthenticationType :: (MonadFastCGI m) => m (Maybe String) +getAuthenticationType = do + getRequestVariable "AUTH_TYPE" + + +-- | Return the content length, as provided by the web server, if it was provided. +getContentLength :: (MonadFastCGI m) => m (Maybe Int) +getContentLength = do + value <- getRequestVariable "CONTENT_LENGTH" + return $ case value of + Nothing -> Nothing + Just value -> parseInt value + + +-- | Return the content type, as provided by the web server, if it was provided. +getContentType :: (MonadFastCGI m) => m (Maybe String) +getContentType = do + getRequestVariable "CONTENT_TYPE" + + +-- | Reads up to a specified amount of data from the input stream of the current request, +-- and interprets it as binary data. This is the content data of the HTTP request, +-- if any. If input has been closed, returns an empty bytestring. If insufficient +-- input is available, blocks until there is enough. If output has been closed, +-- causes an 'OutputAlreadyClosed' exception. +fGet :: (MonadFastCGI m) => Int -> m BS.ByteString +fGet size = fGet' size False + + +-- | Reads up to a specified amount of data from the input stream of the curent request, +-- and interprets it as binary data. This is the content data of the HTTP request, +-- if any. If input has been closed, returns an empty bytestring. If insufficient +-- input is available, returns any input which is immediately available, or an empty +-- bytestring if there is none, never blocking. If output has been closed, causes an +-- 'OutputAlreadyClosed' exception. +fGetNonBlocking :: (MonadFastCGI m) => Int -> m BS.ByteString +fGetNonBlocking size = fGet' size True + + +fGet' :: (MonadFastCGI m) => Int -> Bool -> m BS.ByteString +fGet' size nonBlocking = do + requireOutputNotYetClosed + FastCGIState { request = Just request } <- getFastCGIState + extendStdinStreamBufferToLength size nonBlocking + stdinStreamBuffer <- liftIO $ takeMVar $ stdinStreamBufferMVar request + if size <= BS.length stdinStreamBuffer + then do + let result = BS.take size stdinStreamBuffer + remainder = BS.drop size stdinStreamBuffer + liftIO $ putMVar (stdinStreamBufferMVar request) remainder + return result + else do + liftIO $ putMVar (stdinStreamBufferMVar request) BS.empty + return stdinStreamBuffer + + +-- | Reads all remaining data from the input stream of the current request, and +-- interprets it as binary data. This is the content data of the HTTP request, if +-- any. Blocks until all input has been read. If input has been closed, returns an +-- empty bytestring. If output has been closed, causes an 'OutputAlreadyClosed' +-- exception. +fGetContents :: (MonadFastCGI m) => m BS.ByteString +fGetContents = do + requireOutputNotYetClosed + FastCGIState { request = Just request } <- getFastCGIState + let extend = do + stdinStreamBuffer <- liftIO $ readMVar $ stdinStreamBufferMVar request + extendStdinStreamBufferToLength (BS.length stdinStreamBuffer + 1) False + stdinStreamClosed <- liftIO $ readMVar $ stdinStreamClosedMVar request + if stdinStreamClosed + then do + stdinStreamBuffer + <- liftIO $ swapMVar (stdinStreamBufferMVar request) BS.empty + return stdinStreamBuffer + else extend + extend + + +-- | Returns whether the input stream of the current request potentially has data +-- remaining, either in the buffer or yet to be read. This is the content data of +-- the HTTP request, if any. +fIsReadable :: (MonadFastCGI m) => m Bool +fIsReadable = do + FastCGIState { request = Just request } <- getFastCGIState + stdinStreamBuffer <- liftIO $ readMVar $ stdinStreamBufferMVar request + if BS.length stdinStreamBuffer > 0 + then return True + else do + stdinStreamClosed <- liftIO $ readMVar $ stdinStreamClosedMVar request + requestEnded <- liftIO $ readMVar $ requestEndedMVar request + return $ (not stdinStreamClosed) && (not requestEnded) + + +extendStdinStreamBufferToLength :: (MonadFastCGI m) => Int -> Bool -> m () +extendStdinStreamBufferToLength desiredLength nonBlocking = do + FastCGIState { request = Just request } <- getFastCGIState + stdinStreamBuffer <- liftIO $ takeMVar $ stdinStreamBufferMVar request + let extend bufferSoFar = do + if BS.length bufferSoFar >= desiredLength + then liftIO $ putMVar (stdinStreamBufferMVar request) bufferSoFar + else do + maybeRecord <- if nonBlocking + then do + isEmpty <- liftIO $ isEmptyChan $ requestChannel request + if isEmpty + then return Nothing + else do + record <- liftIO $ readChan $ requestChannel request + return $ Just record + else do + record <- liftIO $ readChan $ requestChannel request + return $ Just record + case maybeRecord of + Nothing -> liftIO $ putMVar (stdinStreamBufferMVar request) bufferSoFar + Just record + -> case recordType record of + StdinRecord -> do + case BS.length $ recordContent record of + 0 -> do + liftIO $ swapMVar (stdinStreamClosedMVar request) True + liftIO $ putMVar (stdinStreamBufferMVar request) bufferSoFar + _ -> do + extend $ BS.append bufferSoFar $ recordContent record + _ -> do + fLog $ "Ignoring record of unexpected type " + ++ (show $ recordType record) + extend stdinStreamBuffer + + +-- | Sets the response status which will be sent with the response headers. If the +-- response headers have already been sent, causes a 'ResponseHeadersAlreadySent' +-- exception. +setResponseStatus + :: (MonadFastCGI m) + => Int -- ^ The HTTP/1.1 status code to set. + -> m () +setResponseStatus status = do + requireResponseHeadersNotYetSent + FastCGIState { request = Just request } <- getFastCGIState + liftIO $ swapMVar (responseStatusMVar request) status + return () + + + +-- | Returns the response status which will be or has been sent with the response +-- headers. +getResponseStatus + :: (MonadFastCGI m) + => m Int -- ^ The HTTP/1.1 status code. +getResponseStatus = do + FastCGIState { request = Just request } <- getFastCGIState + liftIO $ readMVar (responseStatusMVar request) + + +-- | Sets the given 'HttpHeader' response header to the given string value, overriding +-- any value which has previously been set. If the response headers have already +-- been sent, causes a 'ResponseHeadersAlreadySent' exception. If the header is not +-- an HTTP/1.1 or extension response or entity header, ie, is not valid as part of +-- a response, causes a 'NotAResponseHeader' exception. +-- +-- If a value is set for the 'HttpSetCookie' header, this overrides all cookies set +-- for this request with 'setCookie'. +setResponseHeader + :: (MonadFastCGI m) + => Header -- ^ The header to set. Must be a response header or an entity header. + -> String -- ^ The value to set. + -> m () +setResponseHeader header value = do + requireResponseHeadersNotYetSent + if isValidInResponse header + then do + FastCGIState { request = Just request } <- getFastCGIState + responseHeaderMap <- liftIO $ takeMVar $ responseHeaderMapMVar request + let responseHeaderMap' = Map.insert header value responseHeaderMap + liftIO $ putMVar (responseHeaderMapMVar request) responseHeaderMap' + else fThrow $ NotAResponseHeader header + + +-- | Causes the given 'HttpHeader' response header not to be sent, overriding any value +-- which has previously been set. If the response headers have already been sent, +-- causes a 'ResponseHeadersAlreadySent' exception. If the header is not an HTTP/1.1 +-- or extension response or entity header, ie, is not valid as part of a response, +-- causes a 'NotAResponseHeader' exception. +-- +-- Does not prevent the 'HttpSetCookie' header from being sent if cookies have been +-- set for this request with 'setCookie'. +unsetResponseHeader + :: (MonadFastCGI m) + => Header -- ^ The header to unset. Must be a response header or an entity header. + -> m () +unsetResponseHeader header = do + requireResponseHeadersNotYetSent + if isValidInResponse header + then do + FastCGIState { request = Just request } <- getFastCGIState + responseHeaderMap <- liftIO $ takeMVar $ responseHeaderMapMVar request + let responseHeaderMap' = Map.delete header responseHeaderMap + liftIO $ putMVar (responseHeaderMapMVar request) responseHeaderMap' + else fThrow $ NotAResponseHeader header + + +-- | Returns the value of the given header which will be or has been sent with the +-- response headers. If the header is not an HTTP/1.1 or extension response or entity +-- header, ie, is not valid as part of a response, causes a 'NotAResponseHeader' +-- exception. +getResponseHeader + :: (MonadFastCGI m) + => Header -- ^ The header to query. Must be a response header or an entity + -- header. + -> m (Maybe String) -- ^ The value of the queried header. +getResponseHeader header = do + requireResponseHeadersNotYetSent + if isValidInResponse header + then do + FastCGIState { request = Just request } <- getFastCGIState + responseHeaderMap <- liftIO $ readMVar $ responseHeaderMapMVar request + return $ Map.lookup header responseHeaderMap + else fThrow $ NotAResponseHeader header + + +-- | Causes the user agent to record the given cookie and send it back with future +-- loads of this page. Does not take effect instantly, but rather when headers are +-- sent. Cookies are set in accordance with RFC 2109. +-- If an @HttpCookie@ header is set for this request by a call to 'setResponseHeader', +-- this function has no effect. +-- If the response headers have already been sent, +-- causes a 'ResponseHeadersAlreadySent' exception. +-- If the name is not a possible name for a cookie, causes a 'CookieNameInvalid' +-- exception. +setCookie + :: (MonadFastCGI m) + => Cookie -- ^ The cookie to set. + -> m () +setCookie cookie = do + requireResponseHeadersNotYetSent + requireValidCookieName $ cookieName cookie + fLog $ show cookie + FastCGIState { request = Just request } <- getFastCGIState + responseCookieMap <- liftIO $ takeMVar $ responseCookieMapMVar request + let responseCookieMap' = Map.insert (cookieName cookie) cookie responseCookieMap + fLog $ show responseCookieMap' + liftIO $ putMVar (responseCookieMapMVar request) responseCookieMap' + + +-- | Causes the user agent to unset any cookie applicable to this page with the +-- given name. Does not take effect instantly, but rather when headers are sent. +-- If an @HttpCookie@ header is set for this request by a call to 'setResponseHeader', +-- this function has no effect. +-- If the response headers have already been sent, +-- causes a 'ResponseHeadersAlreadySent' exception. +-- If the name is not a possible name for a cookie, causes a 'CookieNameInvalid' +-- exception. +unsetCookie + :: (MonadFastCGI m) + => String -- ^ The name of the cookie to unset. + -> m () +unsetCookie name = do + requireResponseHeadersNotYetSent + requireValidCookieName name + FastCGIState { request = Just request } <- getFastCGIState + responseCookieMap <- liftIO $ takeMVar $ responseCookieMapMVar request + let responseCookieMap' = Map.insert name (mkUnsetCookie name) responseCookieMap + liftIO $ putMVar (responseCookieMapMVar request) responseCookieMap' + + +-- | Constructs a cookie with the given name and value. Version is set to 1; +-- path, domain, and maximum age are set to @Nothing@; and the secure flag is +-- set to @False@. Constructing the cookie does not cause it to be set; to do +-- that, call 'setCookie' on it. +mkSimpleCookie + :: String -- ^ The name of the cookie to construct. + -> String -- ^ The value of the cookie to construct. + -> Cookie -- ^ A cookie with the given name and value. +mkSimpleCookie name value = Cookie { + cookieName = name, + cookieValue = value, + cookieVersion = 1, + cookiePath = Nothing, + cookieDomain = Nothing, + cookieMaxAge = Nothing, + cookieSecure = False, + cookieComment = Nothing + } + + +-- | Constructs a cookie with the given parameters. Version is set to 1. +-- Constructing the cookie does not cause it to be set; to do that, call 'setCookie' +-- on it. +mkCookie + :: String -- ^ The name of the cookie to construct. + -> String -- ^ The value of the cookie to construct. + -> (Maybe String) -- ^ The path of the cookie to construct. + -> (Maybe String) -- ^ The domain of the cookie to construct. + -> (Maybe Int) -- ^ The maximum age of the cookie to construct, in seconds. + -> Bool -- ^ Whether to flag the cookie to construct as secure. + -> Cookie -- ^ A cookie with the given parameters. +mkCookie name value maybePath maybeDomain maybeMaxAge secure + = Cookie { + cookieName = name, + cookieValue = value, + cookieVersion = 1, + cookiePath = maybePath, + cookieDomain = maybeDomain, + cookieMaxAge = maybeMaxAge, + cookieSecure = secure, + cookieComment = Nothing + } + + +mkUnsetCookie :: String -> Cookie +mkUnsetCookie name = Cookie { + cookieName = name, + cookieValue = "", + cookieVersion = 1, + cookiePath = Nothing, + cookieDomain = Nothing, + cookieMaxAge = Just 0, + cookieSecure = False, + cookieComment = Nothing + } + + +requireValidCookieName :: (MonadFastCGI m) => String -> m () +requireValidCookieName name = do + let valid = (length name > 0) && (all validCharacter name) + validCharacter c = (ord c > 0) && (ord c < 128) + && (not $ elem c "()<>@,;:\\\"/[]?={} \t") + if not valid + then fThrow $ CookieNameInvalid name + else return () + + +-- | An exception originating within the FastCGI infrastructure or the web server. +data FastCGIException + = ResponseHeadersAlreadySent + -- ^ An exception thrown by operations which require the response headers not + -- to have been sent yet. + | OutputAlreadyClosed + -- ^ An exception thrown by operations which produce output when output has + -- been closed, as by 'fCloseOutput'. + | NotAResponseHeader Header + -- ^ An exception thrown by operations which are given a header that does not + -- meet their requirement of being valid in a response. + | CookieNameInvalid String + -- ^ An exception thrown by operations which are given cookie names that do not + -- meet the appropriate syntax requirements. + deriving (Show, Typeable) + + +instance Exception.Exception FastCGIException + + +-- | Sets the HTTP/1.1 return status to 301 and sets the 'HttpLocation' header to +-- the provided URL. This has the effect of issuing a permanent redirect to the +-- user agent. Permanent redirects, as opposed to temporary redirects, may cause +-- bookmarks or incoming links to be updated. If the response headers have already +-- been sent, causes a 'ResponseHeadersAlreadySent' exception. +permanentRedirect + :: (MonadFastCGI m) + => String -- ^ The URL to redirect to, as a string. + -> m () +permanentRedirect url = do + setResponseStatus 301 + setResponseHeader HttpLocation url + + +-- | Sets the HTTP/1.1 return status to 303 and sets the 'HttpLocation' header to +-- the provided URL. This has the effect of issuing a see-other or "temporary" +-- redirect to the user agent. Temporary redirects, as opposed to permanent redirects, +-- do not cause bookmarks or incoming links to be updated. If the response headers +-- have already been sent, causes a 'ResponseHeadersAlreadySent' exception. +seeOtherRedirect + :: (MonadFastCGI m) + => String -- ^ The URL to redirect to, as a string. + -> m () +seeOtherRedirect url = do + setResponseStatus 303 + setResponseHeader HttpLocation url + + +-- | Ensures that the response headers have been sent. If they are already sent, does +-- nothing. If output has already been closed, causes an 'OutputAlreadyClosed' +-- exception. +sendResponseHeaders :: (MonadFastCGI m) => m () +sendResponseHeaders = do + requireOutputNotYetClosed + FastCGIState { request = Just request } <- getFastCGIState + alreadySent <- liftIO $ takeMVar $ responseHeadersSentMVar request + if not alreadySent + then do + responseStatus <- liftIO $ readMVar $ responseStatusMVar request + responseHeaderMap <- liftIO $ readMVar $ responseHeaderMapMVar request + responseCookieMap <- liftIO $ readMVar $ responseCookieMapMVar request + fLog $ show responseCookieMap + let nameValuePairs = [("Status", (show responseStatus))] + ++ (map (\key -> (fromHeader key, + fromJust $ Map.lookup key responseHeaderMap)) + $ Map.keys responseHeaderMap) + ++ (if (isNothing $ Map.lookup HttpSetCookie + responseHeaderMap) + && (length (Map.elems responseCookieMap) > 0) + then [("Set-Cookie", setCookieValue)] + else []) + setCookieValue = printCookies $ Map.elems responseCookieMap + bytestrings + = (map (\(name, value) -> BS.fromString $ name ++ ": " ++ value ++ "\r\n") + nameValuePairs) + ++ [BS.fromString "\r\n"] + buffer = foldl BS.append BS.empty bytestrings + sendBuffer buffer + else return () + liftIO $ putMVar (responseHeadersSentMVar request) True + + +-- | Returns whether the response headers have been sent. +responseHeadersSent :: (MonadFastCGI m) => m Bool +responseHeadersSent = do + FastCGIState { request = Just request } <- getFastCGIState + liftIO $ readMVar $ responseHeadersSentMVar request + + +-- | Sends data. This is the content data of the HTTP response. If the response +-- headers have not been sent, first sends them. If output has already been closed, +-- causes an 'OutputAlreadyClosed' exception. +fPut :: (MonadFastCGI m) => BS.ByteString -> m () +fPut buffer = do + requireOutputNotYetClosed + sendResponseHeaders + sendBuffer buffer + return () + + +-- | Sends text, encoded as UTF-8. This is the content data of the HTTP response. +-- if the response headers have not been sent, first sends them. If output has +-- already been closed, causes an 'OutputAlreadyClosed' exception. +fPutStr :: (MonadFastCGI m) => String -> m () +fPutStr string = fPut $ BS.fromString string + + +-- | Informs the web server and the user agent that the request has completed. As +-- a side-effect, any unread input is discarded and no more can be read. This is +-- implicitly called, if it has not already been, after the handler returns; it +-- may be useful within a handler if the handler wishes to return results and then +-- perform time-consuming computations before exiting. If output has already been +-- closed, causes an 'OutputAlreadyClosed' exception. +fCloseOutput :: (MonadFastCGI m) => m () +fCloseOutput = do + requireOutputNotYetClosed + terminateRequest + + +-- | Returns whether it is possible to write more data; ie, whether output has not +-- yet been closed as by 'fCloseOutput'. +fIsWritable :: (MonadFastCGI m) => m Bool +fIsWritable = do + FastCGIState { request = Just request } <- getFastCGIState + requestEnded <- liftIO $ readMVar $ requestEndedMVar request + return $ not requestEnded + + +sendBuffer :: (MonadFastCGI m) => BS.ByteString -> m () +sendBuffer buffer = do + let length = BS.length buffer + lengthThisRecord = minimum [length, 0xFFFF] + bufferThisRecord = BS.take lengthThisRecord buffer + bufferRemaining = BS.drop lengthThisRecord buffer + if lengthThisRecord > 0 + then do + FastCGIState { request = Just request } <- getFastCGIState + sendRecord $ Record { + recordType = StdoutRecord, + recordRequestID = requestID request, + recordContent = bufferThisRecord + } + else return () + if length > lengthThisRecord + then sendBuffer bufferRemaining + else return () + + +terminateRequest :: (MonadFastCGI m) => m () +terminateRequest = do + FastCGIState { request = Just request } <- getFastCGIState + sendRecord $ Record { + recordType = EndRequestRecord, + recordRequestID = requestID request, + recordContent = BS.pack [0, 0, 0, 0, 0, 0, 0, 0] + } + + +requireResponseHeadersNotYetSent :: (MonadFastCGI m) => m () +requireResponseHeadersNotYetSent = do + FastCGIState { request = Just request } <- getFastCGIState + alreadySent <- liftIO $ readMVar $ responseHeadersSentMVar request + if alreadySent + then fThrow ResponseHeadersAlreadySent + else return () + + +requireOutputNotYetClosed :: (MonadFastCGI m) => m () +requireOutputNotYetClosed = do + FastCGIState { request = Just request } <- getFastCGIState + requestEnded <- liftIO $ readMVar $ requestEndedMVar request + if requestEnded + then fThrow OutputAlreadyClosed + else return () + + +-- | Throw an exception in any 'MonadFastCGI' monad. +fThrow + :: (Exception.Exception e, MonadFastCGI m) + => e -- ^ The exception to throw. + -> m a +fThrow exception = implementationThrowFastCGI exception + + +-- | Perform an action, with a given exception-handler action bound. See +-- 'Control.Exception.catch'. The type of exception to catch is determined by the +-- type signature of the handler. +fCatch + :: (Exception.Exception e, MonadFastCGI m) + => m a -- ^ The action to run with the exception handler binding in scope. + -> (e -> m a) -- ^ The exception handler to bind. + -> m a +fCatch action handler = implementationCatchFastCGI action handler + + +-- | Block exceptions within an action, as per the discussion in 'Control.Exception'. +fBlock + :: (MonadFastCGI m) + => m a -- ^ The action to run with exceptions blocked. + -> m a +fBlock action = implementationBlockFastCGI action + + +-- | Unblock exceptions within an action, as per the discussion in 'Control.Exception'. +fUnblock + :: (MonadFastCGI m) + => m a -- ^ The action to run with exceptions unblocked. + -> m a +fUnblock action = implementationUnblockFastCGI action + + +-- | Acquire a resource, perform computation with it, and release it; see the description +-- of 'Control.Exception.bracket'. If an exception is raised during the computation, +-- 'fBracket' will re-raise it after running the release function, having the effect +-- of propagating the exception further up the call stack. +fBracket + :: (MonadFastCGI m) + => m a -- ^ The action to acquire the resource. + -> (a -> m b) -- ^ The action to release the resource. + -> (a -> m c) -- ^ The action to perform using the resource. + -> m c -- ^ The return value of the perform-action. +fBracket acquire release perform = do + fBlock (do + resource <- acquire + result <- fUnblock (perform resource) `fOnException` (release resource) + release resource + return result) + + +-- | Perform an action, with a cleanup action bound to always occur; see the +-- description of 'Control.Exception.finally'. If an exception is raised during the +-- computation, 'fFinally' will re-raise it after running the cleanup action, having +-- the effect of propagating the exception further up the call stack. If no +-- exception is raised, the cleanup action will be invoked after the main action is +-- performed. +fFinally + :: (MonadFastCGI m) + => m a -- ^ The action to perform. + -> m b -- ^ The cleanup action. + -> m a -- ^ The return value of the perform-action. +fFinally perform cleanup = do + fBlock (do + result <- fUnblock perform `fOnException` cleanup + cleanup + return result) + + +-- | Perform an action. If any exceptions of the appropriate type occur within the +-- action, return 'Left' @exception@; otherwise, return 'Right' @result@. +fTry + :: (Exception.Exception e, MonadFastCGI m) + => m a -- ^ The action to perform. + -> m (Either e a) +fTry action = do + fCatch (do + result <- action + return $ Right result) + (\exception -> return $ Left exception) + + +-- | As 'fCatch', but with the arguments in the other order. +fHandle + :: (Exception.Exception e, MonadFastCGI m) + => (e -> m a) -- ^ The exception handler to bind. + -> m a -- ^ The action to run with the exception handler binding in scope. + -> m a +fHandle handler action = fCatch action handler + + +-- | Perform an action, with a cleanup action bound to occur if and only if an exception +-- is raised during the action; see the description of 'Control.Exception.finally'. +-- If an exception is raised during the computation, 'fFinally' will re-raise it +-- after running the cleanup action, having the effect of propagating the exception +-- further up the call stack. If no exception is raised, the cleanup action will not +-- be invoked. +fOnException + :: (MonadFastCGI m) + => m a -- ^ The action to perform. + -> m b -- ^ The cleanup action. + -> m a -- ^ The return value of the perform-action. +fOnException action cleanup = do + fCatch action + (\exception -> do + cleanup + fThrow (exception :: Exception.SomeException)) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple + +main = defaultMain diff --git a/direct-fastcgi.cabal b/direct-fastcgi.cabal new file mode 100644 --- /dev/null +++ b/direct-fastcgi.cabal @@ -0,0 +1,35 @@ +name: direct-fastcgi +version: 1.0 +cabal-version: >= 1.2 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: Copyright (c) 2009 Dan Knapp +author: Dan Knapp +maintainer: dankna@gmail.com +homepage: http://dankna.com/software/ +bug-reports: http://dankna.com/issues/create/ +category: Network +synopsis: Native implementation of the FastCGI protocol. +description: + This package is a native implementation of the FastCGI protocol, allowing + Haskell to work with any webserver that supports it. It makes no attempt to + imitate the interface of the cgi-3000 and fastcgi-3000 packages, because + that API is tied too heavily to legacy interfaces, as with its handling of + exceptions, logging, and time. Its advantage over those packages is + primarily in the area of clean exception management and better control + structure which allows more versatility in processing requests which are + not simple GETs. In particular, POST of large files should be possible, as + should server-push responses which return content a piece at a time. Also, + of course, as a native implementation, there is no dependency on a C + library, which simplifies the install process. + +Library + exposed-modules: Network.FastCGI + build-depends: base >= 4.1 && < 5, + bytestring >= 0.9.1.4 && < 1, + containers >= 0.3.0.0 && < 1, + mtl >= 1.1.0.2 && < 2, + network >= 2.2.1.7 && < 3, + network-bytestring >= 0.1.2.1 && < 1, + utf8-string >= 0.3.6 && < 1