wai-extra 2.1.0.1 → 2.1.1

raw patch · 2 files changed

+98/−1 lines, 2 files

Files

• Network/Wai/Handler/SCGI.hs +96/−0
• wai-extra.cabal +2/−1

@@ -0,0 +1,96 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Network.Wai.Handler.SCGI+    ( run+    , runSendfile+    ) where++import Network.Wai+import Network.Wai.Handler.CGI (runGeneric, requestBodyFunc)+import Foreign.Ptr+import Foreign.Marshal.Alloc+import Foreign.C+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import qualified Data.ByteString.Unsafe as S+import qualified Data.ByteString.Char8 as S8+import Data.IORef+import Data.ByteString.Lazy.Internal (defaultChunkSize)++run :: Application -> IO ()+run app = runOne Nothing app >> run app++runSendfile :: ByteString -> Application -> IO ()+runSendfile sf app = runOne (Just sf) app >> runSendfile sf app++runOne :: Maybe ByteString -> Application -> IO ()+runOne sf app = do+    socket <- c'accept 0 nullPtr nullPtr+    headersBS <- readNetstring socket+    let headers@((_, conLenS):_) = parseHeaders $ S.split 0 headersBS+    let conLen = case reads conLenS of+                    (i, _):_ -> i+                    [] -> 0+    conLenI <- newIORef conLen+    runGeneric headers (requestBodyFunc $ input socket conLenI)+              (write socket) sf app+    drain socket conLenI+    _ <- c'close socket+    return ()++write :: CInt -> S.ByteString -> IO ()+write socket bs = S.unsafeUseAsCStringLen bs $ \(s, l) -> do+    _ <- c'write socket s (fromIntegral l)+    return ()++input :: CInt -> IORef Int -> Int -> IO (Maybe S.ByteString)+input socket ilen rlen = do+    len <- readIORef ilen+    case len of+        0 -> return Nothing+        _ -> do+            bs <- readByteString socket+                $ minimum [defaultChunkSize, len, rlen]+            writeIORef ilen $ len - S.length bs+            return $ Just bs++drain :: CInt -> IORef Int -> IO () -- FIXME do it in chunks+drain socket ilen = do+    len <- readIORef ilen+    _ <- readByteString socket len+    return ()++parseHeaders :: [S.ByteString] -> [(String, String)]+parseHeaders (x:y:z) = (S8.unpack x, S8.unpack y) : parseHeaders z+parseHeaders _ = []++readNetstring :: CInt -> IO S.ByteString+readNetstring socket = do+    len <- readLen 0+    bs <- readByteString socket len+    _ <- readByteString socket 1 -- the comma+    return bs+  where+    readLen l = do+        bs <- readByteString socket 1+        let [c] = S8.unpack bs+        if c == ':'+            then return l+            else readLen $ l * 10 + (fromEnum c - fromEnum '0')++readByteString :: CInt -> Int -> IO S.ByteString+readByteString socket len = do+    buf <- mallocBytes len+    _ <- c'read socket buf $ fromIntegral len+    S.unsafePackCStringFinalizer (castPtr buf) len $ free buf++foreign import ccall unsafe "accept"+    c'accept :: CInt -> Ptr a -> Ptr a -> IO CInt++foreign import ccall unsafe "close"+    c'close :: CInt -> IO CInt++foreign import ccall unsafe "write"+    c'write :: CInt -> Ptr CChar -> CInt -> IO CInt++foreign import ccall unsafe "read"+    c'read :: CInt -> Ptr CChar -> CInt -> IO CInt

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             2.1.0.1+Version:             2.1.1 Synopsis:            Provides some basic WAI handlers and middleware. Description:         The goal here is to provide common features without many dependencies. License:             MIT@@ -53,6 +53,7 @@       build-depends: unix    Exposed-modules:   Network.Wai.Handler.CGI+                     Network.Wai.Handler.SCGI                      Network.Wai.Middleware.AcceptOverride                      Network.Wai.Middleware.Autohead                      Network.Wai.Middleware.CleanPath