git.iko.soy/typeable/wai
on master help sign in
runFork
dbeaf9cMichael Snoyman
Network/Wai/Handler/FastCGI.hsc+60−49
compare with master
unifiedsplit
@@ -1,12 +1,11 @@
1{-# LANGUAGE ForeignFunctionInterface #-}
1{-# LANGUAGE ForeignFunctionInterface #-}
2{-# LANGUAGE EmptyDataDecls #-}
2{-# LANGUAGE EmptyDataDecls #-}
3−{-# LANGUAGE OverloadedStrings #-}
4-----------------------------------------------------------------------------
3-----------------------------------------------------------------------------
5-- |
4-- |
6-- Module : Network.Wai.Handler.FastCGI
5-- Module : Network.Wai.Handler.FastCGI
7−-- Copyright : (c) Bjorn Bringert 2004-2005, (c) Lemmih 2006
6+-- Copyright : (c) Bjorn Bringert 2004-2005, (c) Lemmih 2006, (c) Michael Snoyman 2010
8-- License : BSD-style (see the file libraries/network/LICENSE)
7-- License : BSD-style (see the file libraries/network/LICENSE)
9−--
8+--
10-- Maintainer : michael@snoyman.com
9-- Maintainer : michael@snoyman.com
11-- Stability : experimental
10-- Stability : experimental
12-- Portability : non-portable (uses FFI)
11-- Portability : non-portable (uses FFI)
@@ -18,15 +17,16 @@
18module Network.Wai.Handler.FastCGI
17module Network.Wai.Handler.FastCGI
19 ( run
18 ( run
20 , runSendfile
19 , runSendfile
20+ , runFork
21 ) where
21 ) where
22
22
23−import Data.Maybe
24−import Control.Monad ( liftM )
23+import Control.Monad ( liftM, forever )
25import Data.Word (Word8)
24import Data.Word (Word8)
26import Foreign ( Ptr, castPtr, nullPtr, peekArray0
25import Foreign ( Ptr, castPtr, nullPtr, peekArray0
27− , alloca, throwIfNeg_)
26+ , throwIfNeg_, mallocBytes, free )
28import Foreign.C ( CInt, CString, CStringLen
27import Foreign.C ( CInt, CString, CStringLen
29 , peekCString )
28 , peekCString )
29+import Control.Exception (finally)
30import Foreign.Storable ( Storable (..) )
30import Foreign.Storable ( Storable (..) )
31
31
32import qualified Network.Wai as W
32import qualified Network.Wai as W
@@ -34,15 +34,8 @@ import qualified Network.Wai.Handler.CGI as CGI
34import qualified Network.Wai.Handler.Helper as CGI
34import qualified Network.Wai.Handler.Helper as CGI
35
35
36import qualified Data.ByteString as BS
36import qualified Data.ByteString as BS
37−#if __GLASGOW_HASKELL__ >= 608
38import qualified Data.ByteString.Internal as BSB
37import qualified Data.ByteString.Internal as BSB
39import qualified Data.ByteString.Unsafe as BSB
38import qualified Data.ByteString.Unsafe as BSB
40−#else
41−import qualified Data.ByteString.Base as BSB
42−#endif
43−
44−-- For debugging
45−import Prelude hiding ( log, catch )
46
39
47#include <fcgiapp.h>
40#include <fcgiapp.h>
48
41
@@ -60,59 +53,80 @@ foreign import ccall unsafe "fcgiapp.h FCGX_GetStr" fcgx_getStr
60foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr
53foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr
61 :: CString -> CInt -> StreamPtr -> IO CInt
54 :: CString -> CInt -> StreamPtr -> IO CInt
62
55
63−foreign import ccall safe "fcgiapp.h FCGX_Accept" fcgx_accept
64− :: Ptr StreamPtr -> Ptr StreamPtr -> Ptr StreamPtr -> Ptr Environ -> IO CInt
65−foreign import ccall unsafe "fcgiapp.h FCGX_Finish" fcgx_finish
66− :: IO ()
67
56
68------------------------------------------------------------------------
57------------------------------------------------------------------------
69
58
59+foreign import ccall unsafe "fcgiapp.h FCGX_Init" fcgx_init
60+ :: IO CInt
61+
62+runFork :: Maybe String -> (IO () -> IO a) -> Int -> W.Application -> IO ()
63+runFork sf fork threads app = do
64+ testReturn "FCGX_Init" $ fcgx_init
65+ let oneThread = forever $ oneRequest app sf
66+ mapM_ fork $ replicate (threads - 1) oneThread
67+ oneThread
68+
70-- | Handle FastCGI requests in an infinite loop.
69-- | Handle FastCGI requests in an infinite loop.
71run :: W.Application -> IO ()
70run :: W.Application -> IO ()
72−run f = runOneFastCGI Nothing f >> run f
71+run = runFork Nothing id 1
73
72
74-- | Handle FastCGI requests in an infinite loop. For a server which supports
73-- | Handle FastCGI requests in an infinite loop. For a server which supports
75-- the X-Sendfile header.
74-- the X-Sendfile header.
76runSendfile :: String -> W.Application -> IO ()
75runSendfile :: String -> W.Application -> IO ()
77−runSendfile sf f = runOneFastCGI (Just sf) f >> runSendfile sf f
76+runSendfile sf = runFork (Just sf) id 1
78−
79−-- | Handle a single FastCGI request.
80−runOneFastCGI :: Maybe String -- X-Sendfile
81− -> W.Application -> IO ()
82−runOneFastCGI xsendfile f = do
83− alloca (\inp ->
84− alloca (\outp ->
85− alloca (\errp ->
86− alloca (\envp ->
87− oneRequest f inp outp errp envp
88− xsendfile))))
89
77
90oneRequest :: W.Application
78oneRequest :: W.Application
91− -> Ptr StreamPtr
92− -> Ptr StreamPtr
93− -> Ptr StreamPtr
94− -> Ptr Environ
95 -> Maybe String -- X-Sendfile
79 -> Maybe String -- X-Sendfile
96 -> IO ()
80 -> IO ()
97−oneRequest f inp outp errp envp xsendfile =
81+oneRequest app xsendfile = withRequest $ \r -> do
98− do
82+ putStrLn "Received 1 request"
99− testReturn "FCGX_Accept" $ fcgx_accept inp outp errp envp
83+ env <- peekEnvp r
100− ins <- peek inp
84+ ins <- peekIn r
101− outs <- peek outp
85+ outs <- peekOut r
102− errs <- peek errp
103− env <- peek envp
104− handleRequest f ins outs errs env xsendfile
86+ handleRequest app ins outs env xsendfile
105− fcgx_finish
87+
88+peekIn, peekOut :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)
89+peekIn = (#peek FCGX_Request, in)
90+peekOut = (#peek FCGX_Request, out)
91+
92+peekEnvp :: Ptr FCGX_Request -> IO Environ
93+peekEnvp = (#peek FCGX_Request, envp)
94+
95+foreign import ccall unsafe "fcgiapp.h FCGX_InitRequest" fcgx_initrequest
96+ :: Ptr FCGX_Request -> CInt -> CInt -> IO CInt
97+
98+foreign import ccall safe "fcgiapp.h FCGX_Accept_r" fcgx_accept_r
99+ :: Ptr FCGX_Request -> IO CInt
100+
101+acceptRequest :: IO (Ptr FCGX_Request)
102+acceptRequest = do
103+ reqp <- mallocBytes (#size FCGX_Request)
104+ initAndAccept reqp
105+ return reqp
106+ where initAndAccept reqp = do
107+ testReturn "FCGX_InitRequest" $ fcgx_initrequest reqp 0 0
108+ testReturn "FCGX_Accept_r" $ fcgx_accept_r reqp
109+
110+withRequest :: (Ptr FCGX_Request -> IO ()) -> IO ()
111+withRequest f = do
112+ req <- acceptRequest
113+ f req `finally` finishRequest req
114+
115+foreign import ccall unsafe "fcgiapp.h FCGX_Finish_r" fcgx_finish_r
116+ :: Ptr FCGX_Request -> IO ()
117+
118+finishRequest :: Ptr FCGX_Request -> IO ()
119+finishRequest reqp = do
120+ fcgx_finish_r reqp
121+ free reqp
106
122
107handleRequest :: W.Application
123handleRequest :: W.Application
108− -> StreamPtr
109 -> StreamPtr
124 -> StreamPtr
110 -> StreamPtr
125 -> StreamPtr
111 -> Environ
126 -> Environ
112 -> Maybe String -- sendfile
127 -> Maybe String -- sendfile
113 -> IO ()
128 -> IO ()
114−handleRequest f ins outs _errs env xsendfile =
129+handleRequest f ins outs env xsendfile = do
115− do
116 vars <- environToTable env
130 vars <- environToTable env
117 let input = const $ sRead ins
131 let input = const $ sRead ins
118 let hPut = sPutStr' outs
132 let hPut = sPutStr' outs
@@ -120,9 +134,6 @@ handleRequest f ins outs _errs env xsendfile =
120
134
121data FCGX_Request
135data FCGX_Request
122
136
123−_peekErr :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)
124−_peekErr = (#peek FCGX_Request, err)
125−
126--
137--
127-- * Stream IO
138-- * Stream IO
128--
139--
wai-handler-fastcgi.cabal+1−1
@@ -1,5 +1,5 @@
1name: wai-handler-fastcgi
1name: wai-handler-fastcgi
2−version: 0.2.1
2+version: 0.2.2
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5author: Michael Snoyman <michael@snoyman.com>
5author: Michael Snoyman <michael@snoyman.com>