module Network.Socket.Options
(
getAcceptConn,
getBroadcast,
getDebug,
getDontRoute,
getError,
getKeepAlive,
getLinger,
getOOBInline,
getRecvBuf,
getRecvTimeout,
getReuseAddr,
getSendBuf,
getSendTimeout,
getType,
getTcpNoDelay,
setBroadcast,
setDebug,
setDontRoute,
setKeepAlive,
setLinger,
setOOBInline,
setRecvBuf,
setRecvTimeout,
setReuseAddr,
setSendBuf,
setSendTimeout,
setTcpNoDelay,
HasSocket(..),
Seconds,
Microseconds,
setSocketTimeouts,
#ifdef __GLASGOW_HASKELL__
setHandleTimeouts,
#endif
) where
import Data.Int (Int64)
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek)
import Network.Socket (Socket, SocketType(..), fdSocket)
import Network.Socket.Internal (throwSocketErrorIfMinus1_)
import System.Posix.Types (Fd(Fd))
#ifdef __GLASGOW_HASKELL__
import qualified GHC.IO.FD as FD
import System.IO (Handle)
#if mingw32_HOST_OS
import Data.Typeable (cast)
import GHC.IO.Handle.Internals (withHandle_)
import GHC.IO.Handle.Types (Handle__(Handle__, haDevice))
#endif
#endif
class HasSocket a where
getSocket :: a -> CInt
instance HasSocket Fd where
getSocket (Fd n) = n
instance HasSocket Socket where
getSocket = fdSocket
#ifdef __GLASGOW_HASKELL__
instance HasSocket FD.FD where
getSocket = FD.fdFD
#endif
type Seconds = Int
type Microseconds = Int64
getAcceptConn :: HasSocket sock => sock -> IO Bool
getAcceptConn = getBool 1 30
getBroadcast :: HasSocket sock => sock -> IO Bool
getBroadcast = getBool 1 6
getDebug :: HasSocket sock => sock -> IO Bool
getDebug = getBool 1 1
getDontRoute :: HasSocket sock => sock -> IO Bool
getDontRoute = getBool 1 5
getError :: HasSocket sock => sock -> IO Int
getError = getInt 1 4
getKeepAlive :: HasSocket sock => sock -> IO Bool
getKeepAlive = getBool 1 9
getLinger :: HasSocket sock => sock -> IO (Maybe Seconds)
getLinger sock =
alloca $ \l_onoff_ptr ->
alloca $ \l_linger_ptr -> do
throwSocketErrorIfMinus1_ "getsockopt" $
c_getsockopt_linger (getSocket sock) l_onoff_ptr l_linger_ptr
onoff <- peek l_onoff_ptr
if onoff /= 0
then (Just . fromIntegral) `fmap` peek l_linger_ptr
else return Nothing
getOOBInline :: HasSocket sock => sock -> IO Bool
getOOBInline = getBool 1 10
getRecvBuf :: HasSocket sock => sock -> IO Int
getRecvBuf = getInt 1 8
getRecvTimeout :: HasSocket sock => sock -> IO Microseconds
getRecvTimeout = getTime 1 20
getReuseAddr :: HasSocket sock => sock -> IO Bool
getReuseAddr = getBool 1 2
getSendBuf :: HasSocket sock => sock -> IO Int
getSendBuf = getInt 1 7
getSendTimeout :: HasSocket sock => sock -> IO Microseconds
getSendTimeout = getTime 1 21
getType :: HasSocket sock => sock -> IO SocketType
getType sock =
toSocketType `fmap` getCInt 1 3 sock
toSocketType :: CInt -> SocketType
toSocketType t = case t of
1 -> Stream
2 -> Datagram
3 -> Raw
4 -> RDM
5 -> SeqPacket
_ -> error $ "Network.Socket.Options.getType: Unknown socket type #" ++ show t
getTcpNoDelay :: HasSocket sock => sock -> IO Bool
getTcpNoDelay = getBool 6 1
setBroadcast :: HasSocket sock => sock -> Bool -> IO ()
setBroadcast = setBool 1 6
setDebug :: HasSocket sock => sock -> Bool -> IO ()
setDebug = setBool 1 1
setDontRoute :: HasSocket sock => sock -> Bool -> IO ()
setDontRoute = setBool 1 5
setKeepAlive :: HasSocket sock => sock -> Bool -> IO ()
setKeepAlive = setBool 1 9
setLinger :: HasSocket sock => sock -> Maybe Seconds -> IO ()
setLinger sock (Just linger) =
throwSocketErrorIfMinus1_ "setsockopt" $
c_setsockopt_linger (getSocket sock) 1 (fromIntegral linger)
setLinger sock Nothing =
throwSocketErrorIfMinus1_ "setsockopt" $
c_setsockopt_linger (getSocket sock) 0 0
setOOBInline :: HasSocket sock => sock -> Bool -> IO ()
setOOBInline = setBool 1 10
setRecvBuf :: HasSocket sock => sock -> Int -> IO ()
setRecvBuf = setInt 1 8
setRecvTimeout :: HasSocket sock => sock -> Microseconds -> IO ()
setRecvTimeout = setTime 1 20
setReuseAddr :: HasSocket sock => sock -> Bool -> IO ()
setReuseAddr = setBool 1 2
setSendBuf :: HasSocket sock => sock -> Int -> IO ()
setSendBuf = setInt 1 7
setSendTimeout :: HasSocket sock => sock -> Microseconds -> IO ()
setSendTimeout = setTime 1 21
setTcpNoDelay :: HasSocket sock => sock -> Bool -> IO ()
setTcpNoDelay = setBool 6 1
type SockFd = CInt
type Level = CInt
type OptName = CInt
getBool :: HasSocket sock => Level -> OptName -> sock -> IO Bool
getBool level optname sock =
(/= 0) `fmap` getCInt level optname sock
setBool :: HasSocket sock => Level -> OptName -> sock -> Bool -> IO ()
setBool level optname sock b =
setCInt level optname sock (fromIntegral $ fromEnum b)
getInt :: HasSocket sock => Level -> OptName -> sock -> IO Int
getInt level optname sock =
fromIntegral `fmap` getCInt level optname sock
setInt :: HasSocket sock => Level -> OptName -> sock -> Int -> IO ()
setInt level optname sock n =
setCInt level optname sock (fromIntegral n)
getCInt :: HasSocket sock => Level -> OptName -> sock -> IO CInt
getCInt level optname sock =
alloca $ \ptr -> do
throwSocketErrorIfMinus1_ "getsockopt" $
c_getsockopt_int (getSocket sock) level optname ptr
peek ptr
setCInt :: HasSocket sock => Level -> OptName -> sock -> CInt -> IO ()
setCInt level optname sock n =
throwSocketErrorIfMinus1_ "setsockopt" $
c_setsockopt_int (getSocket sock) level optname n
getTime :: HasSocket sock => Level -> OptName -> sock -> IO Microseconds
getTime level optname sock =
alloca $ \ptr -> do
throwSocketErrorIfMinus1_ "getsockopt" $
c_getsockopt_time (getSocket sock) level optname ptr
peek ptr
setTime :: HasSocket sock => Level -> OptName -> sock -> Microseconds -> IO ()
setTime level optname sock usec =
throwSocketErrorIfMinus1_ "setsockopt" $
c_setsockopt_time (getSocket sock) level optname usec
foreign import ccall
c_getsockopt_int :: SockFd -> Level -> OptName -> Ptr CInt -> IO CInt
foreign import ccall
c_setsockopt_int :: SockFd -> Level -> OptName -> CInt -> IO CInt
foreign import ccall
c_getsockopt_time :: SockFd -> Level -> OptName -> Ptr Int64 -> IO CInt
foreign import ccall
c_setsockopt_time :: SockFd -> Level -> OptName -> Int64 -> IO CInt
foreign import ccall
c_getsockopt_linger :: SockFd
-> Ptr CInt
-> Ptr CInt
-> IO CInt
foreign import ccall
c_setsockopt_linger :: SockFd
-> CInt
-> CInt
-> IO CInt
setSocketTimeouts
:: HasSocket sock
=> sock
-> Microseconds
-> Microseconds
-> IO ()
#if mingw32_HOST_OS
setSocketTimeouts sock recv_usec send_usec = do
setRecvTimeout sock recv_usec
setSendTimeout sock send_usec
#else
setSocketTimeouts _ _ _ = return ()
#endif
#ifdef __GLASGOW_HASKELL__
setHandleTimeouts
:: Handle
-> Microseconds
-> Microseconds
-> IO ()
#if mingw32_HOST_OS
setHandleTimeouts h recv_usec send_usec =
withHandle_ "setHandleTimeouts" h $ \Handle__{haDevice = dev} ->
case cast dev of
Just fd | FD.fdIsSocket_ fd /= 0 -> do
setRecvTimeout fd recv_usec
setSendTimeout fd send_usec
_ -> return ()
#else
setHandleTimeouts _ _ _ = return ()
#endif
#endif