@@ -14,37 +14,20 @@
1414-- Totally ripped off by Michael Snoyman to work with Hack, then WAI.
1515--
1616-----------------------------------------------------------------------------
17−module Network.Wai.Handler.FastCGI
18− (
19− -- * Single-threaded interface
20− runFastCGIorCGI
21− , runOneFastCGIorCGI
22− , runFastCGI
23− , runOneFastCGI
24− -- * Concurrent interface
25− , runFastCGIConcurrent
26− , runFastCGIConcurrent'
27− ) where
17+module Network.Wai.Handler.FastCGI (run) where
2818
2919import Data.Maybe
30−import Data.ByteString.Lazy.Internal (defaultChunkSize)
31−import Control.Concurrent ( forkOS )
32−import Control.Concurrent.MVar
33−import Control.Concurrent.QSem
34−import Control.Exception as Exception (catch, finally)
3520import Control.Monad ( liftM )
3621import Data.Word (Word8)
3722import Foreign ( Ptr, castPtr, nullPtr, peekArray0
38− , alloca, mallocBytes, free, throwIfNeg_)
23+ , alloca, throwIfNeg_)
3924import Foreign.C ( CInt, CString, CStringLen
4025 , peekCString )
4126import Foreign.Storable ( Storable (..) )
42−import System.IO.Unsafe (unsafeInterleaveIO,unsafePerformIO)
27+import System.IO.Unsafe (unsafeInterleaveIO)
4328
4429import qualified Network.Wai as W
4530import qualified Network.Wai.Enumerator as WE
46−import qualified Network.Wai.Source as WS
47−import qualified Network.Wai.Handler.CGI as CGI
4831
4932import qualified Data.ByteString as BS
5033import qualified Data.ByteString.Char8 as B8
@@ -57,9 +40,7 @@ import qualified Data.ByteString.Base as BSB
5740#endif
5841
5942-- For debugging
60−import Control.Concurrent ( myThreadId )
6143import Prelude hiding ( log, catch )
62−import System.IO ( hPutStrLn, stderr )
6344import qualified System.IO
6445import Control.Arrow ((***))
6546import Data.Char (toLower)
@@ -74,46 +55,22 @@ type Environ = Ptr CString
7455
7556------------------------------------------------------------------------
7657
77−foreign import ccall unsafe "fcgiapp.h FCGX_IsCGI" fcgx_isCGI
78− :: IO CInt
79−
8058foreign import ccall unsafe "fcgiapp.h FCGX_GetStr" fcgx_getStr
8159 :: CString -> CInt -> StreamPtr -> IO CInt
8260
8361foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr
8462 :: CString -> CInt -> StreamPtr -> IO CInt
8563
86−foreign import ccall threadsafe "fcgiapp.h FCGX_Accept" fcgx_accept
64+foreign import ccall safe "fcgiapp.h FCGX_Accept" fcgx_accept
8765 :: Ptr StreamPtr -> Ptr StreamPtr -> Ptr StreamPtr -> Ptr Environ -> IO CInt
8866foreign import ccall unsafe "fcgiapp.h FCGX_Finish" fcgx_finish
8967 :: IO ()
9068
9169------------------------------------------------------------------------
9270
93−-- | Handle a single CGI request, or FastCGI requests in an infinite loop.
94−-- This function only returns normally if it was a CGI request.
95−-- This lets you use the same program
96−-- as either a FastCGI or CGI program, depending on what the server
97−-- treats it as.
98−runFastCGIorCGI :: W.Application -> IO ()
99−runFastCGIorCGI f = do fcgi <- runOneFastCGIorCGI f
100− if fcgi then runFastCGIorCGI f
101− else return ()
102−
103−-- | Handle a single FastCGI or CGI request. This lets you use the same program
104−-- as either a FastCGI or CGI program, depending on what the server
105−-- treats it as.
106−runOneFastCGIorCGI :: W.Application
107− -> IO Bool -- ^ True if it was a FastCGI request,
108− -- False if CGI.
109−runOneFastCGIorCGI f =
110− do x <- fcgx_isCGI
111− if x /= 0 then CGI.run f >> return False
112− else runOneFastCGI f >> return True
113−
11471-- | Handle FastCGI requests in an infinite loop.
115−runFastCGI :: W.Application -> IO ()
116−runFastCGI f = runOneFastCGI f >> runFastCGI f
72+run :: W.Application -> IO ()
73+run f = runOneFastCGI f >> run f
11774
11875-- | Handle a single FastCGI request.
11976runOneFastCGI :: W.Application -> IO ()
@@ -157,75 +114,9 @@ handleRequest f ins outs _errs env =
157114
158115data FCGX_Request
159116
160−foreign import ccall unsafe "fcgiapp.h FCGX_Init" fcgx_init
161− :: IO CInt
162−
163−foreign import ccall unsafe "fcgiapp.h FCGX_InitRequest" fcgx_initrequest
164− :: Ptr FCGX_Request -> CInt -> CInt -> IO CInt
165−
166−foreign import ccall threadsafe "fcgiapp.h FCGX_Accept_r" fcgx_accept_r
167− :: Ptr FCGX_Request -> IO CInt
168−
169−foreign import ccall unsafe "fcgiapp.h FCGX_Finish_r" fcgx_finish_r
170− :: Ptr FCGX_Request -> IO ()
171−
172−-- | Like 'Network.CGI.runCGI', but uses the FastCGI interface
173−-- and forks off a new thread (using 'forkOS') for every request.
174−runFastCGIConcurrent :: Int -- ^ Max number of concurrent threads.
175− -> W.Application -> IO ()
176−runFastCGIConcurrent = runFastCGIConcurrent' forkOS
177−
178−runFastCGIConcurrent' :: (IO () -> IO a) -- ^ How to fork a request.
179− -> Int -- ^ Max number of concurrent threads.
180− -> W.Application -> IO ()
181−
182−runFastCGIConcurrent' fork m f
183− = do qsem <- newQSem m
184− testReturn "FCGX_Init" $ fcgx_init
185− let loop = do waitQSem qsem
186− reqp <- acceptRequest
187− fork (oneRequestMT f reqp
188− `finally`
189− (finishRequest reqp >> signalQSem qsem))
190− loop
191− loop -- FIXME `catch` \e -> log (show e)
192−
193−oneRequestMT :: W.Application -> Ptr FCGX_Request -> IO ()
194−oneRequestMT app r = do
195− env <- peekEnvp r
196− vars <- environToTable env
197− ins <- peekIn r
198− input <- sRead ins
199− outs <- peekOut r
200− let hPut = sPutStr' outs
201− run' vars input hPut app
202−--
203−-- * FCGX_Reqest struct
204−--
205−
206−acceptRequest :: IO (Ptr FCGX_Request)
207−acceptRequest = do
208− reqp <- mallocBytes (#size FCGX_Request)
209− initAndAccept reqp
210− return reqp
211− where initAndAccept reqp = do
212− testReturn "FCGX_InitRequest" $ fcgx_initrequest reqp 0 0
213− testReturn "FCGX_Accept_r" $ fcgx_accept_r reqp
214−
215−finishRequest :: Ptr FCGX_Request -> IO ()
216−finishRequest reqp = do
217− fcgx_finish_r reqp
218− free reqp
219−
220−peekIn, peekOut, _peekErr :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)
221−peekIn = (#peek FCGX_Request, in)
222−peekOut = (#peek FCGX_Request, out)
117+_peekErr :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)
223118_peekErr = (#peek FCGX_Request, err)
224119
225−peekEnvp :: Ptr FCGX_Request -> IO Environ
226−peekEnvp = (#peek FCGX_Request, envp)
227−
228−
229120--
230121-- * Stream IO
231122--
@@ -234,10 +125,6 @@ sPutStr' :: StreamPtr -> BS.ByteString -> IO ()
234125sPutStr' h str =
235126 BSB.unsafeUseAsCStringLen str $ fcgxPutCStringLen h
236127
237−sPutStr :: StreamPtr -> Lazy.ByteString -> IO ()
238−sPutStr h str =
239− mapM_ (flip BSB.unsafeUseAsCStringLen (fcgxPutCStringLen h)) (Lazy.toChunks str)
240−
241128fcgxPutCStringLen :: StreamPtr -> CStringLen -> IO ()
242129fcgxPutCStringLen h (cs,len) =
243130 testReturn "FCGX_PutStr" $ fcgx_putStr cs (fromIntegral len) h
@@ -287,19 +174,6 @@ splitBy :: Eq a => a -> [a] -> ([a],[a])
287174splitBy x xs = (y, drop 1 z)
288175 where (y,z) = break (==x) xs
289176
290−--
291−-- * Debugging
292−--
293−
294−{-# NOINLINE logMutex #-}
295−logMutex :: MVar ()
296−logMutex = unsafePerformIO (newMVar ())
297−
298−log :: String -> IO ()
299−log msg = do
300− t <- myThreadId
301− withMVar logMutex (const $ hPutStrLn stderr (show t ++ ": " ++ msg))
302−
303177run' :: [(String, String)] -- ^ all variables
304178 -> Lazy.ByteString -- ^ responseBody of input
305179 -> (BS.ByteString -> IO ()) -- ^ destination for output
@@ -374,9 +248,10 @@ cleanupVarName "SCRIPT_NAME" = W.requestHeaderFromBS $ B8.pack "CGI-Script-Name"
374248cleanupVarName x = W.requestHeaderFromBS $ B8.pack x -- FIXME remove?
375249
376250requestBodyLBS :: Lazy.ByteString -> Int -> W.Source
377−requestBodyLBS l len = go (Lazy.toChunks l) len
251+requestBodyLBS = go . Lazy.toChunks
378252 where
379253 go _ 0 = W.Source $ return Nothing
254+ go [] _ = W.Source $ return Nothing
380255 go (l:ls) len =
381256 let len' = len - BS.length l
382257 len'' = if len' < 0 then 0 else len'