wai-handler-fastcgi 0.2.1 → 0.2.2
raw patch · 2 files changed
+61/−50 lines, 2 files
Files
- Network/Wai/Handler/FastCGI.hsc +60/−49
- wai-handler-fastcgi.cabal +1/−1
Network/Wai/Handler/FastCGI.hsc view
@@ -1,12 +1,11 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Network.Wai.Handler.FastCGI--- Copyright : (c) Bjorn Bringert 2004-2005, (c) Lemmih 2006+-- Copyright : (c) Bjorn Bringert 2004-2005, (c) Lemmih 2006, (c) Michael Snoyman 2010 -- License : BSD-style (see the file libraries/network/LICENSE)--- +-- -- Maintainer : michael@snoyman.com -- Stability : experimental -- Portability : non-portable (uses FFI)@@ -18,15 +17,16 @@ module Network.Wai.Handler.FastCGI ( run , runSendfile+ , runFork ) where -import Data.Maybe-import Control.Monad ( liftM )+import Control.Monad ( liftM, forever ) import Data.Word (Word8) import Foreign ( Ptr, castPtr, nullPtr, peekArray0- , alloca, throwIfNeg_)+ , throwIfNeg_, mallocBytes, free ) import Foreign.C ( CInt, CString, CStringLen , peekCString )+import Control.Exception (finally) import Foreign.Storable ( Storable (..) ) import qualified Network.Wai as W@@ -34,16 +34,9 @@ import qualified Network.Wai.Handler.Helper as CGI import qualified Data.ByteString as BS-#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 Prelude hiding ( log, catch )- #include <fcgiapp.h> ------------------------------------------------------------------------@@ -60,68 +53,86 @@ foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr :: CString -> CInt -> StreamPtr -> IO CInt -foreign import ccall safe "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 () ------------------------------------------------------------------------ +foreign import ccall unsafe "fcgiapp.h FCGX_Init" fcgx_init+ :: IO CInt++runFork :: Maybe String -> (IO () -> IO a) -> Int -> W.Application -> IO ()+runFork sf fork threads app = do+ testReturn "FCGX_Init" $ fcgx_init+ let oneThread = forever $ oneRequest app sf+ mapM_ fork $ replicate (threads - 1) oneThread+ oneThread+ -- | Handle FastCGI requests in an infinite loop. run :: W.Application -> IO ()-run f = runOneFastCGI Nothing f >> run f+run = runFork Nothing id 1 -- | Handle FastCGI requests in an infinite loop. For a server which supports -- the X-Sendfile header. runSendfile :: String -> W.Application -> IO ()-runSendfile sf f = runOneFastCGI (Just sf) f >> runSendfile sf f---- | Handle a single FastCGI request.-runOneFastCGI :: Maybe String -- X-Sendfile- -> W.Application -> IO ()-runOneFastCGI xsendfile f = do- alloca (\inp ->- alloca (\outp ->- alloca (\errp ->- alloca (\envp ->- oneRequest f inp outp errp envp- xsendfile))))+runSendfile sf = runFork (Just sf) id 1 oneRequest :: W.Application- -> Ptr StreamPtr- -> Ptr StreamPtr- -> Ptr StreamPtr- -> Ptr Environ -> Maybe String -- X-Sendfile -> IO ()-oneRequest f inp outp errp envp xsendfile =- 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 xsendfile- fcgx_finish+oneRequest app xsendfile = withRequest $ \r -> do+ putStrLn "Received 1 request"+ env <- peekEnvp r+ ins <- peekIn r+ outs <- peekOut r+ handleRequest app ins outs env xsendfile +peekIn, peekOut :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)+peekIn = (#peek FCGX_Request, in)+peekOut = (#peek FCGX_Request, out)++peekEnvp :: Ptr FCGX_Request -> IO Environ+peekEnvp = (#peek FCGX_Request, envp)++foreign import ccall unsafe "fcgiapp.h FCGX_InitRequest" fcgx_initrequest+ :: Ptr FCGX_Request -> CInt -> CInt -> IO CInt++foreign import ccall safe "fcgiapp.h FCGX_Accept_r" fcgx_accept_r+ :: Ptr FCGX_Request -> IO CInt++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++withRequest :: (Ptr FCGX_Request -> IO ()) -> IO ()+withRequest f = do+ req <- acceptRequest+ f req `finally` finishRequest req++foreign import ccall unsafe "fcgiapp.h FCGX_Finish_r" fcgx_finish_r+ :: Ptr FCGX_Request -> IO ()++finishRequest :: Ptr FCGX_Request -> IO ()+finishRequest reqp = do+ fcgx_finish_r reqp+ free reqp+ handleRequest :: W.Application -> StreamPtr -> StreamPtr- -> StreamPtr -> Environ -> Maybe String -- sendfile -> IO ()-handleRequest f ins outs _errs env xsendfile =- do+handleRequest f ins outs env xsendfile = do vars <- environToTable env let input = const $ sRead ins let hPut = sPutStr' outs CGI.run'' vars (CGI.requestBodyFunc input) hPut xsendfile f data FCGX_Request--_peekErr :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)-_peekErr = (#peek FCGX_Request, err) -- -- * Stream IO
wai-handler-fastcgi.cabal view
@@ -1,5 +1,5 @@ name: wai-handler-fastcgi-version: 0.2.1+version: 0.2.2 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>