diff --git a/wai-handler-fastcgi/.gitignore b/wai-handler-fastcgi/.gitignore new file mode 100644 index 00000000..f0ddcddc --- /dev/null +++ b/wai-handler-fastcgi/.gitignore @@ -0,0 +1,4 @@ +/dist/ +*.swp +*.hi +*.o diff --git a/wai-handler-fastcgi/LICENSE b/wai-handler-fastcgi/LICENSE new file mode 100644 index 00000000..8643e5d8 --- /dev/null +++ b/wai-handler-fastcgi/LICENSE @@ -0,0 +1,25 @@ +The following license covers this documentation, and the source code, except +where otherwise indicated. + +Copyright 2010, 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. diff --git a/wai-handler-fastcgi/Network/Wai/Handler/FastCGI.hsc b/wai-handler-fastcgi/Network/Wai/Handler/FastCGI.hsc new file mode 100644 index 00000000..6bc679bf --- /dev/null +++ b/wai-handler-fastcgi/Network/Wai/Handler/FastCGI.hsc @@ -0,0 +1,187 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} +----------------------------------------------------------------------------- +-- | +-- Module : Network.Wai.Handler.FastCGI +-- 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) +-- +-- Interface for FastCGI , using the fcgiapp API. +-- Totally ripped off by Michael Snoyman to work with Hack, then WAI. +-- +----------------------------------------------------------------------------- +module Network.Wai.Handler.FastCGI + ( run + , runSendfile + , runFork + ) where + +import Control.Monad ( liftM, forever ) +import Data.Word (Word8) +import Foreign ( Ptr, castPtr, nullPtr, peekArray0 + , throwIfNeg_, mallocBytes, free ) +import Foreign.C (CInt, CString, CStringLen) +import Control.Exception (finally) +import Foreign.Storable ( Storable (..) ) + +import qualified Network.Wai as W +import qualified Network.Wai.Handler.CGI as CGI + +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSB +import qualified Data.ByteString.Unsafe as BSB + +import Control.Arrow ((***)) + +#include + +------------------------------------------------------------------------ + +data FCGX_Stream +type StreamPtr = Ptr FCGX_Stream +type Environ = Ptr CString + +------------------------------------------------------------------------ + +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 unsafe "fcgiapp.h FCGX_Init" fcgx_init + :: IO CInt + +runFork :: Maybe S.ByteString -> (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 = runFork Nothing id 1 + +-- | Handle FastCGI requests in an infinite loop. For a server which supports +-- the X-Sendfile header. +runSendfile :: S.ByteString -> W.Application -> IO () +runSendfile sf = runFork (Just sf) id 1 + +oneRequest :: W.Application + -> Maybe S.ByteString -- X-Sendfile + -> IO () +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 + -> Environ + -> Maybe S.ByteString -- sendfile + -> IO () +handleRequest f ins outs env xsendfile = do + vars <- environToTable env + let vars' = map (S8.unpack *** S8.unpack) vars + let input = const $ sRead ins + let hPut = sPutStr' outs + CGI.runGeneric vars' (CGI.requestBodyFunc input) hPut xsendfile f + +data FCGX_Request + +-- +-- * Stream IO +-- + +sPutStr' :: StreamPtr -> BS.ByteString -> IO () +sPutStr' h str = + BSB.unsafeUseAsCStringLen str $ fcgxPutCStringLen h + +fcgxPutCStringLen :: StreamPtr -> CStringLen -> IO () +fcgxPutCStringLen h (cs,len) = + testReturn "FCGX_PutStr" $ fcgx_putStr cs (fromIntegral len) h + +sRead :: StreamPtr -> IO (Maybe BS.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 (Maybe BS.ByteString) +buildByteString f k = do + ps <- BSB.createAndTrim k $ \p -> f p k + case BS.length ps of + 0 -> return Nothing + _ -> return $ Just ps + +-- +-- * Utilities +-- + +testReturn :: String -> IO CInt -> IO () +testReturn e = throwIfNeg_ (\n -> e ++ " failed with error code: "++ show n) + +environToTable :: Environ -> IO [(S.ByteString, S.ByteString)] +environToTable arr = do + css <- peekArray0 nullPtr arr + ss <- mapM S.packCString css + return $ map splitEq ss + where + splitEq s = + let (a, b) = S.breakByte 61 s + in (a, S.drop 1 b) diff --git a/wai-handler-fastcgi/README b/wai-handler-fastcgi/README new file mode 100644 index 00000000..e69de29b diff --git a/wai-handler-fastcgi/Setup.lhs b/wai-handler-fastcgi/Setup.lhs new file mode 100755 index 00000000..06e2708f --- /dev/null +++ b/wai-handler-fastcgi/Setup.lhs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple + +> main :: IO () +> main = defaultMain diff --git a/wai-handler-fastcgi/configure b/wai-handler-fastcgi/configure new file mode 100644 index 00000000..33c42228 --- /dev/null +++ b/wai-handler-fastcgi/configure @@ -0,0 +1,9 @@ +#!/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 diff --git a/wai-handler-fastcgi/fastcgi.buildinfo.in b/wai-handler-fastcgi/fastcgi.buildinfo.in new file mode 100644 index 00000000..37cc208a --- /dev/null +++ b/wai-handler-fastcgi/fastcgi.buildinfo.in @@ -0,0 +1,3 @@ +ghc-options: -optc@CPPFLAGS@ +cc-options: @CPPFLAGS@ +ld-options: @LDFLAGS@ diff --git a/wai-handler-fastcgi/lighttpd.conf b/wai-handler-fastcgi/lighttpd.conf new file mode 100644 index 00000000..37e982db --- /dev/null +++ b/wai-handler-fastcgi/lighttpd.conf @@ -0,0 +1,19 @@ +# Run with lighttpd -D -f lighttpd.conf +server.port = 3000 +server.document-root = "." +server.modules = ("mod_fastcgi", "mod_rewrite") + +url.rewrite-once = ( + "(.*)" => "/app/$1" +) + +fastcgi.server = ( + "/app" => (( + "socket" => "/tmp/test.fastcgi.socket", + "check-local" => "disable", + "bin-path" => "./test", + "min-procs" => 1, + "max-procs" => 12, + "idle-timeout" => 30 + )) +) diff --git a/wai-handler-fastcgi/test.hs b/wai-handler-fastcgi/test.hs new file mode 100644 index 00000000..21cc766d --- /dev/null +++ b/wai-handler-fastcgi/test.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +import Network.Wai +import Network.Wai.Handler.FastCGI +import Control.Monad.IO.Class +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as L8 +import qualified Data.Enumerator as E + +main = run app + +app req + | pathInfo req == "/" = return $ responseLBS status200 [("Content-Type", "text/html")] "
" +app req = do + bss <- E.consume + return $ responseLBS status200 [("Content-Type", "text/plain")] $ L.concat + [ L8.pack $ show $ requestHeaders req + , "\n" + , L.fromChunks bss + ] diff --git a/wai-handler-fastcgi/wai-handler-fastcgi.cabal b/wai-handler-fastcgi/wai-handler-fastcgi.cabal new file mode 100644 index 00000000..b2c7240d --- /dev/null +++ b/wai-handler-fastcgi/wai-handler-fastcgi.cabal @@ -0,0 +1,23 @@ +name: wai-handler-fastcgi +version: 0.4.0 +license: BSD3 +license-file: LICENSE +author: Michael Snoyman +maintainer: Michael Snoyman +synopsis: Wai handler to fastcgi +category: Web +stability: stable +cabal-version: >= 1.2 +build-type: Configure +extra-source-files: configure fastcgi.buildinfo.in +homepage: http://github.com/snoyberg/wai-handler-fastcgi + +library + build-depends: base >= 4 && < 5 + , wai >= 0.4 && < 0.5 + , wai-extra >= 0.4 && < 0.5 + , bytestring >= 0.9 && < 0.10 + exposed-modules: Network.Wai.Handler.FastCGI + ghc-options: -Wall + includes: fcgiapp.h + extra-libraries: fcgi