git.iko.soy/typeable/wai
on master help sign in
Initial working version
4c3d8d7Michael Snoyman
LICENSEnew file+25
compare with master
unifiedsplit
@@ -0,0 +1,25 @@
1+The following license covers this documentation, and the source code, except
2+where otherwise indicated.
3+
4+Copyright 2009, Michael Snoyman. All rights reserved.
5+
6+Redistribution and use in source and binary forms, with or without
7+modification, are permitted provided that the following conditions are met:
8+
9+* Redistributions of source code must retain the above copyright notice, this
10+ list of conditions and the following disclaimer.
11+
12+* Redistributions in binary form must reproduce the above copyright notice,
13+ this list of conditions and the following disclaimer in the documentation
14+ and/or other materials provided with the distribution.
15+
16+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR
17+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
18+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
19+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,
20+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
21+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
22+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
23+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
24+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
25+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Network/Wai/Handler/FastCGI.hsnew file+100
@@ -0,0 +1,100 @@
1+module Network.Wai.Handler.FastCGI
2+ ( run
3+ ) where
4+
5+import qualified Network.Wai as W
6+import Network.FastCGI
7+import Control.Concurrent (forkIO)
8+import Control.Monad.Trans
9+import Control.Monad.Reader
10+import qualified Data.ByteString.Char8 as B
11+import qualified System.IO
12+import Control.Arrow ((***))
13+import Data.Char (toLower)
14+import Data.Maybe (fromMaybe)
15+import Data.ByteString.Lazy.Internal (defaultChunkSize)
16+import Network.Wai.Enumerator (fromEitherFile)
17+
18+run :: W.Application -> IO ()
19+run = acceptLoop forkIO . conv
20+
21+safeRead :: Read a => a -> String -> a
22+safeRead d s =
23+ case reads s of
24+ ((x, _):_) -> x
25+ [] -> d
26+
27+lookup' :: String -> [(String, String)] -> String
28+lookup' key pairs = fromMaybe "" $ lookup key pairs
29+
30+conv :: W.Application -> FastCGI ()
31+conv app = do
32+ vars <- getAllRequestVariables
33+ let rmethod = W.methodFromBS $ B.pack $ lookup' "REQUEST_METHOD" vars
34+ pinfo = lookup' "PATH_INFO" vars
35+ qstring = lookup' "QUERY_STRING" vars
36+ servername = lookup' "SERVER_NAME" vars
37+ serverport = safeRead 80 $ lookup' "SERVER_PORT" vars
38+ contentLength = safeRead 0 $ lookup' "CONTENT_LENGTH" vars
39+ remoteHost' =
40+ case lookup "REMOTE_HOST" vars of
41+ Just x -> x
42+ Nothing ->
43+ case lookup "REMOTE_ADDR" vars of
44+ Just x -> x
45+ Nothing -> ""
46+ urlScheme' =
47+ case map toLower $ lookup' "SERVER_PROTOCOL" vars of -- FIXME get httpVersion too
48+ "https" -> W.HTTPS
49+ _ -> W.HTTP
50+ state <- ask
51+ let env = W.Request
52+ { W.requestMethod = rmethod
53+ , W.pathInfo = B.pack pinfo
54+ , W.queryString = B.pack qstring
55+ , W.serverName = B.pack servername
56+ , W.serverPort = serverport
57+ , W.requestHeaders = map (cleanupVarName *** B.pack) vars
58+ , W.urlScheme = urlScheme'
59+ , W.requestBody = requestBody state contentLength
60+ , W.errorHandler = System.IO.hPutStr System.IO.stderr
61+ , W.remoteHost = B.pack remoteHost'
62+ , W.httpVersion = W.HttpVersion B.empty
63+ }
64+ res <- liftIO $ app env
65+ setResponseStatus $ W.statusCode $ W.status res
66+ mapM_ setHeader $ W.responseHeaders res
67+ _ <- liftIO $ W.runEnumerator
68+ (fromEitherFile (W.responseBody res))
69+ (myPut state)
70+ ()
71+ return ()
72+
73+cleanupVarName :: String -> W.RequestHeader
74+cleanupVarName ('H':'T':'T':'P':'_':a:as) =
75+ W.requestHeaderFromBS $ B.pack $ a : helper' as where
76+ helper' ('_':x:rest) = '-' : x : helper' rest
77+ helper' (x:rest) = toLower x : helper' rest
78+ helper' [] = []
79+cleanupVarName "CONTENT_TYPE" = W.ReqContentType
80+cleanupVarName "CONTENT_LENGTH" = W.ReqContentLength
81+cleanupVarName "SCRIPT_NAME" = W.requestHeaderFromBS $ B.pack "CGI-Script-Name"
82+cleanupVarName x = W.requestHeaderFromBS $ B.pack x -- FIXME remove?
83+
84+requestBody :: FastCGIState -> Int -> W.Source
85+requestBody _ 0 = W.Source $ return Nothing
86+requestBody state len = W.Source $ do
87+ bs <- runReaderT (fGet defaultChunkSize) state
88+ let newLen = len - B.length bs
89+ return $ Just (bs, requestBody state newLen)
90+
91+setHeader :: MonadFastCGI m => (W.ResponseHeader, B.ByteString) -> m ()
92+setHeader (k, v) =
93+ setResponseHeader
94+ (HttpExtensionHeader $ B.unpack $ W.responseHeaderToBS k)
95+ (B.unpack v)
96+
97+myPut :: FastCGIState -> () -> B.ByteString -> IO (Either () ())
98+myPut state _ bs = do
99+ runReaderT (fPut bs) state
100+ return $ Right ()
test.hsnew file+8
@@ -0,0 +1,8 @@
1+{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
2+import Yesod
3+import Network.Wai.Handler.FastCGI
4+data HelloWorld = HelloWorld
5+mkYesod "HelloWorld" [$parseRoutes|/ Home GET|]
6+instance Yesod HelloWorld where approot _ = ""
7+getHome = return $ RepPlain $ cs "Hello World!"
8+main = toWaiApp HelloWorld >>= run
wai-handler-fastcgi.cabalnew file+25
@@ -0,0 +1,25 @@
1+name: wai-handler-fastcgi
2+version: 0.0.0
3+license: BSD3
4+license-file: LICENSE
5+author: Michael Snoyman <michael@snoyman.com>
6+maintainer: Michael Snoyman <michael@snoyman.com>
7+synopsis: WAI wrapper around direct-fastcgi
8+category: Web
9+stability: Stable
10+cabal-version: >= 1.6
11+build-type: Simple
12+homepage: http://github.com/snoyberg/wai-handler-fastcgi
13+
14+library
15+ build-depends: base >= 4 && < 5,
16+ wai >= 0.0.1 && < 0.1,
17+ bytestring >= 0.9.1.4 && < 0.10,
18+ mtl >= 1.1.0.2 && < 1.2,
19+ direct-fastcgi >= 1.0.1.1 && < 1.1
20+ exposed-modules: Network.Wai.Handler.FastCGI
21+ ghc-options: -Wall
22+
23+source-repository head
24+ type: git
25+ location: git://github.com/snoyberg/wai-handler-fastcgi.git