diff --git a/Network/C10kServer.hs b/Network/C10kServer.hs --- a/Network/C10kServer.hs +++ b/Network/C10kServer.hs @@ -1,13 +1,17 @@ {-| Network server library to handle over 10,000 connections. Since - GHC 6.10.4 or earlier uses select(), it cannot handle connections over + GHC 6.12 or earlier uses select(), it cannot handle connections over 1,024. This library uses the \"prefork\" technique to get over the barrier. Each process handles 'threadNumberPerProcess' connections. 'preforkProcessNumber' child server processes are preforked. So, this server can handle 'preforkProcessNumber' * 'threadNumberPerProcess' connections. - Even if GHC supports kqueue or epoll(), it is difficult for RTS + Programs complied by GHC 6.10 or earlier with the -threaded option + kill the IO thread when forkProcess is used. So, don't specify + the -threaded option to use this library. + + Even if GHC 6.14 supports kqueue or epoll(), it is difficult for RTS to balance over multi-cores. So, this library can be used to make a process for each core and to set limitation of the number to accept connections. @@ -26,15 +30,16 @@ import Control.Exception import Control.Monad import IO hiding (catch, try) -import Network hiding (accept) +import Network.BSD import Network.Socket import Prelude hiding (catch) import Network.TCPInfo hiding (accept) import qualified Network.TCPInfo as T (accept) +import System.Exit import System.Posix.Process import System.Posix.Signals +import System.Posix.Types import System.Posix.User -import System.Exit ---------------------------------------------------------------- @@ -74,6 +79,8 @@ , threadNumberPerProcess :: Int -- | A port name. e.g. \"http\" or \"80\" , portName :: ServiceName + -- | A numeric IP address. e.g. \"127.0.0.1\" + , ipAddr :: Maybe HostName -- | A file where the process ID of the parent process is written. , pidFile :: FilePath -- | A user name. When the program linked with this library runs @@ -92,68 +99,95 @@ Run 'C10kServer' with 'C10kConfig'. -} runC10kServer :: C10kServer -> C10kConfig -> IO () -runC10kServer srv cnf = runC10kServer' (dispatchS srv) cnf - ----------------------------------------------------------------- +runC10kServer srv cnf = runC10kServer' (dispatchS srv) cnf `catch` errorHandle cnf {-| Run 'C10kServerH' with 'C10kConfig'. -} runC10kServerH :: C10kServerH -> C10kConfig -> IO () -runC10kServerH srv cnf = runC10kServer' (dispatchH srv) cnf +runC10kServerH srv cnf = runC10kServer' (dispatchH srv) cnf `catch` errorHandle cnf +errorHandle :: C10kConfig -> SomeException -> IO () +errorHandle cnf e = do + exitHook cnf (show e) + exitFailure + ---------------------------------------------------------------- runC10kServer' :: (Socket -> Dispatch) -> C10kConfig -> IO () runC10kServer' sDispatch cnf = do initHook cnf `catch` ignore - initServer sDispatch cnf `catch` errorHandle + if onlyOne + then stay sDispatch cnf + else prefork sDispatch cnf + where + onlyOne = preforkProcessNumber cnf == 1 + +---------------------------------------------------------------- + +stay :: (Socket -> Dispatch) -> C10kConfig -> IO () +stay sDispatch cnf = do parentStartedHook cnf `catch` ignore - doNothing + s <- listenOn addr port + writePidFile cnf + setGroupUser cnf + runServer (sDispatch s) cnf + sClose s where - errorHandle :: SomeException -> IO () - errorHandle e = do - exitHook cnf (show e) - exitFailure - doNothing = do - threadDelay $ 5 * microseconds - doNothing + port = portName cnf + addr = ipAddr cnf ---------------------------------------------------------------- -initServer :: (Socket -> Dispatch) -> C10kConfig -> IO () -initServer sDispatch cnf = do - let port = Service $ portName cnf - n = preforkProcessNumber cnf - pidf = pidFile cnf - s <- listenOn port - setGroupUser - preFork n (sDispatch s) cnf +prefork :: (Socket -> Dispatch) -> C10kConfig -> IO () +prefork sDispatch cnf = do + cids <- doPrefork sDispatch cnf + parentStartedHook cnf `catch` ignore + handleSignal cids + pause + terminateChildren cids + where + handleSignal cids = do + ignoreSigChild + mapM_ (terminator cids) [sigTERM,sigINT] + pause = awaitSignal Nothing >> yield + initHandler func sig = installHandler sig func Nothing + ignoreSigChild = initHandler Ignore sigCHLD + terminator cids sig = initHandler (Catch (terminateChildren cids)) sig + terminateChildren cids = do + ignoreSigChild + mapM_ terminateChild cids + terminateChild cid = signalProcess sigTERM cid `catch` ignore + +---------------------------------------------------------------- + +doPrefork :: (Socket -> Dispatch) -> C10kConfig -> IO [ProcessID] +doPrefork sDispatch cnf = do + s <- listenOn addr port + writePidFile cnf + setGroupUser cnf + cids <- fork (sDispatch s) sClose s - writePidFile pidf + return cids where - writePidFile pidf = do - pid <- getProcessID - writeFile pidf $ show pid ++ "\n" - setGroupUser = do - uid <- getRealUserID - when (uid == 0) $ do + port = portName cnf + addr = ipAddr cnf + n = preforkProcessNumber cnf + fork dispatch = replicateM n . forkProcess $ runServer dispatch cnf + +---------------------------------------------------------------- + +setGroupUser :: C10kConfig -> IO () +setGroupUser cnf = do + uid <- getRealUserID + when (uid == 0) $ do getGroupEntryForName (group cnf) >>= setGroupID . groupID getUserEntryForName (user cnf) >>= setUserID . userID -preFork :: Int -> Dispatch -> C10kConfig -> IO () -preFork n dispatch cnf = do - ignoreSigChild +writePidFile :: C10kConfig -> IO () +writePidFile cnf = do pid <- getProcessID - cids <- replicateM n $ forkProcess (runServer dispatch cnf) - mapM_ (terminator pid cids) [sigTERM,sigINT] - where - ignoreSigChild = installHandler sigCHLD Ignore Nothing - terminator pid cids sig = installHandler sig (Catch (terminate pid cids)) Nothing - terminate pid cids = do - mapM_ terminateChild cids - signalProcess killProcess pid - terminateChild cid = signalProcess sigTERM cid `catch` ignore + writeFile (pidFile cnf) $ show pid ++ "\n" ---------------------------------------------------------------- @@ -201,3 +235,23 @@ microseconds :: Int microseconds = 1000000 + +---------------------------------------------------------------- + +listenOn :: Maybe HostName -> ServiceName -> IO Socket +listenOn maddr serv = do + proto <- getProtocolNumber "tcp" + let hints = defaultHints { + addrFlags = [ AI_ADDRCONFIG, AI_NUMERICHOST + , AI_NUMERICSERV, AI_PASSIVE + ] + , addrSocketType = Stream + , addrProtocol = proto + } + ais <- getAddrInfo (Just hints) maddr (Just serv) + let ai = head ais + sock <- socket (addrFamily ai) (addrSocketType ai) (addrProtocol ai) + setSocketOption sock ReuseAddr 1 + bindSocket sock (addrAddress ai) + listen sock maxListenQueue + return sock diff --git a/c10k.cabal b/c10k.cabal --- a/c10k.cabal +++ b/c10k.cabal @@ -1,16 +1,16 @@ Name: c10k -Version: 0.3.0 +Version: 0.4.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE -Synopsis: C10k server library +Synopsis: C10k server library using prefork Description: Network server library to handle - over 10,000 connections. Since GHC 6.10.4 or + over 10,000 connections. Since GHC 6.12 or earlier uses select(), it cannot handle connections over 1,024. This library uses the prefork technique to get over the barrier. - Programs complied by GHC 6.10.4 or earlier + Programs complied by GHC 6.10 or earlier with the -threaded option kill the IO thread when forkProcess is used. So, don't specify the -threaded option to use this library. @@ -19,10 +19,13 @@ Cabal-Version: >= 1.6 Build-Type: Simple Library - GHC-Options: -Wall -O2 + if impl(ghc >= 6.12) + GHC-Options: -Wall -O2 -fno-warn-unused-do-bind + else + GHC-Options: -Wall -O2 Exposed-Modules: Network.C10kServer Network.TCPInfo - Build-Depends: base >= 4 && < 10, haskell98, network, unix, hdaemonize + Build-Depends: base >= 4 && < 5, haskell98, network, unix, hdaemonize Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/c10k.git