wai-handler-fastcgi (empty) → 0.0.0
raw patch · 4 files changed
+157/−0 lines, 4 filesdep +basedep +bytestringdep +direct-fastcgisetup-changed
Dependencies added: base, bytestring, direct-fastcgi, mtl, wai
Files
- LICENSE +25/−0
- Network/Wai/Handler/FastCGI.hs +100/−0
- Setup.lhs +7/−0
- wai-handler-fastcgi.cabal +25/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2009, Michael Snoyman. 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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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/Wai/Handler/FastCGI.hs view
@@ -0,0 +1,100 @@+module Network.Wai.Handler.FastCGI+ ( run+ ) where++import qualified Network.Wai as W+import Network.FastCGI+import Control.Concurrent (forkIO)+import Control.Monad.Trans+import Control.Monad.Reader+import qualified Data.ByteString.Char8 as B+import qualified System.IO+import Control.Arrow ((***))+import Data.Char (toLower)+import Data.Maybe (fromMaybe)+import Data.ByteString.Lazy.Internal (defaultChunkSize)+import Network.Wai.Enumerator (fromEitherFile)++run :: W.Application -> IO ()+run = acceptLoop forkIO . conv++safeRead :: Read a => a -> String -> a+safeRead d s =+ case reads s of+ ((x, _):_) -> x+ [] -> d++lookup' :: String -> [(String, String)] -> String+lookup' key pairs = fromMaybe "" $ lookup key pairs++conv :: W.Application -> FastCGI ()+conv app = do+ vars <- getAllRequestVariables+ let rmethod = W.methodFromBS $ B.pack $ lookup' "REQUEST_METHOD" vars+ pinfo = lookup' "PATH_INFO" vars+ qstring = lookup' "QUERY_STRING" vars+ servername = lookup' "SERVER_NAME" vars+ serverport = safeRead 80 $ lookup' "SERVER_PORT" vars+ contentLength = safeRead 0 $ lookup' "CONTENT_LENGTH" vars+ remoteHost' =+ case lookup "REMOTE_HOST" vars of+ Just x -> x+ Nothing ->+ case lookup "REMOTE_ADDR" vars of+ Just x -> x+ Nothing -> ""+ urlScheme' =+ case map toLower $ lookup' "SERVER_PROTOCOL" vars of -- FIXME get httpVersion too+ "https" -> W.HTTPS+ _ -> W.HTTP+ state <- ask+ let env = W.Request+ { W.requestMethod = rmethod+ , W.pathInfo = B.pack pinfo+ , W.queryString = B.pack qstring+ , W.serverName = B.pack servername+ , W.serverPort = serverport+ , W.requestHeaders = map (cleanupVarName *** B.pack) vars+ , W.urlScheme = urlScheme'+ , W.requestBody = requestBody state contentLength+ , W.errorHandler = System.IO.hPutStr System.IO.stderr+ , W.remoteHost = B.pack remoteHost'+ , W.httpVersion = W.HttpVersion B.empty+ }+ res <- liftIO $ app env+ setResponseStatus $ W.statusCode $ W.status res+ mapM_ setHeader $ W.responseHeaders res+ _ <- liftIO $ W.runEnumerator+ (fromEitherFile (W.responseBody res))+ (myPut state)+ ()+ return ()++cleanupVarName :: String -> W.RequestHeader+cleanupVarName ('H':'T':'T':'P':'_':a:as) =+ W.requestHeaderFromBS $ B.pack $ a : helper' as where+ helper' ('_':x:rest) = '-' : x : helper' rest+ helper' (x:rest) = toLower x : helper' rest+ helper' [] = []+cleanupVarName "CONTENT_TYPE" = W.ReqContentType+cleanupVarName "CONTENT_LENGTH" = W.ReqContentLength+cleanupVarName "SCRIPT_NAME" = W.requestHeaderFromBS $ B.pack "CGI-Script-Name"+cleanupVarName x = W.requestHeaderFromBS $ B.pack x -- FIXME remove?++requestBody :: FastCGIState -> Int -> W.Source+requestBody _ 0 = W.Source $ return Nothing+requestBody state len = W.Source $ do+ bs <- runReaderT (fGet defaultChunkSize) state+ let newLen = len - B.length bs+ return $ Just (bs, requestBody state newLen)++setHeader :: MonadFastCGI m => (W.ResponseHeader, B.ByteString) -> m ()+setHeader (k, v) =+ setResponseHeader+ (HttpExtensionHeader $ B.unpack $ W.responseHeaderToBS k)+ (B.unpack v)++myPut :: FastCGIState -> () -> B.ByteString -> IO (Either () ())+myPut state _ bs = do+ runReaderT (fPut bs) state+ return $ Right ()
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ wai-handler-fastcgi.cabal view
@@ -0,0 +1,25 @@+name: wai-handler-fastcgi+version: 0.0.0+license: BSD3+license-file: LICENSE+author: Michael Snoyman <michael@snoyman.com>+maintainer: Michael Snoyman <michael@snoyman.com>+synopsis: WAI wrapper around direct-fastcgi+category: Web+stability: Stable+cabal-version: >= 1.6+build-type: Simple+homepage: http://github.com/snoyberg/wai-handler-fastcgi++library+ build-depends: base >= 4 && < 5,+ wai >= 0.0.1 && < 0.1,+ bytestring >= 0.9.1.4 && < 0.10,+ mtl >= 1.1.0.2 && < 1.2,+ direct-fastcgi >= 1.0.1.1 && < 1.1+ exposed-modules: Network.Wai.Handler.FastCGI+ ghc-options: -Wall++source-repository head+ type: git+ location: git://github.com/snoyberg/wai-handler-fastcgi.git