diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,16 @@ # Revision history for network-run +## 0.4.0 + +* New API: `openTCPServerSocket`, `runTCPClientWithSettings`, etc. +* Breaking change: runTCPServerSocket takes a socket itself + +## 0.3.2 + +* Add `openServerSocketWithOptions`, `openClientSocketWithOptions`, + `runTCPServerWithSocketOptions`, `runTCPClientWithSocketOptions`. + [#6](https://github.com/kazu-yamamoto/network-run/pull/6) + ## 0.3.1 * Using close instead of gracefulClose for client diff --git a/Network/Run/Core.hs b/Network/Run/Core.hs --- a/Network/Run/Core.hs +++ b/Network/Run/Core.hs @@ -5,13 +5,19 @@ resolve, openSocket, openClientSocket, + openClientSocketWithOptions, openServerSocket, + openServerSocketWithOptions, + openTCPServerSocket, + openTCPServerSocketWithOptions, gclose, + labelMe, ) where import qualified Control.Exception as E import Control.Monad (when) import Network.Socket +import GHC.Conc.Sync resolve :: SocketType @@ -33,32 +39,74 @@ openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) #endif +-- | This is the same as +-- +-- > openClientSocketWithOptions [] openClientSocket :: AddrInfo -> IO Socket -openClientSocket ai = do - sock <- openSocket ai - connect sock $ addrAddress ai +openClientSocket = openClientSocketWithOptions [] + +openClientSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket +openClientSocketWithOptions opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do + mapM_ (uncurry $ setSocketOption sock) opts + connect sock $ addrAddress addr return sock -- | Open socket for server use -- --- The socket is configured to +-- This is the same as: -- +-- > openServerSocketWithOptions [] +openServerSocket :: AddrInfo -> IO Socket +openServerSocket = openServerSocketWithOptions [] + +-- | Open socket for server use, and set the provided options before binding. +-- +-- In addition to the given options, the socket is configured to +-- -- * allow reuse of local addresses (SO_REUSEADDR) -- * automatically be closed during a successful @execve@ (FD_CLOEXEC) -- * bind to the address specified -openServerSocket :: AddrInfo -> IO Socket -openServerSocket addr = E.bracketOnError (openSocket addr) close $ \sock -> do +openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket +openServerSocketWithOptions opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do setSocketOption sock ReuseAddr 1 #if !defined(openbsd_HOST_OS) when (addrFamily addr == AF_INET6) $ setSocketOption sock IPv6Only 1 #endif - withFdSocket sock $ setCloseOnExecIfNeeded + mapM_ (uncurry $ setSocketOption sock) opts + withFdSocket sock setCloseOnExecIfNeeded bind sock $ addrAddress addr return sock +-- | Open TCP socket for server use +-- +-- This is the same as: +-- +-- > openTCPServerSocketWithOptions [] +openTCPServerSocket :: AddrInfo -> IO Socket +openTCPServerSocket = openTCPServerSocketWithOptions [] + +-- | Open socket for server use, and set the provided options before binding. +-- +-- In addition to the given options, the socket is configured to +-- +-- * allow reuse of local addresses (SO_REUSEADDR) +-- * automatically be closed during a successful @execve@ (FD_CLOEXEC) +-- * bind to the address specified +-- * listen with queue length with 1024 +openTCPServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket +openTCPServerSocketWithOptions opts addr = do + sock <- openServerSocketWithOptions opts addr + listen sock 1024 + return sock + gclose :: Socket -> IO () #if MIN_VERSION_network(3,1,1) gclose sock = gracefulClose sock 5000 #else gclose = close #endif + +labelMe :: String -> IO () +labelMe name = do + tid <- myThreadId + labelThread tid name diff --git a/Network/Run/TCP.hs b/Network/Run/TCP.hs --- a/Network/Run/TCP.hs +++ b/Network/Run/TCP.hs @@ -1,13 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -- | Simple functions to run TCP clients and servers. module Network.Run.TCP ( - runTCPClient, + -- * Server runTCPServer, - - -- * Generalized API runTCPServerWithSocket, - openServerSocket, + openTCPServerSocket, + openTCPServerSocketWithOptions, + resolve, + + -- * Client + runTCPClient, + Settings, + defaultSettings, + settingsOpenClientSocket, + runTCPClientWithSettings, + openClientSocket, + openClientSocketWithOptions, ) where import Control.Concurrent (forkFinally) @@ -17,42 +27,62 @@ import Network.Run.Core --- | Running a TCP client with a connected socket. -runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a -runTCPClient host port client = withSocketsDo $ do - addr <- resolve Stream (Just host) port [AI_ADDRCONFIG] - E.bracket (open addr) close client - where - open addr = E.bracketOnError (openClientSocket addr) close return +---------------------------------------------------------------- -- | Running a TCP server with an accepted socket and its peer name. +-- +-- This is the same as: +-- +-- > runTCPServerWithSocketOptions [] runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a -runTCPServer = runTCPServerWithSocket openServerSocket - ----------------------------------------------------------------- --- Generalized API +runTCPServer mhost port server = withSocketsDo $ do + addr <- resolve Stream mhost port [AI_PASSIVE] + E.bracket (openTCPServerSocket addr) close $ \sock -> + runTCPServerWithSocket sock server --- | Generalization of 'runTCPServer' +-- | Running a TCP client with a connected socket for a given listen +-- socket. runTCPServerWithSocket - :: (AddrInfo -> IO Socket) - -- ^ Initialize socket. - -- - -- This function is called while exceptions are masked. - -- - -- The default (used by 'runTCPServer') is 'openServerSocket'. - -> Maybe HostName - -> ServiceName + :: Socket -> (Socket -> IO a) -- ^ Called for each incoming connection, in a new thread -> IO a -runTCPServerWithSocket initSocket mhost port server = withSocketsDo $ do - addr <- resolve Stream mhost port [AI_PASSIVE] - E.bracket (open addr) close loop - where - open addr = E.bracketOnError (initSocket addr) close $ \sock -> do - listen sock 1024 - return sock - loop sock = forever $ +runTCPServerWithSocket sock server = withSocketsDo $ + forever $ E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) -> - void $ forkFinally (server conn) (const $ gclose conn) + void $ forkFinally (labelMe "TCP server" >> server conn) (const $ gclose conn) + +---------------------------------------------------------------- + +-- | Settings for client. +data Settings = Settings + { settingsOpenClientSocket :: AddrInfo -> IO Socket + -- ^ Opening a socket. Use 'openClientSocketWithOptions' to specify 'SocketOption' + } + +-- | Default settings. +defaultSettings :: Settings +defaultSettings = + Settings + { settingsOpenClientSocket = openClientSocket + } + +-- | Running a TCP client with a connected socket. +-- +-- This is the same as: +-- +-- > runTCPClientWithSettings defaultSettings +runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a +runTCPClient = runTCPClientWithSettings defaultSettings + +-- | Running a TCP client with a connected socket. +runTCPClientWithSettings + :: Settings + -> HostName + -> ServiceName + -> (Socket -> IO a) + -> IO a +runTCPClientWithSettings Settings{..} host port client = withSocketsDo $ do + addr <- resolve Stream (Just host) port [AI_ADDRCONFIG] + E.bracket (settingsOpenClientSocket addr) close client diff --git a/Network/Run/TCP/Timeout.hs b/Network/Run/TCP/Timeout.hs --- a/Network/Run/TCP/Timeout.hs +++ b/Network/Run/TCP/Timeout.hs @@ -7,8 +7,8 @@ -- * Generalized API runTCPServerWithSocket, - openClientSocket, openServerSocket, + openServerSocketWithOptions, ) where import Control.Concurrent (forkFinally) @@ -29,7 +29,7 @@ -- ^ A connected socket -> IO a --- | Running a TCP server with an accepted socket and its peer name. +-- | Running a TCP server with a connected socket. runTCPServer :: Int -- ^ Timeout in second. @@ -37,34 +37,28 @@ -> ServiceName -> TimeoutServer a -> IO a -runTCPServer = runTCPServerWithSocket openServerSocket - ----------------------------------------------------------------- --- Generalized API +runTCPServer tm mhost port server = withSocketsDo $ do + addr <- resolve Stream mhost port [AI_PASSIVE] + E.bracket (openTCPServerSocket addr) close $ \sock -> + runTCPServerWithSocket tm sock server --- | Generalization of 'runTCPServer' --- --- See 'Network.Run.TCP.runTCPServerWithSocket' for additional discussion. +-- | Running a TCP client with a connected socket for a given listen +-- socket. runTCPServerWithSocket - :: (AddrInfo -> IO Socket) - -> Int + :: Int -- ^ Timeout in second. - -> Maybe HostName - -> ServiceName + -> Socket -> TimeoutServer a -> IO a -runTCPServerWithSocket initSocket tm mhost port server = withSocketsDo $ do - T.withManager (tm * 1000000) $ \mgr -> do - addr <- resolve Stream mhost port [AI_PASSIVE] - E.bracket (open addr) close $ loop mgr - where - open addr = E.bracketOnError (initSocket addr) close $ \sock -> do - listen sock 1024 - return sock - loop mgr sock = forever $ +runTCPServerWithSocket tm sock server = withSocketsDo $ do + T.withManager (tm * 1000000) $ \mgr -> forever $ E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) -> - void $ forkFinally (server' mgr conn) (const $ gclose conn) + void $ + forkFinally + (labelMe "TCP timeout server" >> server' mgr conn) + (const $ gclose conn) + where server' mgr conn = do th <- T.registerKillThread mgr $ return () server mgr th conn diff --git a/Network/Run/UDP.hs b/Network/Run/UDP.hs --- a/Network/Run/UDP.hs +++ b/Network/Run/UDP.hs @@ -46,19 +46,21 @@ mapM_ (forkIO . run) hs run h where - run host = runUDPServer (Just host) port $ \lsock -> forever $ do - (bs0, peeraddr) <- recvFrom lsock 2048 - let family = case peeraddr of - SockAddrInet{} -> AF_INET - SockAddrInet6{} -> AF_INET6 - _ -> error "family" - hints = - defaultHints - { addrSocketType = Datagram - , addrFamily = family - , addrFlags = [AI_PASSIVE] - } - addr <- head <$> getAddrInfo (Just hints) Nothing (Just port) - s <- openServerSocket addr - connect s peeraddr - void $ forkFinally (server s bs0) (\_ -> close s) + run host = do + labelMe $ "UDP server for " ++ h + runUDPServer (Just host) port $ \lsock -> forever $ do + (bs0, peeraddr) <- recvFrom lsock 2048 + let family = case peeraddr of + SockAddrInet{} -> AF_INET + SockAddrInet6{} -> AF_INET6 + _ -> error "family" + hints = + defaultHints + { addrSocketType = Datagram + , addrFamily = family + , addrFlags = [AI_PASSIVE] + } + addr <- head <$> getAddrInfo (Just hints) Nothing (Just port) + s <- openServerSocket addr + connect s peeraddr + void $ forkFinally (labelMe "UDP server" >> server s bs0) (\_ -> close s) diff --git a/network-run.cabal b/network-run.cabal --- a/network-run.cabal +++ b/network-run.cabal @@ -1,5 +1,5 @@ name: network-run -version: 0.3.1 +version: 0.4.0 synopsis: Simple network runner library description: Simple functions to run network clients and servers. -- bug-reports: