c10k 0.2.0 → 0.3.0

raw patch · 3 files changed

+104/−23 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Network/C10kServer.hs +58/−22
• Network/TCPInfo.hs +44/−0
• c10k.cabal +2/−1

@@ -16,15 +16,21 @@   (e.g. @kill `cat PIDFILE`@ where the PID file name is   specified by 'pidFile') -}-module Network.C10kServer (C10kServer, C10kConfig(..),-                           runC10kServer) where+module Network.C10kServer (+    C10kConfig(..)+  , C10kServer,  runC10kServer+  , C10kServerH, runC10kServerH+  ) where  import Control.Concurrent import Control.Exception import Control.Monad+import IO hiding (catch, try) import Network hiding (accept) import Network.Socket import Prelude hiding (catch)+import Network.TCPInfo hiding (accept)+import qualified Network.TCPInfo as T (accept) import System.Posix.Process import System.Posix.Signals import System.Posix.User@@ -38,6 +44,11 @@ type C10kServer = Socket -> IO ()  {-|+  The type of the first argument of 'runC10kServerH'.+-}+type C10kServerH = Handle -> TCPInfo -> IO ()++{-|   The type of configuration given to 'runC10kServer' as the second   argument. -}@@ -81,9 +92,22 @@   Run 'C10kServer' with 'C10kConfig'. -} runC10kServer :: C10kServer -> C10kConfig -> IO ()-runC10kServer srv cnf = do+runC10kServer srv cnf = runC10kServer' (dispatchS srv) cnf++----------------------------------------------------------------++{-|+  Run 'C10kServerH' with 'C10kConfig'.+-}+runC10kServerH :: C10kServerH -> C10kConfig -> IO ()+runC10kServerH srv cnf = runC10kServer' (dispatchH srv) cnf++----------------------------------------------------------------++runC10kServer' :: (Socket -> Dispatch) -> C10kConfig -> IO ()+runC10kServer' sDispatch cnf = do     initHook cnf `catch` ignore-    initServer srv cnf `catch` errorHandle+    initServer sDispatch cnf `catch` errorHandle     parentStartedHook cnf `catch` ignore     doNothing   where@@ -97,14 +121,14 @@  ---------------------------------------------------------------- -initServer :: C10kServer -> C10kConfig -> IO ()-initServer srv cnf = do+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 s n srv cnf+    preFork n (sDispatch s) cnf     sClose s     writePidFile pidf   where@@ -117,11 +141,11 @@         getGroupEntryForName (group cnf) >>= setGroupID . groupID         getUserEntryForName (user cnf) >>= setUserID . userID -preFork :: Socket -> Int -> C10kServer -> C10kConfig -> IO ()-preFork s n srv cnf = do+preFork :: Int -> Dispatch -> C10kConfig -> IO ()+preFork n dispatch cnf = do     ignoreSigChild     pid <- getProcessID-    cids <- replicateM n $ forkProcess (runServer s srv cnf)+    cids <- replicateM n $ forkProcess (runServer dispatch cnf)     mapM_ (terminator pid cids) [sigTERM,sigINT]   where     ignoreSigChild = installHandler sigCHLD Ignore Nothing@@ -133,30 +157,42 @@  ---------------------------------------------------------------- -runServer :: Socket -> C10kServer -> C10kConfig -> IO ()-runServer s srv cnf = do+runServer :: Dispatch -> C10kConfig -> IO ()+runServer dispatch cnf = do     startedHook cnf     mvar <- newMVar 0-    dispatchOrSleep mvar s srv cnf+    dispatchOrSleep mvar dispatch cnf -dispatchOrSleep :: MVar Int -> Socket -> C10kServer -> C10kConfig -> IO ()-dispatchOrSleep mvar s srv cnf = do+dispatchOrSleep :: MVar Int -> Dispatch -> C10kConfig -> IO ()+dispatchOrSleep mvar dispatch cnf = do     n <- howMany     if n > threadNumberPerProcess cnf         then sleep (sleepTimer cnf * microseconds)-        else dispatch-    dispatchOrSleep mvar s srv cnf+        else dispatch increase decrease+    dispatchOrSleep mvar dispatch cnf   where-    dispatch = do-        (sock,_) <- accept s-        increase-        forkIO $ srv sock `finally` (decrease >> (sClose sock `catch` ignore))-        return ()     howMany = readMVar mvar     increase = modifyMVar_ mvar (return . succ)     decrease = modifyMVar_ mvar (return . pred)     sleep = threadDelay +----------------------------------------------------------------++type Dispatch = IO () -> IO () -> IO ()++dispatchS :: C10kServer -> Socket -> Dispatch+dispatchS srv sock inc dec = do+    (connsock,_) <- accept sock+    inc+    forkIO $ srv connsock `finally` (dec >> sClose connsock)+    return ()++dispatchH :: C10kServerH -> Socket -> Dispatch+dispatchH srv sock inc dec = do+    (hdl,tcpi) <- T.accept sock+    inc+    forkIO $ srv hdl tcpi `finally` (dec >> hClose hdl)+    return ()  ---------------------------------------------------------------- 

@@ -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

@@ -1,5 +1,5 @@ Name:                   c10k-Version:                0.2.0+Version:                0.3.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -21,6 +21,7 @@ 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