Skip to content

Instantly share code, notes, and snippets.

@kazu-yamamoto
Created August 9, 2012 07:41
Show Gist options
  • Save kazu-yamamoto/3302049 to your computer and use it in GitHub Desktop.
Save kazu-yamamoto/3302049 to your computer and use it in GitHub Desktop.
Demo for new thundering herd on epoll with non-blocking listening socket.
{-
Thundering herd on epoll with a non-blocking listening socket.
Compile: ghc -O ThunderingHerd.hs -threaded
Run this and do "telnet localhost 3000" to see new thundering herd.
-}
module Main where
import Control.Concurrent
import Control.Exception
import Control.Monad
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Network
import Network.Socket
import Network.Socket.Internal
import System.Posix
main :: IO ()
main = handle handler $ do
ignoreSigChild
sock <- listenOn (PortNumber 3000)
replicateM_ 4 $ void . forkProcess $ child sock
sClose sock
loop
child :: Socket -> IO ()
child (MkSocket s family _ _ _) = handle handler $ do
putStrLn $ "waiting for a listen socket -- " ++ show s
threadWaitRead (fromIntegral s)
let sz = sizeOfSockAddrByFamily family
res <- allocaBytes sz $ \sockaddr ->
with (fromIntegral sz) $ \ptr_len ->
c_accept s sockaddr ptr_len
if res /= -1 then
putStrLn $ "accteped: " ++ show res
else
putStrLn $ "accteped failed (thundering herd!)"
handler :: SomeException -> IO ()
handler e = do
pid <- getProcessID
putStrLn $ show pid ++ ": " ++ show e
loop :: IO ()
loop = threadDelay 10000000 >> loop
ignoreSigChild :: IO ()
ignoreSigChild = void $ installHandler sigCHLD Ignore Nothing
foreign import ccall unsafe "accept"
c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment