@@ -0,0 +1,96 @@
1+{-# LANGUAGE ForeignFunctionInterface #-}
2+module Network.Wai.Handler.SCGI
8+import Network.Wai.Handler.CGI (runGeneric, requestBodyFunc)
10+import Foreign.Marshal.Alloc
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
17+import Data.ByteString.Lazy.Internal (defaultChunkSize)
19+run :: Application -> IO ()
20+run app = runOne Nothing app >> run app
22+runSendfile :: ByteString -> Application -> IO ()
23+runSendfile sf app = runOne (Just sf) app >> runSendfile sf app
25+runOne :: Maybe ByteString -> Application -> IO ()
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
33+ conLenI <- newIORef conLen
34+ runGeneric headers (requestBodyFunc $ input socket conLenI)
35+ (write socket) sf app
40+write :: CInt -> S.ByteString -> IO ()
41+write socket bs = S.unsafeUseAsCStringLen bs $ \(s, l) -> do
42+ _ <- c'write socket s (fromIntegral l)
45+input :: CInt -> IORef Int -> Int -> IO (Maybe S.ByteString)
46+input socket ilen rlen = do
47+ len <- readIORef ilen
51+ bs <- readByteString socket
52+ $ minimum [defaultChunkSize, len, rlen]
53+ writeIORef ilen $ len - S.length bs
56+drain :: CInt -> IORef Int -> IO () -- FIXME do it in chunks
57+drain socket ilen = do
58+ len <- readIORef ilen
59+ _ <- readByteString socket len
62+parseHeaders :: [S.ByteString] -> [(String, String)]
63+parseHeaders (x:y:z) = (S8.unpack x, S8.unpack y) : parseHeaders z
66+readNetstring :: CInt -> IO S.ByteString
67+readNetstring socket = do
69+ bs <- readByteString socket len
70+ _ <- readByteString socket 1 -- the comma
74+ bs <- readByteString socket 1
75+ let [c] = S8.unpack bs
78+ else readLen $ l * 10 + (fromEnum c - fromEnum '0')
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
86+foreign import ccall unsafe "accept"
87+ c'accept :: CInt -> Ptr a -> Ptr a -> IO CInt
89+foreign import ccall unsafe "close"
90+ c'close :: CInt -> IO CInt
92+foreign import ccall unsafe "write"
93+ c'write :: CInt -> Ptr CChar -> CInt -> IO CInt
95+foreign import ccall unsafe "read"
96+ c'read :: CInt -> Ptr CChar -> CInt -> IO CInt