diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,2 @@ +Handler Implemenation for Hack (http://hackage.haskell.org/package/hack) + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main where + +import Distribution.Simple + +main = defaultMain + diff --git a/hack-handler-epoll.cabal b/hack-handler-epoll.cabal new file mode 100644 --- /dev/null +++ b/hack-handler-epoll.cabal @@ -0,0 +1,32 @@ +name: hack-handler-epoll +version: 0.1 +synopsis: hack handler implementation using epoll +description: Hack handler implemented using System.Linux.Epoll +category: Web +license: LGPL +license-file: LICENSE +author: Toralf Wittner +maintainer: toralf.wittner@gmail.com +copyright: Copyright (c) 2010 Toralf Wittner +homepage: http://github.com/twittner/hack-handler-epoll/ +stability: experimental +tested-With: GHC == 6.12.1 +cabal-version: >= 1.6.0 +build-type: Simple +extra-source-files: README + +library + exposed-modules: Hack.Handler.Epoll + ghc-options: -Wall -O2 + build-depends: base >= 3 && < 5, + unix, + hack >= 2009.10.30, + epoll >= 0.2.2, + HTTP >= 4000.0.8, + data-default >= 0.2, + network >= 2.2.1.2, + failure >= 0.0.0.1, + utf8-string >= 0.3.4, + containers >= 0.3.0.0 + hs-source-dirs: src + diff --git a/src/Hack/Handler/Epoll.hs b/src/Hack/Handler/Epoll.hs new file mode 100644 --- /dev/null +++ b/src/Hack/Handler/Epoll.hs @@ -0,0 +1,235 @@ +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | +-- Module : Hack.Handler.Epoll +-- Copyright : (c) 2010 Toralf Wittner +-- License : LGPL +-- Maintainer : toralf.wittner@gmail.com +-- Stability : experimental +-- Portability : non-portable +-- +-- Implements Hack Handler interface using System.Linux.Epoll. + +module Hack.Handler.Epoll ( + run, + runWithConfig, + ServerConf(..) +) where + +import Control.Concurrent +import Control.Exception (Exception, bracket, finally) +import Control.Failure +import Control.Monad +import Data.Default +import Data.List +import Data.Maybe +import Data.Typeable (Typeable) +import Hack +import Network.HTTP (RequestData, parseRequestHead) +import Network.HTTP.Headers +import Network.Socket +import Network.Stream (ConnError) +import Network.URI +import System.IO +import System.Linux.Epoll +import System.Posix.Signals +import System.Posix.Types +import qualified Data.ByteString.Lazy.UTF8 as B +import qualified Data.Map as M + + +data ServerConf = ServerConf + { host :: String + , port :: Int + , backlog :: Int + , epollSize :: Int + } deriving Show + +instance Default ServerConf where + def = ServerConf "127.0.0.1" 8000 256 8192 + + +data BodyLen = Chunked | Len Int | Unknown deriving (Eq, Show) + + +deriving instance Typeable ConnError +instance Exception ConnError + + +run :: Application -> IO () +run = runWithConfig def + + +runWithConfig :: ServerConf -> Application -> IO () +runWithConfig conf app = + bracket (createRuntime (fromJust . toSize . epollSize $ conf)) + shutdownRuntime $ \epoll -> do + + ai <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) + (Just . host $ conf) + (Just . show . port $ conf) + + let serverAddr = head ai + server <- socket (addrFamily serverAddr) Stream defaultProtocol + + setSocketOption server ReuseAddr 1 + bindSocket server (addrAddress serverAddr) + listen server (backlog conf) + + installHandler sigPIPE Ignore Nothing + + forever $ do + (sock, remoteAddr) <- accept server + process conf epoll app sock remoteAddr + + +process :: ServerConf -> Runtime -> Application -> Socket -> SockAddr -> IO ThreadId +process c r app s ra = forkIO $ ensure (sClose s) $ do + let fd = Fd . fdSocket $ s + env <- parseEnv c r fd ra + app env >>= writeResponse r fd + where + ensure = flip finally + + +parseEnv :: ServerConf -> Runtime -> Fd -> SockAddr -> IO Env +parseEnv c r fd ra = withIBuffer r fd $ \b -> do + (hd, bd) <- readBuffer b >>= return . headBody + header <- try $ parseRequestHead . breakLines $ hd + headerToEnv c header bd ra + + +headerToEnv :: ServerConf -> RequestData -> String -> SockAddr -> IO Env +headerToEnv conf (meth, uri, header) bdy remote = do + (mrhost, _) <- getNameInfo [NI_NOFQDN] True False remote + let rhost = mrhost ||| "" + host' = lookupHeader HdrHost header ||| host conf + body' = readBody bodyLen bdy + return $ Env + { requestMethod = read . show $ meth + , scriptName = "" + , pathInfo = uriPath uri + , queryString = uriQuery uri + , serverName = host' + , serverPort = port conf + , http = map (\(Header h v) -> (show h, v)) header + , hackVersion = [2009, 10, 30] + , hackUrlScheme = HTTP + , hackInput = B.fromString body' + , hackErrors = hPutStr stderr + , hackHeaders = [] + , hackCache = [] + , remoteHost = rhost + } + where + infixr 2 ||| + (|||) m d = maybe d id m + + bodyLen = transferEnc ||| contentLen ||| Unknown + + contentLen = do + cl <- lookupHeader HdrContentLength header + return . Len . abs . read $ cl + + transferEnc = do + tc <- lookupHeader HdrTransferEncoding header + if tc /= "identity" then return Chunked else return Unknown + + +writeResponse :: Runtime -> Fd -> Response -> IO () +writeResponse r fd resp = withOBuffer r fd $ \b -> do + let st = status resp + sm = M.findWithDefault "" st statusCode + sl = showString "HTTP/1.1 " . shows st . showString " " . showString sm $ "\r\n" + hd = map (\(k, v) -> (k ++ (": " ++ v))) $ headers resp + writeBuffer b $ showString sl + . showString (concat . intersperse "\r\n" $ hd) + . showString "\r\n\r\n" $ B.toString . body $ resp + + +readBody :: BodyLen -> String -> String +readBody Unknown _ = "" +readBody (Len n) b = take n b +readBody Chunked b = concat $ readChunks [] b + where + readChunks chs [] = reverse chs + readChunks chs st = + let (hd, tl) = line st + n = read $ "0x" ++ takeWhile (/= ';') hd + in + readChunks (take n tl:chs) + (dropWhile (isIn "\r\n") . drop n $ tl) + + +headBody :: String -> (String, String) +headBody = go [] + where + go hd [] = (reverse hd, []) + go hd ('\r':'\n':'\r':'\n':bd) = (reverse hd, bd) + go hd (x:xs) = go (x:hd) xs + + +breakLines :: String -> [String] +breakLines str = pre : case rest of + '\r':'\n':suf -> breakLines suf + '\r':suf -> breakLines suf + '\n':suf -> breakLines suf + _ -> [] + where + (pre, rest) = break (isIn "\r\n") str + + +line :: String -> (String, String) +line s = let (hd, tl) = break (isIn "\r\n") s + in (hd, dropWhile (isIn "\r\n") tl) + + +isIn :: (Eq a) => [a] -> a -> Bool +isIn = flip elem + + +statusCode :: M.Map Int String +statusCode = M.fromAscList + [ (100, "Continue") + , (101, "Switching Protocols") + , (200, "OK") + , (201, "Created") + , (202, "Accepted") + , (203, "Non-Authoritative Information") + , (204, "No Content") + , (205, "Reset Content") + , (206, "Partial Content") + , (300, "Multiple Choices") + , (301, "Moved Permanently") + , (302, "Found") + , (303, "See Other") + , (304, "Not Modified") + , (305, "Use Proxy") + , (307, "Temporary Redirect") + , (400, "Bad Request") + , (401, "Unauthorized") + , (402, "Payment Required") + , (403, "Forbidden") + , (404, "Not Found") + , (405, "Method Not Allowed") + , (406, "Not Acceptable") + , (407, "Proxy Authentication Required") + , (408, "Request Time-out") + , (409, "Conflict") + , (410, "Gone") + , (411, "Length Required") + , (412, "Precondition Failed") + , (413, "Request Entity Too Large") + , (414, "Request-URI Too Large") + , (415, "Unsupported Media Type") + , (416, "Requested range not satisfiable") + , (417, "Expectation Failed") + , (500, "Internal Server Error") + , (501, "Not Implemented") + , (502, "Bad Gateway") + , (503, "Service Unavailable") + , (504, "Gateway Time-out") + , (505, "HTTP Version not supported") + ] +