c10k (empty) → 0.1.0

raw patch · 5 files changed

+264/−0 lines, 5 filesdep +basedep +haskell98dep +hdaemonizesetup-changed

Dependencies added: base, haskell98, hdaemonize, network, unix

Files

• LICENSE +29/−0
• Network/C10kServer.hs +162/−0
• Network/TCPInfo.hs +44/−0
• Setup.hs +2/−0
• c10k.cabal +27/−0

@@ -0,0 +1,29 @@+Copyright (c) 2009, IIJ Innovation Institute Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++  * Redistributions of source code must retain the above copyright+    notice, this list of conditions and the following disclaimer.+  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in+    the documentation and/or other materials provided with the+    distribution.+  * Neither the name of the copyright holders nor the names of its+    contributors may be used to endorse or promote products derived+    from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,162 @@+{-|+  Network server library to handle over 10,000 connections. Since+  GHC 6.10.4 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. To stop all server, send SIGTERM to the parent+  process. (e.g. @kill `cat PIDFILE`@ where the PID file name is+  specified by 'pidFile')+-}+module Network.C10kServer (C10kServer, C10kConfig(..),+                           runC10kServer) where++import Control.Concurrent+import Control.Exception+import Control.Monad+import IO hiding (catch, try)+import Network hiding (accept)+import Network.Socket hiding (accept)+import Network.TCPInfo+import Prelude hiding (catch)+import System.Posix.Process+import System.Posix.Signals+import System.Posix.User+import System.Exit++----------------------------------------------------------------++{-|+  The type of the first argument of 'runC10kServer'.+-}+type C10kServer = Handle -> TCPInfo -> IO ()++{-|+  The type of configuration given to 'runC10kServer' as the second+  argument.+-}+data C10kConfig = C10kConfig {+  -- | A hook called initialization time. This is used topically to+  --   initialize syslog.+    initHook :: IO ()+  -- | A hook called when the server exits due to an error.+  , exitHook :: String -> IO ()+  -- | A hook to be called in the parent process when all child+  --   process are preforked successfully.+  , parentStartedHook :: IO ()+  -- | A hook to be called when each child process is started+  --   successfully.+  , startedHook :: IO ()+  -- | The time in seconds that a main thread of each child process+  --   to sleep when the number of connection reaches+  --   'threadNumberPerProcess'.+  , sleepTimer :: Int+  -- | The number of child process.+  , preforkProcessNumber :: Int+  -- | The number of thread which a process handle.+  , threadNumberPerProcess :: Int+  -- | A port name. e.g. \"http\" or \"80\"+  , portName :: ServiceName+  -- | 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+  --   in the root privilege, set user to this value. Otherwise,+  --   this value is ignored.+  , user :: String+  -- | A group name. When the program linked with this library runs+  --   in the root privilege, set group to this value. Otherwise,+  --   this value is ignored.+  , group :: String+}++----------------------------------------------------------------++{-|+  Run 'C10kServer' with 'C10kConfig'.+-}+runC10kServer :: C10kServer -> C10kConfig -> IO ()+runC10kServer srv cnf = do+    initHook cnf `catch` ignore+    initServer srv cnf `catch` errorHandle+    parentStartedHook cnf `catch` ignore+    doNothing+  where+    errorHandle :: SomeException -> IO ()+    errorHandle e = do+      exitHook cnf (show e)+      exitFailure+    doNothing = do+      threadDelay $ 5 * microseconds+      doNothing++----------------------------------------------------------------++initServer :: C10kServer -> C10kConfig -> IO ()+initServer srv cnf = do+    let port = Service $ portName cnf+        n    = preforkProcessNumber cnf+        pidf = pidFile cnf+    s <- listenOn port+    setGroupUser+    preFork s n srv cnf+    sClose s+    writePidFile pidf+  where+    writePidFile pidf = do+        pid <- getProcessID+        writeFile pidf $ show pid ++ "\n"+    setGroupUser = do+      uid <- getRealUserID+      when (uid == 0) $ do+        getGroupEntryForName (group cnf) >>= setGroupID . groupID+        getUserEntryForName (user cnf) >>= setUserID . userID++preFork :: Socket -> Int -> C10kServer -> C10kConfig -> IO ()+preFork s n srv cnf = do+    ignoreSigChild+    pid <- getProcessID+    cids <- replicateM n $ forkProcess (runServer s srv 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++----------------------------------------------------------------++runServer :: Socket -> C10kServer -> C10kConfig -> IO ()+runServer s srv cnf = do+    startedHook cnf+    mvar <- newMVar 0+    dispatchOrSleep mvar s srv cnf++dispatchOrSleep :: MVar Int -> Socket -> C10kServer -> C10kConfig -> IO ()+dispatchOrSleep mvar s srv cnf = do+    n <- howMany+    if n > threadNumberPerProcess cnf+        then sleep (sleepTimer cnf * microseconds)+        else dispatch+    dispatchOrSleep mvar s srv cnf+  where+    dispatch = do+        (hdl,tcpi) <- accept s+        increase+        forkIO $ srv hdl tcpi `finally` (decrease >> hClose hdl)+        return ()+    howMany = readMVar mvar+    increase = modifyMVar_ mvar (return . succ)+    decrease = modifyMVar_ mvar (return . pred)+    sleep = threadDelay+++----------------------------------------------------------------++ignore :: SomeException -> IO ()+ignore _ = return ()++microseconds :: Int+microseconds = 1000000

@@ -0,0 +1,44 @@+{-|+  Yet another accept() to tell TCP information.+-}+module Network.TCPInfo where++import Data.List+import Network.Socket+import System.IO++{-|+  A Type to carry TCP information.+-}+data TCPInfo = TCPInfo {+  -- | Local IP address+    myAddr :: HostName+  -- | Local port number+  , myPort :: ServiceName+  -- | Remote IP address+  , peerAddr :: HostName+  -- | Remote port number+  , peerPort :: ServiceName+  } deriving (Eq,Show)++----------------------------------------------------------------++{-|+  Yet another accept() to return both 'Handle' and 'TCPInfo'.+-}+accept :: Socket -> IO (Handle, TCPInfo)+accept sock = do+    (sock', sockaddr) <- Network.Socket.accept sock+    let getInfo = getNameInfo [NI_NUMERICHOST, NI_NUMERICSERV] True True+    (Just vMyAddr,   Just vMyPort)   <- getSocketName sock' >>= getInfo+    (Just vPeerAddr, Just vPeerPort) <- getInfo sockaddr+    hdl <- socketToHandle sock' ReadWriteMode+    let info = TCPInfo { myAddr = strip vMyAddr+                       , myPort = vMyPort+                       , peerAddr = strip vPeerAddr+                       , peerPort = vPeerPort}+    return (hdl, info)+  where+    strip x+      | "::ffff:" `isPrefixOf` x = drop 7 x+      | otherwise                = x

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,27 @@+Name:                   c10k+Version:                0.1.0+Author:                 Kazu Yamamoto <kazu@iij.ad.jp>+Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>+License:                BSD3+License-File:           LICENSE+Synopsis:               C10k server+Description:            Network server library to handle+			over 10,000 connections. Since GHC 6.10.4 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+                        with the -threaded option kill the IO thread+                        when forkProcess is used. So, don't specify+                        the -threaded option to use this library.+Homepage:               http://github.com/kazu-yamamoto/c10k+Category:               Network+Cabal-Version:          >= 1.6+Build-Type:             Simple+Library+  GHC-Options:          -Wall -O2+  Exposed-Modules:      Network.C10kServer, Network.TCPInfo+  Build-Depends:        base >= 4 && < 10, haskell98, network, unix, hdaemonize+Source-Repository head+  Type:                 git+  Location:             git://github.com/kazu-yamamoto/c10k.git