git.iko.soy/typeable/wai
on master help sign in
Minimal interface, no warnings
11bf4b7Michael Snoyman
Network/Wai/Handler/FastCGI.hsc+9−134
compare with master
unifiedsplit
@@ -14,37 +14,20 @@
14-- Totally ripped off by Michael Snoyman to work with Hack, then WAI.
14-- Totally ripped off by Michael Snoyman to work with Hack, then WAI.
15--
15--
16-----------------------------------------------------------------------------
16-----------------------------------------------------------------------------
17−module Network.Wai.Handler.FastCGI
17+module Network.Wai.Handler.FastCGI (run) where
18− (
19− -- * Single-threaded interface
20− runFastCGIorCGI
21− , runOneFastCGIorCGI
22− , runFastCGI
23− , runOneFastCGI
24− -- * Concurrent interface
25− , runFastCGIConcurrent
26− , runFastCGIConcurrent'
27− ) where
28
18
29import Data.Maybe
19import 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)
35import Control.Monad ( liftM )
20import Control.Monad ( liftM )
36import Data.Word (Word8)
21import Data.Word (Word8)
37import Foreign ( Ptr, castPtr, nullPtr, peekArray0
22import Foreign ( Ptr, castPtr, nullPtr, peekArray0
38− , alloca, mallocBytes, free, throwIfNeg_)
23+ , alloca, throwIfNeg_)
39import Foreign.C ( CInt, CString, CStringLen
24import Foreign.C ( CInt, CString, CStringLen
40 , peekCString )
25 , peekCString )
41import Foreign.Storable ( Storable (..) )
26import Foreign.Storable ( Storable (..) )
42−import System.IO.Unsafe (unsafeInterleaveIO,unsafePerformIO)
27+import System.IO.Unsafe (unsafeInterleaveIO)
43
28
44import qualified Network.Wai as W
29import qualified Network.Wai as W
45import qualified Network.Wai.Enumerator as WE
30import qualified Network.Wai.Enumerator as WE
46−import qualified Network.Wai.Source as WS
47−import qualified Network.Wai.Handler.CGI as CGI
48
31
49import qualified Data.ByteString as BS
32import qualified Data.ByteString as BS
50import qualified Data.ByteString.Char8 as B8
33import qualified Data.ByteString.Char8 as B8
@@ -57,9 +40,7 @@ import qualified Data.ByteString.Base as BSB
57#endif
40#endif
58
41
59-- For debugging
42-- For debugging
60−import Control.Concurrent ( myThreadId )
61import Prelude hiding ( log, catch )
43import Prelude hiding ( log, catch )
62−import System.IO ( hPutStrLn, stderr )
63import qualified System.IO
44import qualified System.IO
64import Control.Arrow ((***))
45import Control.Arrow ((***))
65import Data.Char (toLower)
46import Data.Char (toLower)
@@ -74,46 +55,22 @@ type Environ = Ptr CString
74
55
75------------------------------------------------------------------------
56------------------------------------------------------------------------
76
57
77−foreign import ccall unsafe "fcgiapp.h FCGX_IsCGI" fcgx_isCGI
78− :: IO CInt
79−
80foreign import ccall unsafe "fcgiapp.h FCGX_GetStr" fcgx_getStr
58foreign import ccall unsafe "fcgiapp.h FCGX_GetStr" fcgx_getStr
81 :: CString -> CInt -> StreamPtr -> IO CInt
59 :: CString -> CInt -> StreamPtr -> IO CInt
82
60
83foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr
61foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr
84 :: CString -> CInt -> StreamPtr -> IO CInt
62 :: CString -> CInt -> StreamPtr -> IO CInt
85
63
86−foreign import ccall threadsafe "fcgiapp.h FCGX_Accept" fcgx_accept
64+foreign import ccall safe "fcgiapp.h FCGX_Accept" fcgx_accept
87 :: Ptr StreamPtr -> Ptr StreamPtr -> Ptr StreamPtr -> Ptr Environ -> IO CInt
65 :: Ptr StreamPtr -> Ptr StreamPtr -> Ptr StreamPtr -> Ptr Environ -> IO CInt
88foreign import ccall unsafe "fcgiapp.h FCGX_Finish" fcgx_finish
66foreign import ccall unsafe "fcgiapp.h FCGX_Finish" fcgx_finish
89 :: IO ()
67 :: IO ()
90
68
91------------------------------------------------------------------------
69------------------------------------------------------------------------
92
70
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−
114-- | Handle FastCGI requests in an infinite loop.
71-- | Handle FastCGI requests in an infinite loop.
115−runFastCGI :: W.Application -> IO ()
72+run :: W.Application -> IO ()
116−runFastCGI f = runOneFastCGI f >> runFastCGI f
73+run f = runOneFastCGI f >> run f
117
74
118-- | Handle a single FastCGI request.
75-- | Handle a single FastCGI request.
119runOneFastCGI :: W.Application -> IO ()
76runOneFastCGI :: W.Application -> IO ()
@@ -157,75 +114,9 @@ handleRequest f ins outs _errs env =
157
114
158data FCGX_Request
115data FCGX_Request
159
116
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)
117+_peekErr :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)
221−peekIn = (#peek FCGX_Request, in)
222−peekOut = (#peek FCGX_Request, out)
223_peekErr = (#peek FCGX_Request, err)
118_peekErr = (#peek FCGX_Request, err)
224
119
225−peekEnvp :: Ptr FCGX_Request -> IO Environ
226−peekEnvp = (#peek FCGX_Request, envp)
227−
228−
229--
120--
230-- * Stream IO
121-- * Stream IO
231--
122--
@@ -234,10 +125,6 @@ sPutStr' :: StreamPtr -> BS.ByteString -> IO ()
234sPutStr' h str =
125sPutStr' h str =
235 BSB.unsafeUseAsCStringLen str $ fcgxPutCStringLen h
126 BSB.unsafeUseAsCStringLen str $ fcgxPutCStringLen h
236
127
237−sPutStr :: StreamPtr -> Lazy.ByteString -> IO ()
238−sPutStr h str =
239− mapM_ (flip BSB.unsafeUseAsCStringLen (fcgxPutCStringLen h)) (Lazy.toChunks str)
240−
241fcgxPutCStringLen :: StreamPtr -> CStringLen -> IO ()
128fcgxPutCStringLen :: StreamPtr -> CStringLen -> IO ()
242fcgxPutCStringLen h (cs,len) =
129fcgxPutCStringLen h (cs,len) =
243 testReturn "FCGX_PutStr" $ fcgx_putStr cs (fromIntegral len) h
130 testReturn "FCGX_PutStr" $ fcgx_putStr cs (fromIntegral len) h
@@ -287,19 +174,6 @@ splitBy :: Eq a => a -> [a] -> ([a],[a])
287splitBy x xs = (y, drop 1 z)
174splitBy x xs = (y, drop 1 z)
288 where (y,z) = break (==x) xs
175 where (y,z) = break (==x) xs
289
176
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−
303run' :: [(String, String)] -- ^ all variables
177run' :: [(String, String)] -- ^ all variables
304 -> Lazy.ByteString -- ^ responseBody of input
178 -> Lazy.ByteString -- ^ responseBody of input
305 -> (BS.ByteString -> IO ()) -- ^ destination for output
179 -> (BS.ByteString -> IO ()) -- ^ destination for output
@@ -374,9 +248,10 @@ cleanupVarName "SCRIPT_NAME" = W.requestHeaderFromBS $ B8.pack "CGI-Script-Name"
374cleanupVarName x = W.requestHeaderFromBS $ B8.pack x -- FIXME remove?
248cleanupVarName x = W.requestHeaderFromBS $ B8.pack x -- FIXME remove?
375
249
376requestBodyLBS :: Lazy.ByteString -> Int -> W.Source
250requestBodyLBS :: Lazy.ByteString -> Int -> W.Source
377−requestBodyLBS l len = go (Lazy.toChunks l) len
251+requestBodyLBS = go . Lazy.toChunks
378 where
252 where
379 go _ 0 = W.Source $ return Nothing
253 go _ 0 = W.Source $ return Nothing
254+ go [] _ = W.Source $ return Nothing
380 go (l:ls) len =
255 go (l:ls) len =
381 let len' = len - BS.length l
256 let len' = len - BS.length l
382 len'' = if len' < 0 then 0 else len'
257 len'' = if len' < 0 then 0 else len'