diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Revision history for network-run +## 0.4.1 + +* Make sure to cancel Handles. + [#13](https://github.com/kazu-yamamoto/network-run/pull/13) +* New API: `openClientSocketWithOpts`, `openServerSocketWithOpts` + and `openTCPServerSocketWithOpts`. + [#12](https://github.com/kazu-yamamoto/network-run/pull/12) + ## 0.4.0 * New API: `openTCPServerSocket`, `runTCPClientWithSettings`, etc. diff --git a/Network/Run/Core.hs b/Network/Run/Core.hs --- a/Network/Run/Core.hs +++ b/Network/Run/Core.hs @@ -1,23 +1,29 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} module Network.Run.Core ( resolve, openSocket, openClientSocket, openClientSocketWithOptions, + openClientSocketWithOpts, openServerSocket, openServerSocketWithOptions, + openServerSocketWithOpts, openTCPServerSocket, openTCPServerSocketWithOptions, + openTCPServerSocketWithOpts, gclose, labelMe, ) where +import qualified Data.List.NonEmpty as NE +import Control.Arrow +import Control.Concurrent import qualified Control.Exception as E import Control.Monad (when) -import Network.Socket +import Foreign (Storable) import GHC.Conc.Sync +import Network.Socket resolve :: SocketType @@ -26,7 +32,7 @@ -> [AddrInfoFlag] -> IO AddrInfo resolve socketType mhost port flags = - head <$> getAddrInfo (Just hints) mhost (Just port) + NE.head <$> getAddrInfo (Just hints) mhost (Just port) where hints = defaultHints @@ -41,13 +47,32 @@ -- | This is the same as -- --- > openClientSocketWithOptions [] +-- @ +-- 'openClientSocketWithOptions' [] +-- @ openClientSocket :: AddrInfo -> IO Socket openClientSocket = openClientSocketWithOptions [] +-- | Open a client socket with the given options +-- +-- The options are set before 'connect'. This is equivalent to +-- +-- @ +-- 'openClientSocketWithOpts' . 'map' ('second' 'SockOptValue') +-- @ openClientSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket -openClientSocketWithOptions opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do - mapM_ (uncurry $ setSocketOption sock) opts +openClientSocketWithOptions = openClientSocketWithOpts . map (second SockOptValue) + +-- | Open a client socket with the given options +-- +-- This must be used rather than 'openClientSocketWithOptions' for options such +-- as 'Network.Socket.Linger' which require a composite value +-- ('Network.Socket.StructLinger'). +-- +-- The options are set before 'connect'. +openClientSocketWithOpts :: [(SocketOption, SockOptValue)] -> AddrInfo -> IO Socket +openClientSocketWithOpts opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do + mapM_ (uncurry $ setSockOptValue sock) opts connect sock $ addrAddress addr return sock @@ -55,24 +80,36 @@ -- -- This is the same as: -- --- > openServerSocketWithOptions [] +-- @ +-- 'openServerSocketWithOptions' [] +-- @ openServerSocket :: AddrInfo -> IO Socket openServerSocket = openServerSocketWithOptions [] -- | Open socket for server use, and set the provided options before binding. -- +-- This is equivalent to +-- +-- @ +-- 'openServerSocketWithOpts' . 'map' ('second' 'SockOptValue') +-- @ +openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket +openServerSocketWithOptions = openServerSocketWithOpts . map (second SockOptValue) + +-- | 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 -openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket -openServerSocketWithOptions opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do +openServerSocketWithOpts :: [(SocketOption, SockOptValue)] -> AddrInfo -> IO Socket +openServerSocketWithOpts 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 - mapM_ (uncurry $ setSocketOption sock) opts + mapM_ (uncurry $ setSockOptValue sock) opts withFdSocket sock setCloseOnExecIfNeeded bind sock $ addrAddress addr return sock @@ -81,21 +118,33 @@ -- -- This is the same as: -- --- > openTCPServerSocketWithOptions [] +-- @ +-- 'openTCPServerSocketWithOptions' [] +-- @ openTCPServerSocket :: AddrInfo -> IO Socket openTCPServerSocket = openTCPServerSocketWithOptions [] -- | Open socket for server use, and set the provided options before binding. -- +-- This is equivalent to +-- +-- @ +-- 'openTCPServerSocketWithOpts' . 'map' ('second' 'SockOptValue') +-- @ +openTCPServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket +openTCPServerSocketWithOptions = openTCPServerSocketWithOpts . map (second SockOptValue) + +-- | 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 +openTCPServerSocketWithOpts :: [(SocketOption, SockOptValue)] -> AddrInfo -> IO Socket +openTCPServerSocketWithOpts opts addr = do + sock <- openServerSocketWithOpts opts addr listen sock 1024 return sock diff --git a/Network/Run/TCP.hs b/Network/Run/TCP.hs --- a/Network/Run/TCP.hs +++ b/Network/Run/TCP.hs @@ -8,6 +8,7 @@ runTCPServerWithSocket, openTCPServerSocket, openTCPServerSocketWithOptions, + openTCPServerSocketWithOpts, resolve, -- * Client @@ -18,9 +19,10 @@ runTCPClientWithSettings, openClientSocket, openClientSocketWithOptions, + openClientSocketWithOpts, ) where -import Control.Concurrent (forkFinally) +import Control.Concurrent (forkFinally, threadDelay, forkIO) import qualified Control.Exception as E import Control.Monad (forever, void) import Network.Socket @@ -30,10 +32,6 @@ ---------------------------------------------------------------- -- | 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 mhost port server = withSocketsDo $ do addr <- resolve Stream mhost port [AI_PASSIVE] @@ -72,7 +70,9 @@ -- -- This is the same as: -- --- > runTCPClientWithSettings defaultSettings +-- @ +-- 'runTCPClientWithSettings' 'defaultSettings' +-- @ runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a runTCPClient = runTCPClientWithSettings defaultSettings 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 @@ -9,6 +9,7 @@ runTCPServerWithSocket, openServerSocket, openServerSocketWithOptions, + openServerSocketWithOpts, ) where import Control.Concurrent (forkFinally) @@ -60,5 +61,5 @@ (const $ gclose conn) where server' mgr conn = do - th <- T.registerKillThread mgr $ return () - server mgr th conn + E.bracket (T.registerKillThread mgr $ return ()) T.cancel $ \th -> + 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 @@ -9,6 +9,7 @@ import qualified Control.Exception as E import Control.Monad (forever, void) import Data.ByteString (ByteString) +import qualified Data.List.NonEmpty as NE import Network.Socket import Network.Socket.ByteString @@ -60,7 +61,7 @@ , addrFamily = family , addrFlags = [AI_PASSIVE] } - addr <- head <$> getAddrInfo (Just hints) Nothing (Just port) + addr <- NE.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.4.0 +version: 0.4.1 synopsis: Simple network runner library description: Simple functions to run network clients and servers. -- bug-reports: @@ -20,7 +20,7 @@ -- other-extensions: build-depends: base >= 4 && < 5 , bytestring - , network >= 3.1.0 + , network >= 3.2.4 , time-manager -- hs-source-dirs: default-language: Haskell2010