diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -8,4 +8,10 @@ - add return code to OTHER_KEEPALIVE_ERROR +## 0.2.1.0 + +- add darwin support +- fix windows build +- add CI and tests + ## Unreleased changes diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cbits/CKa.h b/cbits/CKa.h --- a/cbits/CKa.h +++ b/cbits/CKa.h @@ -17,14 +17,14 @@ # endif #endif -INLINE int +INLINE int winSetKeepAlive(int s, ULONG onoff, ULONG time, ULONG intvl) { struct tcp_keepalive ka; DWORD size; - ka.onoff = onoff; + ka.onoff = onoff; ka.keepalivetime = time; ka.keepaliveinterval = intvl; int sizeka = sizeof(ka); diff --git a/keep-alive.cabal b/keep-alive.cabal --- a/keep-alive.cabal +++ b/keep-alive.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: keep-alive -version: 0.2.0.0 +version: 0.2.1.0 homepage: https://github.com/3kyro/keep-alive#readme bug-reports: https://github.com/3kyro/keep-alive/issues author: Kyriakos Papachrysanthou @@ -13,7 +13,7 @@ synopsis: TCP keep alive implementation category: Network description: - This module allows you to set per-connection keep alive parameters on windows and linux enviroments. + This module allows you to set per-connection keep alive parameters on windows, linux and darwin enviroments. For more information on keep alive signals see . See also for a linux specific implementation. @@ -52,4 +52,5 @@ build-depends: base >=4.7 && <5 , keep-alive + , network default-language: Haskell2010 diff --git a/src/LibForeign.hsc b/src/LibForeign.hsc --- a/src/LibForeign.hsc +++ b/src/LibForeign.hsc @@ -2,22 +2,35 @@ module LibForeign where import Foreign (Ptr, alloca, peek, sizeOf, with) -import Foreign.C.Types (CInt (..)) +import Foreign.C.Types (CInt (..), CULong (..)) import Foreign.C.Error (Errno (..), getErrno) import Data.Word (Word32) -- Platform specific includes -#ifdef _WIN32 +#ifdef _WIN32 # include "CKa.h" +#elif __APPLE__ + +#include +#include +#include +#include #else #include #endif +-- All platforms --------------------------------------------------------------- +foreign import ccall unsafe "getsockopt" + c_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt + +foreign import ccall unsafe "setsockopt" + c_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt + getKeepAliveOnOff_ :: CInt -> IO CInt getKeepAliveOnOff_ fd = alloca $ \ptr -> do @@ -26,32 +39,29 @@ c_getsockopt fd c_SOL_SOCKET c_SO_KEEPALIVE ptr ptr_sz peek ptr +c_SOL_SOCKET_ = #const SOL_SOCKET + +c_SOL_SOCKET :: CInt +c_SOL_SOCKET = fromIntegral c_SOL_SOCKET_ + +c_SO_KEEPALIVE_ = #const SO_KEEPALIVE + +c_SO_KEEPALIVE :: CInt +c_SO_KEEPALIVE = fromIntegral c_SO_KEEPALIVE_ + +-- Win32 ----------------------------------------------------------------------- #ifdef _WIN32 +foreign import ccall unsafe "winSetKeepAlive" + c_winSetKeepAlive :: CInt -> CULong -> CULong -> CULong -> IO CInt + setKeepAlive_ :: CInt -> Word32 -> Word32 -> Word32 -> IO CInt setKeepAlive_ fd onoff idle intvl = c_winSetKeepAlive fd (fromIntegral onoff) (fromIntegral $ idle * 1000) (fromIntegral $ intvl * 1000) +-- posix ----------------------------------------------------------------------- #else -setKeepAlive_ :: CInt -> Word32 -> Word32 -> Word32 -> IO CInt -setKeepAlive_ fd onoff idle intvl = do - - let intOnOff = fromInteger $ toInteger onoff - let intIdle = fromInteger $ toInteger idle - let intIntvl = fromInteger $ toInteger intvl - - onoffrtn <- setKeepAliveOption_ fd c_SOL_SOCKET c_SO_KEEPALIVE intOnOff - idlertn <- setKeepAliveOption_ fd c_SOL_TCP c_TCP_KEEPIDLE intIdle - intrtn <- setKeepAliveOption_ fd c_SOL_TCP c_TCP_KEEPINTVL intIntvl - - -- Error check - Errno rtn <- - if onoffrtn + idlertn + intrtn /= 0 - then getErrno - else return $ Errno 0 - return rtn - getKeepAliveOption_ :: CInt -> CInt -> CInt -> IO Int getKeepAliveOption_ fd level option = alloca $ \ptr -> do @@ -66,51 +76,62 @@ with value $ \ptr -> c_setsockopt fd level option ptr sz +setKeepAlive_ :: CInt -> Word32 -> Word32 -> Word32 -> IO CInt +setKeepAlive_ fd onoff idle intvl = do -#endif + let intOnOff = fromInteger $ toInteger onoff + let intIdle = fromInteger $ toInteger idle + let intIntvl = fromInteger $ toInteger intvl -c_SOL_SOCKET_ = #const SOL_SOCKET + onoffrtn <- setKeepAliveOption_ fd c_SOL_SOCKET c_SO_KEEPALIVE intOnOff -c_SOL_SOCKET :: CInt -c_SOL_SOCKET = fromIntegral c_SOL_SOCKET_ +-- Apple specific kkep alive settings +#ifdef __APPLE__ + idlertn <- setKeepAliveOption_ fd c_IPPROTO_TCP c_TCP_KEEPALIVE intIdle + intrtn <- setKeepAliveOption_ fd c_IPPROTO_TCP c_TCP_KEEPINTVL intIntvl +#else + idlertn <- setKeepAliveOption_ fd c_SOL_TCP c_TCP_KEEPIDLE intIdle + intrtn <- setKeepAliveOption_ fd c_SOL_TCP c_TCP_KEEPINTVL intIntvl +-- __APPLE__ +#endif + -- Error check + Errno rtn <- + if onoffrtn + idlertn + intrtn /= 0 + then getErrno + else return $ Errno 0 + return rtn -c_SO_KEEPALIVE_ = #const SO_KEEPALIVE - -c_SO_KEEPALIVE :: CInt -c_SO_KEEPALIVE = fromIntegral c_SO_KEEPALIVE_ +c_TCP_KEEPINTVL_ = #const TCP_KEEPINTVL +c_TCP_KEEPINTVL :: CInt +c_TCP_KEEPINTVL = fromIntegral c_TCP_KEEPINTVL_ -#ifdef _WIN32 +#ifdef __APPLE__ -foreign import ccall unsafe "winSetKeepAlive" - c_winSetKeepAlive :: CInt -> CULong -> CULong -> CULong -> IO CInt +c_IPPROTO_TCP_ = #const IPPROTO_TCP +c_IPPROTO_TCP :: CInt +c_IPPROTO_TCP = fromIntegral c_IPPROTO_TCP_ +c_TCP_KEEPALIVE_ = #const TCP_KEEPALIVE +c_TCP_KEEPALIVE :: CInt +c_TCP_KEEPALIVE = fromIntegral c_TCP_KEEPALIVE_ + #else c_SOL_TCP_ = #const SOL_TCP - c_SOL_TCP :: CInt c_SOL_TCP = fromIntegral c_SOL_TCP_ c_TCP_KEEPIDLE_ = #const TCP_KEEPIDLE - c_TCP_KEEPIDLE :: CInt -c_TCP_KEEPIDLE = fromIntegral c_TCP_KEEPIDLE_ - - -c_TCP_KEEPCNT_ = #const TCP_KEEPCNT +c_TCP_KEEPIDLE = fromIntegral c_TCP_KEEPIDLE_ +c_TCP_KEEPCNT_ = #const TCP_KEEPCNT c_TCP_KEEPCNT :: CInt c_TCP_KEEPCNT = fromIntegral c_TCP_KEEPCNT_ -c_TCP_KEEPINTVL_ = #const TCP_KEEPINTVL - -c_TCP_KEEPINTVL :: CInt -c_TCP_KEEPINTVL = fromIntegral c_TCP_KEEPINTVL_ - +-- __APPLE__ Check #endif -foreign import ccall unsafe "getsockopt" - c_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt -foreign import ccall unsafe "setsockopt" - c_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt +-- End of POSIX ---------------------------------------------------------------- +#endif diff --git a/src/Network/Socket/KeepAlive.hs b/src/Network/Socket/KeepAlive.hs --- a/src/Network/Socket/KeepAlive.hs +++ b/src/Network/Socket/KeepAlive.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- + -- | --- This module allows you to set per-connection keep alive parameters on windows and linux enviroments. +-- This module allows you to set per-connection keep alive parameters on windows, linux and darwin environments. -- For more information on keep alive signals see https://en.wikipedia.org/wiki/Keepalive. -- See also https://tldp.org/HOWTO/html_single/TCP-Keepalive-HOWTO/ for a linux specific implementation. -- @@ -23,98 +24,96 @@ -- > print after -- True -- -- Please note that only the envocing process can manipulate sockets based on their file descriptors. - module Network.Socket.KeepAlive - ( KeepAlive (..) - , KeepAliveError (..) - , setKeepAlive - , getKeepAliveOnOff - ) where - -import Foreign (Word32) -import Foreign.C (CInt) -import LibForeign (getKeepAliveOnOff_, setKeepAlive_) + ( KeepAlive (..) + , KeepAliveError (..) + , setKeepAlive + , getKeepAliveOnOff + ) +where +import Foreign (Word32) +import Foreign.C (CInt) +import LibForeign (getKeepAliveOnOff_, setKeepAlive_) -- | The main data structure defining keep alive parameters data KeepAlive = KeepAlive - { kaOnOff :: Bool - -- ^ Turns on / off keep alive probes - , kaIdle :: Word32 - -- ^ The interval in seconds between the last data packet sent and the first keep alive probe - , kaIntvl :: Word32 - -- ^ The interval in seconds between subsequential keepalive probes - } - deriving (Show, Eq, Ord) + { kaOnOff :: Bool + -- ^ Turns on / off keep alive probes + , kaIdle :: Word32 + -- ^ The interval in seconds between the last data packet sent and the first keep alive probe + , kaIntvl :: Word32 + -- ^ The interval in seconds between subsequential keepalive probes + } + deriving (Show, Eq, Ord) -- | Errors starting with WSA are windows specific data KeepAliveError - = WSA_IO_PENDING - | WSA_OPERATION_ABORTED - | WSAEFAULT - | WSAEINPROGRESS - | WSAEINTR - | WSAEINVAL - | WSAENETDOWN - | WSAENOPROTOOPT - | WSAENOTSOCK - | WSAEOPNOTSUPP - | EBADF - | EDOM - | EINVAL - | EISCONN - | ENOPROTOOPT - | ENOTSOCK - | ENOMEM - | ENOBUFS - | OTHER_KEEPALIVE_ERROR CInt - deriving (Show, Eq, Ord) + = WSA_IO_PENDING + | WSA_OPERATION_ABORTED + | WSAEFAULT + | WSAEINPROGRESS + | WSAEINTR + | WSAEINVAL + | WSAENETDOWN + | WSAENOPROTOOPT + | WSAENOTSOCK + | WSAEOPNOTSUPP + | EBADF + | EDOM + | EINVAL + | EISCONN + | ENOPROTOOPT + | ENOTSOCK + | ENOMEM + | ENOBUFS + | OTHER_KEEPALIVE_ERROR CInt + deriving (Show, Eq, Ord) -- | Set keep alive parameters for the current socket setKeepAlive :: - CInt - -- ^ Socket file descriptor - -> KeepAlive - -- ^ Keep alive parameters - -> IO ( Either KeepAliveError ()) + -- | Socket file descriptor + CInt -> + -- | Keep alive parameters + KeepAlive -> + IO (Either KeepAliveError ()) setKeepAlive fd (KeepAlive onoff idle intvl) = do - rlt <- setKeepAlive_ fd (cFromBool onoff) idle intvl - return $ case rlt of - 0 -> Right () - 997 -> Left WSA_IO_PENDING - 995 -> Left WSA_OPERATION_ABORTED - 10014 -> Left WSAEFAULT - 10036 -> Left WSAEINPROGRESS - 10004 -> Left WSAEINTR - 10022 -> Left WSAEINVAL - 10050 -> Left WSAENETDOWN - 10042 -> Left WSAENOPROTOOPT - 10038 -> Left WSAENOTSOCK - 10045 -> Left WSAEOPNOTSUPP - 9 -> Left EBADF - 33 -> Left EDOM - 22 -> Left EINVAL - 106 -> Left EISCONN - 92 -> Left ENOPROTOOPT - 88 -> Left ENOTSOCK - 12 -> Left ENOMEM - 105 -> Left ENOBUFS - other -> Left $ OTHER_KEEPALIVE_ERROR other + rlt <- setKeepAlive_ fd (cFromBool onoff) idle intvl + return $ case rlt of + 0 -> Right () + 997 -> Left WSA_IO_PENDING + 995 -> Left WSA_OPERATION_ABORTED + 10014 -> Left WSAEFAULT + 10036 -> Left WSAEINPROGRESS + 10004 -> Left WSAEINTR + 10022 -> Left WSAEINVAL + 10050 -> Left WSAENETDOWN + 10042 -> Left WSAENOPROTOOPT + 10038 -> Left WSAENOTSOCK + 10045 -> Left WSAEOPNOTSUPP + 9 -> Left EBADF + 33 -> Left EDOM + 22 -> Left EINVAL + 106 -> Left EISCONN + 92 -> Left ENOPROTOOPT + 88 -> Left ENOTSOCK + 12 -> Left ENOMEM + 105 -> Left ENOBUFS + other -> Left $ OTHER_KEEPALIVE_ERROR other -- | Returns True if keep alive is active for the specified socket getKeepAliveOnOff :: - CInt - -- ^ Socket file descriptor - -> IO Bool + -- | Socket file descriptor + CInt -> + IO Bool getKeepAliveOnOff fd = - cToBool <$> getKeepAliveOnOff_ fd + cToBool <$> getKeepAliveOnOff_ fd cToBool :: CInt -> Bool cToBool x - | x == 0 = False - | otherwise = True + | x == 0 = False + | otherwise = True cFromBool :: Bool -> Word32 -cFromBool True = 1 +cFromBool True = 1 cFromBool False = 0 - diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,26 @@ +import Control.Exception (assert) +import qualified Control.Exception as E +import Data.Either (isRight) +import Network.Socket hiding (KeepAlive) +import Network.Socket.KeepAlive + main :: IO () -main = putStrLn "Test suite not yet implemented" +main = do + addr <- resolve + -- sock is a Socket type + E.bracketOnError (openSocket addr) close $ \sock -> do + withFdSocket sock $ \fd -> do + -- set keep alive on, idle 60 seconds, interval 2 seconds + _ <- assert . isRight <$> (setKeepAlive fd $ KeepAlive True 60 2) + _ <- assert <$> getKeepAliveOnOff fd + _ <- assert . isRight <$> (setKeepAlive fd $ KeepAlive False 60 2) + _ <- assert . not <$> getKeepAliveOnOff fd + return () + where + resolve = do + let hints = + defaultHints + { addrFlags = [AI_PASSIVE] + , addrSocketType = Stream + } + head <$> getAddrInfo (Just hints) (Just "localhost") Nothing