fastcgi-3001.0.2.4/0000755000000000000000000000000012115461523011705 5ustar0000000000000000fastcgi-3001.0.2.4/Setup.lhs0000644000000000000000000000015612115461523013517 0ustar0000000000000000#!/usr/bin/env runghc > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain fastcgi-3001.0.2.4/fastcgi.buildinfo.in0000644000000000000000000000011412115461523015623 0ustar0000000000000000ghc-options: -optc@CPPFLAGS@ cc-options: @CPPFLAGS@ ld-options: @LDFLAGS@ fastcgi-3001.0.2.4/LICENSE0000644000000000000000000000266412115461523012722 0ustar0000000000000000Copyright (c) Bjorn Bringert, Lemmih All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. fastcgi-3001.0.2.4/fastcgi.cabal0000644000000000000000000000165612115461523014321 0ustar0000000000000000Name: fastcgi Version: 3001.0.2.4 Copyright: Bjorn Bringert, Lemmih Maintainer: Chris Done License: BSD3 license-file: LICENSE Category: Network Synopsis: A Haskell library for writing FastCGI programs Description: This library lets you write FastCGI programs. This package reuses the cgi package API, making it very easy to port CGI programs to FastCGI. The FastCGI C development kit is required to build this library. Cabal-version: >= 1.2.0 build-type: Configure extra-source-files: configure fastcgi.buildinfo.in flag small_base description: Choose the new smaller, split-up base package. library build-depends: base >= 4 && < 5, cgi >= 3000.0.0, bytestring >= 0.9.1.5 Extensions: ForeignFunctionInterface, EmptyDataDecls, ScopedTypeVariables Exposed-Modules: Network.FastCGI ghc-options: -O2 -Wall includes: fcgiapp.h extra-libraries: fcgi fastcgi-3001.0.2.4/configure0000755000000000000000000000040312115461523013611 0ustar0000000000000000#!/bin/sh # # subst standard header path variables if test -n "$CPPFLAGS" ; then echo "Found CPPFLAGS in environment: '$CPPFLAGS'" sed 's,@CPPFLAGS@,'"$CPPFLAGS"',g;s,@LDFLAGS@,'"$LDFLAGS"',g' \ < fastcgi.buildinfo.in > fastcgi.buildinfo fi fastcgi-3001.0.2.4/Network/0000755000000000000000000000000012115461523013336 5ustar0000000000000000fastcgi-3001.0.2.4/Network/FastCGI.hsc0000644000000000000000000002177312115461523015267 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Network.FastCGI -- Copyright : (c) Bjorn Bringert 2004-2005, (c) Lemmih 2006 -- License : BSD-style (see the file libraries/network/LICENSE) -- -- Maintainer : lemmih@gmail.com -- Stability : experimental -- Portability : non-portable (uses FFI) -- -- Interface for FastCGI , using the fcgiapp API. -- ----------------------------------------------------------------------------- module Network.FastCGI ( -- * Single-threaded interface runFastCGIorCGI , runOneFastCGIorCGI , runFastCGI , runOneFastCGI -- * Concurrent interface , runFastCGIConcurrent , runFastCGIConcurrent' -- * Re-export , module Network.CGI ) where import Control.Concurrent ( forkOS ) import Control.Concurrent.MVar import Control.Concurrent.QSem import Control.Exception 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 Network.CGI import Network.CGI.Monad (runCGIT) import Network.CGI.Protocol (runCGIEnvFPS) 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 ------------------------------------------------------------------------ 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 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 () ------------------------------------------------------------------------ -- | 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 :: CGI CGIResult -> 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 :: CGI CGIResult -> IO Bool -- ^ True if it was a FastCGI request, -- False if CGI. runOneFastCGIorCGI f = do x <- fcgx_isCGI if x /= 0 then runCGI f >> return False else runOneFastCGI f >> return True -- | Handle FastCGI requests in an infinite loop. runFastCGI :: CGI CGIResult -> IO () runFastCGI f = runOneFastCGI f >> runFastCGI f -- | Handle a single FastCGI request. runOneFastCGI :: CGI CGIResult -> IO () runOneFastCGI f = do alloca (\inp -> alloca (\outp -> alloca (\errp -> alloca (\envp -> oneRequest f inp outp errp envp)))) oneRequest :: CGI CGIResult -> 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 :: CGI CGIResult -> StreamPtr -> StreamPtr -> StreamPtr -> Environ -> IO () handleRequest f ins outs _errs env = do vars <- environToTable env input <- sRead ins output' <- runCGIEnvFPS vars input (runCGIT 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 safe "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. -> CGI CGIResult -> IO () runFastCGIConcurrent = runFastCGIConcurrent' forkOS runFastCGIConcurrent' :: (IO () -> IO a) -- ^ How to fork a request. -> Int -- ^ Max number of concurrent threads. -> CGI CGIResult -> 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::IOException) -> log (show e) oneRequestMT :: CGI CGIResult -> Ptr FCGX_Request -> IO () oneRequestMT f r = do env <- peekEnvp r vars <- environToTable env ins <- peekIn r input <- sRead ins output' <- runCGIEnvFPS vars input (runCGIT f) 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) `catch` \(_ :: IOException) -> return () 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))