@@ -1,96 +0,0 @@
1−{-# LANGUAGE ForeignFunctionInterface #-}
2−module Network.Wai.Handler.SCGI
3− ( run
4− , runSendfile
5− ) where
6−
7−import Network.Wai
8−import Network.Wai.Handler.CGI (runGeneric, requestBodyFunc)
9−import Foreign.Ptr
10−import Foreign.Marshal.Alloc
11−import Foreign.C
12−import Data.ByteString (ByteString)
13−import qualified Data.ByteString as S
14−import qualified Data.ByteString.Unsafe as S
15−import qualified Data.ByteString.Char8 as S8
16−import Data.IORef
17−import Data.ByteString.Lazy.Internal (defaultChunkSize)
18−
19−run :: Application -> IO ()
20−run app = runOne Nothing app >> run app
21−
22−runSendfile :: ByteString -> Application -> IO ()
23−runSendfile sf app = runOne (Just sf) app >> runSendfile sf app
24−
25−runOne :: Maybe ByteString -> Application -> IO ()
26−runOne sf app = do
27− socket <- c'accept 0 nullPtr nullPtr
28− headersBS <- readNetstring socket
29− let headers@((_, conLenS):_) = parseHeaders $ S.split 0 headersBS
30− let conLen = case reads conLenS of
31− (i, _):_ -> i
32− [] -> 0
33− conLenI <- newIORef conLen
34− runGeneric headers (requestBodyFunc $ input socket conLenI)
35− (write socket) sf app
36− drain socket conLenI
37− _ <- c'close socket
38− return ()
39−
40−write :: CInt -> S.ByteString -> IO ()
41−write socket bs = S.unsafeUseAsCStringLen bs $ \(s, l) -> do
42− _ <- c'write socket s (fromIntegral l)
43− return ()
44−
45−input :: CInt -> IORef Int -> Int -> IO (Maybe S.ByteString)
46−input socket ilen rlen = do
47− len <- readIORef ilen
48− case len of
49− 0 -> return Nothing
50− _ -> do
51− bs <- readByteString socket
52− $ minimum [defaultChunkSize, len, rlen]
53− writeIORef ilen $ len - S.length bs
54− return $ Just bs
55−
56−drain :: CInt -> IORef Int -> IO () -- FIXME do it in chunks
57−drain socket ilen = do
58− len <- readIORef ilen
59− _ <- readByteString socket len
60− return ()
61−
62−parseHeaders :: [S.ByteString] -> [(String, String)]
63−parseHeaders (x:y:z) = (S8.unpack x, S8.unpack y) : parseHeaders z
64−parseHeaders _ = []
65−
66−readNetstring :: CInt -> IO S.ByteString
67−readNetstring socket = do
68− len <- readLen 0
69− bs <- readByteString socket len
70− _ <- readByteString socket 1 -- the comma
71− return bs
72− where
73− readLen l = do
74− bs <- readByteString socket 1
75− let [c] = S8.unpack bs
76− if c == ':'
77− then return l
78− else readLen $ l * 10 + (fromEnum c - fromEnum '0')
79−
80−readByteString :: CInt -> Int -> IO S.ByteString
81−readByteString socket len = do
82− buf <- mallocBytes len
83− _ <- c'read socket buf $ fromIntegral len
84− S.unsafePackCStringFinalizer (castPtr buf) len $ free buf
85−
86−foreign import ccall unsafe "accept"
87− c'accept :: CInt -> Ptr a -> Ptr a -> IO CInt
88−
89−foreign import ccall unsafe "close"
90− c'close :: CInt -> IO CInt
91−
92−foreign import ccall unsafe "write"
93− c'write :: CInt -> Ptr CChar -> CInt -> IO CInt
94−
95−foreign import ccall unsafe "read"
96− c'read :: CInt -> Ptr CChar -> CInt -> IO CInt