hack2-handler-mongrel2-http 2011.6.24 → 2011.6.25
raw patch · 7 files changed
+156/−127 lines, 7 filesdep −case-insensitive
Dependencies removed: case-insensitive
Files
- Nemesis +3/−13
- hack2-handler-mongrel2-http.cabal +3/−4
- readme.md +37/−5
- src/Hack2/Handler/Mongrel2/IO.hs +1/−1
- src/Hack2/Handler/Mongrel2/MessageParser.hs +93/−0
- src/Hack2/Handler/Mongrel2/ResponseParser.hs +0/−93
- src/Hack2/Handler/Mongrel2HTTP.hs +19/−11
Nemesis view
@@ -3,10 +3,8 @@ clean [ "**/*.hi" , "**/*.o"- , "manifest" , "main" , "nemesis-tmp.*"- , "Test" ] @@ -16,18 +14,11 @@ sh "cabal configure" sh "cabal sdist" -- desc "put all .hs files in manifest"- task "manifest" - do- sh "find . | grep 'hs-' > manifest"-- desc "start console" task "i" (sh "ghci -isrc test/hello.hs") desc "run main" task "run" (sh "runghc -isrc test/hello.hs")- desc "test hello" task "hello" - do@@ -38,10 +29,6 @@ sh "runghc -isrc test/ab.hs" - desc "show sloc"- task "stat" - do- sh "cloc -match-f=hs- --quiet src"- desc "load mongrel config from config/test.conf" task "load" - do sh "m2sh load -config config/test.conf"@@ -52,6 +39,9 @@ desc "start mongrel2 server" task "start" - do+ sh "mkdir -p run"+ sh "mkdir -p logs"+ sh "mkdir -p tmp" sh "m2sh start -name test"
hack2-handler-mongrel2-http.cabal view
@@ -1,5 +1,5 @@ Name: hack2-handler-mongrel2-http-Version: 2011.6.24+Version: 2011.6.25 Build-type: Simple Synopsis: Hack2 Mongrel2 HTTP handler Description: Hack2 Mongrel2 HTTP handler@@ -24,8 +24,6 @@ , containers , mtl , enumerator < 5- , blaze-builder < 0.4- , case-insensitive < 0.3 , air , zeromq-haskell , directory@@ -33,6 +31,7 @@ , text , aeson , blaze-textual+ , blaze-builder < 0.4 , unix , attoparsec , stm@@ -41,7 +40,7 @@ Hack2.Handler.Mongrel2HTTP other-modules: Hack2.Handler.Mongrel2.IO- Hack2.Handler.Mongrel2.ResponseParser+ Hack2.Handler.Mongrel2.MessageParser Hack2.Handler.Mongrel2.Response Hack2.Handler.Mongrel2.Types
readme.md view
@@ -3,9 +3,41 @@ * enumerator enabled, constant memory consumption when enumerator all the way down -Known Issues----------- -* Server run loop is naive ><-* default start 10 instances, might not be the best way to run Hack2 apps-* Very early stage in development+How to run+-----------++* install mongrel2+* install GHC+* install cabal\-install++<br />++ cabal update+ cabal install nemesis+ cabal install hack2-handler-mongrel2-http+ cabal install hack2-contrib+ + git clone https://github.com/nfjinjing/hack2-handler-mongrel2-http.git+ + cd hack2-handler-mongrel2-http+ + # load a mongrel config, for more information, see the Nemesis task file+ nemesis load++ # start a mongrel server, port is 6767+ nemesis start+ + # start a hello world hack2 app using mongrel2 handler+ nemesis run+ ++now visit: <http://localhost:6767>, you should see a hello world page.++Useful getting started resource+-------------------------------++* Read the manual on <http://mongrel2.org>+* [config/test.conf](https://github.com/nfjinjing/hack2-handler-mongrel2-http/blob/master/config/test.conf) sample config, and [test/hello.hs](https://github.com/nfjinjing/hack2-handler-mongrel2-http/blob/master/test/hello.hs) hello world application.+* [The Hack2 spec](https://github.com/nfjinjing/hack2)+
src/Hack2/Handler/Mongrel2/IO.hs view
@@ -10,7 +10,7 @@ import Blaze.ByteString.Builder (Builder,fromByteString) import Data.Attoparsec-import Hack2.Handler.Mongrel2.ResponseParser (messageParser)+import Hack2.Handler.Mongrel2.MessageParser (messageParser) import Hack2.Handler.Mongrel2.Response import Hack2.Handler.Mongrel2.Types import qualified System.ZMQ as ZMQ
+ src/Hack2/Handler/Mongrel2/MessageParser.hs view
@@ -0,0 +1,93 @@+module Hack2.Handler.Mongrel2.MessageParser+ ( + messageParser+ ) where++import Data.Aeson (Value(..), json)+import Data.Attoparsec+import Data.Attoparsec.Char8 (decimal)+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Data.Word (Word8)+import Prelude hiding (take)+import qualified Data.Map as M+import Hack2.Handler.Mongrel2.Types++++-- Predicates for parsing.+isSpace :: Word8 -> Bool+isSpace 0x20 = True+isSpace _ = False++isColon :: Word8 -> Bool+isColon 0x3a = True+isColon _ = False++isComma :: Word8 -> Bool+isComma 0x2c = True+isComma _ = False++-- Skip spaces.+skipSpace :: Parser ()+skipSpace = skipWhile isSpace++-- Parse a UUID.+uuidParser :: Parser ByteString+uuidParser = takeWhile1 $ \w -> ((w >= 65) && (w <= 90 )) -- A-Z+ || ((w >= 97) && (w <= 122)) -- a-z+ || ((w >= 48) && (w <= 57 )) -- 0-9+ || (w == 45) -- Dash+ -- || (w == 95) -- _+ + ++netstringParser :: (Int -> Parser a) -> Parser a+netstringParser contentParser = do+ len <- decimal+ skip isColon+ str <- contentParser len+ return str++-- mongrel_send 2 / 238:{"PATH":"/","x-forwarded-for":"127.0.0.1","accept":"*/*","user-agent":"curl/7.19.7 (universal-apple-darwin10.0) libcurl/7.19.7 OpenSSL/0.9.8l zlib/1.2.3",+-- "host":"127.0.0.1:6767","METHOD":"GET","VERSION":"HTTP/1.1","URI":"/","PA+-- TTERN":"/"},0:,++-- def parse(msg):+-- sender, conn_id, path, rest = msg.split(' ', 3)+-- headers, rest = tnetstrings.parse(rest)+-- body, _ = tnetstrings.parse(rest)+-- +-- if type(headers) is str:+-- headers = json.loads(headers)+-- +-- return Request(sender, conn_id, path, headers, body)+ +messageParser :: Parser Request+messageParser = do+ uuid <- uuidParser+ skipSpace+ clientId <- decimal+ skipSpace+ path <- takeTill isSpace+ skipSpace+ reqHdr <- netstringParser $ \_ -> json+ skip isComma+ reqBody <- netstringParser take+ + return $ Request + {+ requestUuid = uuid+ , requestClientId = clientId+ , requestPath = path+ , requestHeaders = reqHdr+ , requestBody = reqBody+ }++-- extractQuery :: Value -> ([Text], Query)+-- extractQuery (Object hdrs) =+-- case M.lookup "URI" hdrs of+-- Just (String uriText) -> decodePath $ encodeUtf8 uriText+-- _ -> fail "Missing/invalid 'URI' in headers received from Mongrel2"+-- extractQuery _ = fail "Invalid headers received from Mongrel2"
− src/Hack2/Handler/Mongrel2/ResponseParser.hs
@@ -1,93 +0,0 @@-module Hack2.Handler.Mongrel2.ResponseParser- ( - messageParser- ) where--import Data.Aeson (Value(..), json)-import Data.Attoparsec-import Data.Attoparsec.Char8 (decimal)-import Data.ByteString (ByteString)-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8)-import Data.Word (Word8)-import Prelude hiding (take)-import qualified Data.Map as M-import Hack2.Handler.Mongrel2.Types------ Predicates for parsing.-isSpace :: Word8 -> Bool-isSpace 0x20 = True-isSpace _ = False--isColon :: Word8 -> Bool-isColon 0x3a = True-isColon _ = False--isComma :: Word8 -> Bool-isComma 0x2c = True-isComma _ = False---- Skip spaces.-skipSpace :: Parser ()-skipSpace = skipWhile isSpace---- Parse a UUID.-uuidParser :: Parser ByteString-uuidParser = takeWhile1 $ \w -> ((w >= 65) && (w <= 90 )) -- A-Z- || ((w >= 97) && (w <= 122)) -- a-z- || ((w >= 48) && (w <= 57 )) -- 0-9- || (w == 45) -- Dash- -- || (w == 95) -- _- - --netstringParser :: (Int -> Parser a) -> Parser a-netstringParser contentParser = do- len <- decimal- skip isColon- str <- contentParser len- return str---- mongrel_send 2 / 238:{"PATH":"/","x-forwarded-for":"127.0.0.1","accept":"*/*","user-agent":"curl/7.19.7 (universal-apple-darwin10.0) libcurl/7.19.7 OpenSSL/0.9.8l zlib/1.2.3",--- "host":"127.0.0.1:6767","METHOD":"GET","VERSION":"HTTP/1.1","URI":"/","PA--- TTERN":"/"},0:,---- def parse(msg):--- sender, conn_id, path, rest = msg.split(' ', 3)--- headers, rest = tnetstrings.parse(rest)--- body, _ = tnetstrings.parse(rest)--- --- if type(headers) is str:--- headers = json.loads(headers)--- --- return Request(sender, conn_id, path, headers, body)- -messageParser :: Parser Request-messageParser = do- uuid <- uuidParser- skipSpace- clientId <- decimal- skipSpace- path <- takeTill isSpace- skipSpace- reqHdr <- netstringParser $ \_ -> json- skip isComma- reqBody <- netstringParser take- - return $ Request - {- requestUuid = uuid- , requestClientId = clientId- , requestPath = path- , requestHeaders = reqHdr- , requestBody = reqBody- }---- extractQuery :: Value -> ([Text], Query)--- extractQuery (Object hdrs) =--- case M.lookup "URI" hdrs of--- Just (String uriText) -> decodePath $ encodeUtf8 uriText--- _ -> fail "Missing/invalid 'URI' in headers received from Mongrel2"--- extractQuery _ = fail "Invalid headers received from Mongrel2"
src/Hack2/Handler/Mongrel2HTTP.hs view
@@ -16,19 +16,14 @@ import Hack2 import Data.Default (def, Default)-import qualified Data.CaseInsensitive as CaseInsensitive import Data.ByteString.Char8 (ByteString, pack) import qualified Data.ByteString.Char8 as B import Data.Enumerator (Enumerator, Iteratee (..), ($$), joinI, run_, Enumeratee, Step, (=$), ($=), enumList, concatEnums)-import qualified Data.Enumerator.List as EL import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString, toByteString) import Data.Maybe (listToMaybe, fromMaybe, isJust, fromJust) import Data.Map (toAscList, fromAscList) -import Data.IORef (readIORef)--import System.Directory (createDirectory, doesDirectoryExist) import Control.Monad (when, forever) import Hack2.Handler.Mongrel2.IO@@ -39,23 +34,20 @@ import System.Posix.Signals import Control.Concurrent-import Control.Concurrent.MVar-import System.Exit (exitSuccess) import qualified Data.Map as Map import Blaze.Text.Int (integral) import Data.Monoid import qualified Data.Aeson as Aeson-import Data.Text.Encoding (encodeUtf8) import Safe (readMay, readDef) import Hack2.Handler.Mongrel2.Utils-import Data.Attoparsec-import Data.Aeson (Value(..), json) import Control.Concurrent.STM import Data.Int import qualified Data.Set as Set+import qualified Data.List as List+import qualified Prelude as P buildSpace :: Builder buildSpace = fromByteString " "@@ -245,6 +237,8 @@ forkIO - server_safe_loop instance_id disconnected ) + fork - forever - clean_up_disconnected_client_ids disconnected+ log "taking exit_indicator" takeMVar exit_indicator log "done taking exit_indicator"@@ -270,7 +264,21 @@ catch_all message io_action = Exception.catch io_action - \e -> log_error - message + " " + (e :: Exception.SomeException).show + "\n"++clean_up_disconnected_client_ids :: TVar (Set.Set Int64) -> IO ()+clean_up_disconnected_client_ids disconnected = do+ sleep 10+ + atomically - do+ ids <- readTVar disconnected+ let set_length = ids.Set.size + max_length = 10000+ + when (set_length >= max_length) - do+ let new_ids = ids.to_list.List.sort.drop (set_length P.- max_length).Set.fromList+ writeTVar disconnected new_ids+ loop :: Int -> Mongrel2.Handler -> TVar (Set.Set Int64) -> Application -> IO () loop instance_id _handler disconnected app = do@@ -314,5 +322,5 @@ writeTVar disconnected - _ids.Set.insert client_id _ ->- log - "json reponse: " + show xs+ log_error - "Unknown json reponse: " + request.Mongrel2.requestBody.B.unpack