@@ -24,19 +24,21 @@ import Control.Monad ( liftM, forever )
2424import Data.Word (Word8)
2525import Foreign ( Ptr, castPtr, nullPtr, peekArray0
2626 , throwIfNeg_, mallocBytes, free )
27−import Foreign.C ( CInt, CString, CStringLen
28− , peekCString )
27+import Foreign.C (CInt, CString, CStringLen)
2928import Control.Exception (finally)
3029import Foreign.Storable ( Storable (..) )
3130
3231import qualified Network.Wai as W
3332import qualified Network.Wai.Handler.CGI as CGI
34−import qualified Network.Wai.Handler.Helper as CGI
3533
34+import qualified Data.ByteString as S
35+import qualified Data.ByteString.Char8 as S8
3636import qualified Data.ByteString as BS
3737import qualified Data.ByteString.Internal as BSB
3838import qualified Data.ByteString.Unsafe as BSB
3939
40+import Control.Arrow ((***))
41+
4042#include <fcgiapp.h>
4143
4244------------------------------------------------------------------------
@@ -59,7 +61,7 @@ foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr
5961foreign import ccall unsafe "fcgiapp.h FCGX_Init" fcgx_init
6062 :: IO CInt
6163
62−runFork :: Maybe String -> (IO () -> IO a) -> Int -> W.Application -> IO ()
64+runFork :: Maybe S.ByteString -> (IO () -> IO a) -> Int -> W.Application -> IO ()
6365runFork sf fork threads app = do
6466 testReturn "FCGX_Init" $ fcgx_init
6567 let oneThread = forever $ oneRequest app sf
@@ -72,11 +74,11 @@ run = runFork Nothing id 1
7274
7375-- | Handle FastCGI requests in an infinite loop. For a server which supports
7476-- the X-Sendfile header.
75−runSendfile :: String -> W.Application -> IO ()
77+runSendfile :: S.ByteString -> W.Application -> IO ()
7678runSendfile sf = runFork (Just sf) id 1
7779
7880oneRequest :: W.Application
79− -> Maybe String -- X-Sendfile
81+ -> Maybe S.ByteString -- X-Sendfile
8082 -> IO ()
8183oneRequest app xsendfile = withRequest $ \r -> do
8284 putStrLn "Received 1 request"
@@ -124,13 +126,14 @@ handleRequest :: W.Application
124126 -> StreamPtr
125127 -> StreamPtr
126128 -> Environ
127− -> Maybe String -- sendfile
129+ -> Maybe S.ByteString -- sendfile
128130 -> IO ()
129131handleRequest f ins outs env xsendfile = do
130132 vars <- environToTable env
133+ let vars' = map (S8.unpack *** S8.unpack) vars
131134 let input = const $ sRead ins
132135 let hPut = sPutStr' outs
133− CGI.run'' vars (CGI.requestBodyFunc input) hPut xsendfile f
136+ CGI.run'' vars' (CGI.requestBodyFunc input) hPut xsendfile f
134137
135138data FCGX_Request
136139
@@ -173,16 +176,12 @@ buildByteString f k = do
173176testReturn :: String -> IO CInt -> IO ()
174177testReturn e = throwIfNeg_ (\n -> e ++ " failed with error code: "++ show n)
175178
176−environToTable :: Environ -> IO [(String,String)]
177−environToTable arr =
178− do css <- peekArray0 nullPtr arr
179− ss <- mapM peekCString css
180− return $ map (splitBy '=') ss
181−
182−-- | Split a list at the first occurence of a marker.
183−-- Do not include the marker in any of the resulting lists.
184−-- If the marker does not occur in the list, the entire
185−-- input with be in the first list.
186−splitBy :: Eq a => a -> [a] -> ([a],[a])
187−splitBy x xs = (y, drop 1 z)
188− where (y,z) = break (==x) xs
179+environToTable :: Environ -> IO [(S.ByteString, S.ByteString)]
180+environToTable arr = do
181+ css <- peekArray0 nullPtr arr
182+ ss <- mapM S.packCString css
183+ return $ map splitEq ss
184+ where
185+ splitEq s =
186+ let (a, b) = S.breakByte 61 s
187+ in (a, S.drop 1 b)