hack-handler-fastcgi (empty) → 0.0.0
raw patch · 4 files changed
+340/−0 lines, 4 filesdep +basedep +bytestringdep +hacksetup-changed
Dependencies added: base, bytestring, hack, hack-handler-cgi
Files
- Hack/Handler/FastCGI.hsc +289/−0
- LICENSE +25/−0
- Setup.lhs +7/−0
- hack-handler-fastcgi.cabal +19/−0
+ Hack/Handler/FastCGI.hsc view
@@ -0,0 +1,289 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE EmptyDataDecls #-}+-----------------------------------------------------------------------------+-- |+-- Module : Hack.Handler.FastCGI+-- Copyright : (c) Bjorn Bringert 2004-2005, (c) Lemmih 2006+-- License : BSD-style (see the file libraries/network/LICENSE)+-- +-- Maintainer : michael@snoyman.com+-- Stability : experimental+-- Portability : non-portable (uses FFI)+--+-- Interface for FastCGI <http://fastcgi.com/>, using the fcgiapp API.+-- Totally ripped off by Michael Snoyman to work with Hack.+--+-----------------------------------------------------------------------------+module Hack.Handler.FastCGI+ (+ -- * Single-threaded interface+ runFastCGIorCGI+ , runOneFastCGIorCGI+ , runFastCGI+ , runOneFastCGI+ -- * Concurrent interface+ , runFastCGIConcurrent+ , runFastCGIConcurrent'+ ) where++import Control.Concurrent ( forkOS )+import Control.Concurrent.MVar+import Control.Concurrent.QSem+import Control.OldException as Exception (catch, finally)+import Control.Monad ( liftM )+import Data.Word (Word8)+import Foreign ( Ptr, castPtr, nullPtr, peekArray0 + , alloca, mallocBytes, free, throwIfNeg_)+import Foreign.C ( CInt, CString, CStringLen+ , peekCString )+import Foreign.Storable ( Storable (..) )+import System.IO.Unsafe (unsafeInterleaveIO,unsafePerformIO)++import qualified Hack+import qualified Hack.Handler.CGI as CGI++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy.Char8 as Lazy+#if __GLASGOW_HASKELL__ >= 608+import qualified Data.ByteString.Internal as BSB+import qualified Data.ByteString.Unsafe as BSB+#else+import qualified Data.ByteString.Base as BSB+#endif++-- For debugging+import Control.Concurrent ( myThreadId )+import Prelude hiding ( log, catch )+import System.IO ( hPutStrLn, stderr )++#include <fcgiapp.h>++------------------------------------------------------------------------++data FCGX_Stream+type StreamPtr = Ptr FCGX_Stream+type Environ = Ptr CString++------------------------------------------------------------------------++foreign import ccall unsafe "fcgiapp.h FCGX_IsCGI" fcgx_isCGI+ :: IO CInt++foreign import ccall unsafe "fcgiapp.h FCGX_GetStr" fcgx_getStr+ :: CString -> CInt -> StreamPtr -> IO CInt++foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr+ :: CString -> CInt -> StreamPtr -> IO CInt++foreign import ccall threadsafe "fcgiapp.h FCGX_Accept" fcgx_accept+ :: Ptr StreamPtr -> Ptr StreamPtr -> Ptr StreamPtr -> Ptr Environ -> IO CInt+foreign import ccall unsafe "fcgiapp.h FCGX_Finish" fcgx_finish+ :: IO ()++------------------------------------------------------------------------++-- | Handle a single CGI request, or FastCGI requests in an infinite loop.+-- This function only returns normally if it was a CGI request.+-- This lets you use the same program+-- as either a FastCGI or CGI program, depending on what the server +-- treats it as.+runFastCGIorCGI :: Hack.Application -> IO ()+runFastCGIorCGI f = do fcgi <- runOneFastCGIorCGI f+ if fcgi then runFastCGIorCGI f+ else return ()++-- | Handle a single FastCGI or CGI request. This lets you use the same program+-- as either a FastCGI or CGI program, depending on what the server +-- treats it as.+runOneFastCGIorCGI :: Hack.Application+ -> IO Bool -- ^ True if it was a FastCGI request, + -- False if CGI.+runOneFastCGIorCGI f =+ do x <- fcgx_isCGI+ if x /= 0 then CGI.run f >> return False+ else runOneFastCGI f >> return True++-- | Handle FastCGI requests in an infinite loop.+runFastCGI :: Hack.Application -> IO ()+runFastCGI f = runOneFastCGI f >> runFastCGI f++-- | Handle a single FastCGI request.+runOneFastCGI :: Hack.Application -> IO ()+runOneFastCGI f = do+ alloca (\inp ->+ alloca (\outp ->+ alloca (\errp ->+ alloca (\envp ->+ oneRequest f inp outp errp envp))))++oneRequest :: Hack.Application+ -> Ptr StreamPtr+ -> Ptr StreamPtr+ -> Ptr StreamPtr+ -> Ptr Environ+ -> IO ()+oneRequest f inp outp errp envp =+ do+ testReturn "FCGX_Accept" $ fcgx_accept inp outp errp envp+ ins <- peek inp+ outs <- peek outp+ errs <- peek errp+ env <- peek envp+ handleRequest f ins outs errs env+ fcgx_finish++handleRequest :: Hack.Application+ -> StreamPtr+ -> StreamPtr+ -> StreamPtr+ -> Environ+ -> IO ()+handleRequest f ins outs _errs env =+ do+ vars <- environToTable env+ input <- sRead ins+ output <- CGI.helper vars input f+ sPutStr outs output++++data FCGX_Request++foreign import ccall unsafe "fcgiapp.h FCGX_Init" fcgx_init+ :: IO CInt++foreign import ccall unsafe "fcgiapp.h FCGX_InitRequest" fcgx_initrequest+ :: Ptr FCGX_Request -> CInt -> CInt -> IO CInt++foreign import ccall threadsafe "fcgiapp.h FCGX_Accept_r" fcgx_accept_r+ :: Ptr FCGX_Request -> IO CInt++foreign import ccall unsafe "fcgiapp.h FCGX_Finish_r" fcgx_finish_r+ :: Ptr FCGX_Request -> IO ()++-- | Like 'Network.CGI.runCGI', but uses the FastCGI interface+-- and forks off a new thread (using 'forkOS') for every request.+runFastCGIConcurrent :: Int -- ^ Max number of concurrent threads.+ -> Hack.Application -> IO ()+runFastCGIConcurrent = runFastCGIConcurrent' forkOS++runFastCGIConcurrent' :: (IO () -> IO a) -- ^ How to fork a request.+ -> Int -- ^ Max number of concurrent threads.+ -> Hack.Application -> IO ()++runFastCGIConcurrent' fork m f+ = do qsem <- newQSem m+ testReturn "FCGX_Init" $ fcgx_init+ let loop = do waitQSem qsem+ reqp <- acceptRequest+ fork (oneRequestMT f reqp+ `finally`+ (finishRequest reqp >> signalQSem qsem))+ loop+ loop `catch` \e -> log (show e)++oneRequestMT :: Hack.Application -> Ptr FCGX_Request -> IO ()+oneRequestMT app r = do+ env <- peekEnvp r+ vars <- environToTable env+ ins <- peekIn r+ input <- sRead ins+ output <- CGI.helper vars input app+ outs <- peekOut r+ sPutStr outs output+--+-- * FCGX_Reqest struct+--++acceptRequest :: IO (Ptr FCGX_Request)+acceptRequest = do+ reqp <- mallocBytes (#size FCGX_Request)+ initAndAccept reqp+ return reqp+ where initAndAccept reqp = do+ testReturn "FCGX_InitRequest" $ fcgx_initrequest reqp 0 0+ testReturn "FCGX_Accept_r" $ fcgx_accept_r reqp++finishRequest :: Ptr FCGX_Request -> IO ()+finishRequest reqp = do+ fcgx_finish_r reqp+ free reqp++peekIn, peekOut, _peekErr :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)+peekIn = (#peek FCGX_Request, in)+peekOut = (#peek FCGX_Request, out)+_peekErr = (#peek FCGX_Request, err)++peekEnvp :: Ptr FCGX_Request -> IO Environ+peekEnvp = (#peek FCGX_Request, envp)+++--+-- * Stream IO+--++sPutStr :: StreamPtr -> Lazy.ByteString -> IO ()+sPutStr h str =+ mapM_ (flip BSB.unsafeUseAsCStringLen (fcgxPutCStringLen h)) (Lazy.toChunks str)++fcgxPutCStringLen :: StreamPtr -> CStringLen -> IO ()+fcgxPutCStringLen h (cs,len) =+ testReturn "FCGX_PutStr" $ fcgx_putStr cs (fromIntegral len) h++sRead :: StreamPtr -> IO Lazy.ByteString+sRead h = buildByteString (fcgxGetBuf h) 4096++fcgxGetBuf :: StreamPtr -> Ptr a -> Int -> IO Int+fcgxGetBuf h p c =+ liftM fromIntegral $ fcgx_getStr (castPtr p) (fromIntegral c) h++--+-- * ByteString utilities+--++-- | Data.ByteString.Lazy.hGetContentsN generalized to arbitrary +-- reading functions.+buildByteString :: (Ptr Word8 -> Int -> IO Int) -> Int -> IO Lazy.ByteString+buildByteString f k = lazyRead >>= return . Lazy.fromChunks+ where+ lazyRead = unsafeInterleaveIO $ do+ ps <- BSB.createAndTrim k $ \p -> f p k+ case BS.length ps of+ 0 -> return []+ n | n < k -> return [ps]+ _ -> do pss <- lazyRead+ return (ps : pss)++--+-- * Utilities+--++testReturn :: String -> IO CInt -> IO ()+testReturn e = throwIfNeg_ (\n -> e ++ " failed with error code: "++ show n)++environToTable :: Environ -> IO [(String,String)]+environToTable arr =+ do css <- peekArray0 nullPtr arr+ ss <- mapM peekCString css+ return $ map (splitBy '=') ss++-- | Split a list at the first occurence of a marker.+-- Do not include the marker in any of the resulting lists.+-- If the marker does not occur in the list, the entire+-- input with be in the first list.+splitBy :: Eq a => a -> [a] -> ([a],[a])+splitBy x xs = (y, drop 1 z)+ where (y,z) = break (==x) xs++--+-- * Debugging+--++{-# NOINLINE logMutex #-}+logMutex :: MVar ()+logMutex = unsafePerformIO (newMVar ())++log :: String -> IO ()+log msg = do+ t <- myThreadId+ withMVar logMutex (const $ hPutStrLn stderr (show t ++ ": " ++ msg))
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2008, 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.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ hack-handler-fastcgi.cabal view
@@ -0,0 +1,19 @@+name: hack-handler-fastcgi+version: 0.0.0+license: BSD3+license-file: LICENSE+author: Michael Snoyman <michael@snoyman.com>+maintainer: Michael Snoyman <michael@snoyman.com>+synopsis: Hack handler direct to fastcgi+category: Web+stability: stable+cabal-version: >= 1.2+build-type: Simple+homepage: http://github.com/snoyberg/hack-handler-fastcgi/tree/master++library+ build-depends: base, hack >= 2009.5.19, bytestring, hack-handler-cgi+ exposed-modules: Hack.Handler.FastCGI+ ghc-options: -Wall+ includes: fcgiapp.h+ extra-libraries: fcgi