keep-alive 0.2.0.0 → 0.2.1.0
raw patch · 7 files changed
+176/−127 lines, 7 filesdep +networksetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: network
API changes (from Hackage documentation)
Files
- ChangeLog.md +6/−0
- Setup.hs +0/−2
- cbits/CKa.h +2/−2
- keep-alive.cabal +3/−2
- src/LibForeign.hsc +67/−46
- src/Network/Socket/KeepAlive.hs +73/−74
- test/Spec.hs +25/−1
ChangeLog.md view
@@ -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
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
cbits/CKa.h view
@@ -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);
keep-alive.cabal view
@@ -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 <https://en.wikipedia.org/wiki/Keepalive>. See also <https://tldp.org/HOWTO/html_single/TCP-Keepalive-HOWTO/> for a linux specific implementation. @@ -52,4 +52,5 @@ build-depends: base >=4.7 && <5 , keep-alive+ , network default-language: Haskell2010
src/LibForeign.hsc view
@@ -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 <sys/socket.h>+#include <sys/types.h>+#include <netinet/tcp.h>+#include <netinet/in.h> #else #include <netinet/tcp.h> #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
src/Network/Socket/KeepAlive.hs view
@@ -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-
test/Spec.hs view
@@ -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