Add 'wai-handler-fastcgi/' from commit 'd8afaeaae54b5420a19f0213e71451516fe3e6f7'

git-subtree-dir: wai-handler-fastcgi
git-subtree-mainline: e1388d9821
git-subtree-split: d8afaeaae5

wai-handler-fastcgi/.gitignore

@@ -0,0 +1,4 @@
+/dist/
+*.swp
+*.hi
+*.o

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.

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 <http://fastcgi.com/>, 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 <fcgiapp.h>
+
+------------------------------------------------------------------------
+
+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)

wai-handler-fastcgi/Setup.lhs

@@ -0,0 +1,7 @@
+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain

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

wai-handler-fastcgi/fastcgi.buildinfo.in

@@ -0,0 +1,3 @@
+ghc-options: -optc@CPPFLAGS@
+cc-options:  @CPPFLAGS@
+ld-options:  @LDFLAGS@

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
+    ))
+)

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")] "<form method='post' action='/post'><input type='text' name='name'><input type='submit'></form>"
+app req = do
+    bss <- E.consume
+    return $ responseLBS status200 [("Content-Type", "text/plain")] $ L.concat
+        [ L8.pack $ show $ requestHeaders req
+        , "\n"
+        , L.fromChunks bss
+        ]

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 <michael@snoyman.com>
+maintainer:      Michael Snoyman <michael@snoyman.com>
+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