Patch with new API for get/setsockopt

Matthew Danish mdanish at
Sat Sep 8 21:07:55 EDT 2007


Russell O'Connor pointed out the other day that it is impossible to
use the getSocketOption/setSocketOption functions on options which
expect or provide a non-Int value.

I've concocted another API which allows values to be constructed from
a specific disjoint union.  This should make it possible to use
options like SendTimeOut which expect a struct timeval.

The attached darcs patch to the network package has the new functions
setSockOpt/getSockOpt and SocketOptionValue.  Whether or not those
will be the final names, I am not sure.  Also, I thought of some
better possible interfaces, but on Ian's suggestion I stuck to
Haskell'98 capabilities only.

I've tested it on Linux/x86-64 and run the validate script.  I'm new
to GHC development, though, so I'm not sure if I should just go ahead
and submit the patch.

-- Matthew Danish -- user: mrd domain:
-- OpenPGP public key: C24B6010 on
-------------- next part --------------

New patches:

[The old socket option API only supported the getting/setting of Int
mrd at**20070909000217
 values.  This means that important options such as SendTimeout were
 incapable of being set from Haskell.  I have addressed this, while
 staying within Haskell'98, by creating a disjoint union data type
 which can represent all possible option values.  There are functions
 to pack and unpack the values into C values.
 The new entry points are getSockOpt/setSockOpt and they continue to
 use the old SocketOptions but now operate with new SocketOptionValue.
 The programmer is responsible for ensuring that the appropriate
 SocketOptionValue constructor is chosen when setting options;
 though the code does try to do some sanity checking.
] {
hunk ./Network/Socket.hsc 135
+    -- * Socket options (NEW API)
+    SocketOptionValue(..),
+    getSockOpt,          -- :: Socket -> SocketOption -> IO SocketOptionValue
+    setSockOpt,          -- :: Socket -> SocketOption -> SocketOptionValue -> IO ()
hunk ./Network/Socket.hsc 202
-import Data.Word ( Word8, Word16, Word32 )
+import Data.Word ( Word8, Word16, Word32, Word64 )
hunk ./Network/Socket.hsc 207
-import Foreign.C.Types ( CInt, CUInt, CChar, CSize )
+import Foreign.C.Types ( CInt, CUInt, CChar, CSize, CLong )
hunk ./Network/Socket.hsc 995
+    | PeerCred      {- SO_PEERCRED  -}
+    | Priority      {- SO_PRIORITY  -}
hunk ./Network/Socket.hsc 1043
+    deriving (Show, Eq)
hunk ./Network/Socket.hsc 1085
+    PeerCred      -> #const SO_PEERCRED
+    Priority      -> #const SO_PRIORITY
hunk ./Network/Socket.hsc 1142
hunk ./Network/Socket.hsc 1153
+-- New Socket Option API
+-- Checklist for adding a new option value type:
+--   * add constructor to SocketOptionValue
+--   * add sanity-check in socketOptionValueCheck
+--   * add size entry in socketOptionValueSize
+--   * add to packSocketOptionValue / unpackSocketOptionValue
+-- |
+-- The possible values that getsockopt or setsockopt may handle.
+data SocketOptionValue 
+  = OptValInt Int
+  | OptValBool Bool  -- ^ Corresponds to the C convention of non-zero == True
+  -- | pid, uid, gid
+  | OptValPeerCred Int
+                   Word32
+                   Word32
+#ifdef SO_LINGER
+  -- | on or off, linger time
+  | OptValLinger Bool
+                 Int
+#ifdef SO_RCVTIMEO 
+  -- | seconds, microseconds
+  | OptValTimeVal Int
+                  Word64
+    deriving (Show, Eq)
+-- |
+-- A list of socket options meant to be interpreted as Bool.
+booleanSocketOptions = 
+  [ Broadcast, Debug, DontRoute, KeepAlive
+  , OOBInline, ReuseAddr ]
+-- |
+-- A sanity check on socket option and option value correspondence.
+socketOptionValueCheck PeerCred (OptValPeerCred _ _ _) = True
+socketOptionValueCheck PeerCred _ = False
+#ifdef SO_LINGER
+socketOptionValueCheck Linger (OptValLinger _ _) = True
+socketOptionValueCheck Linger _ = False
+#ifdef SO_RCVTIMEO 
+socketOptionValueCheck RecvTimeOut (OptValTimeVal _ _) = True
+socketOptionValueCheck RecvTimeOut _ = False
+#ifdef SO_SNDTIMEO 
+socketOptionValueCheck SendTimeOut (OptValTimeVal _ _) = True
+socketOptionValueCheck SendTimeOut _ = False
+socketOptionValueCheck so (OptValBool _) 
+  | so `elem` booleanSocketOptions = True
+-- assume Int by default
+socketOptionValueCheck _ (OptValInt _) = True
+socketOptionValueCheck _ _ = False
+-- |
+-- Size of the associated option value in bytes.
+socketOptionValueSize PeerCred = fromIntegral (#const sizeof(struct ucred))
+#ifdef SO_LINGER
+socketOptionValueSize Linger = fromIntegral (#const sizeof(struct linger))
+#ifdef SO_RCVTIMEO 
+socketOptionValueSize RecvTimeOut = fromIntegral (#const sizeof(struct timeval))
+#ifdef SO_SNDTIMEO 
+socketOptionValueSize SendTimeOut = fromIntegral (#const sizeof(struct timeval))
+-- assume Int or Bool by default
+socketOptionValueSize _ = fromIntegral (sizeOf (undefined :: CInt))
+-- |
+-- Assemble a SocketOptionValue from a pointer to the C result.
+unpackSocketOptionValue PeerCred ptr_v = do
+  pid <- (#peek struct ucred, pid) ptr_v :: IO CInt
+  uid <- (#peek struct ucred, uid) ptr_v :: IO CUInt
+  gid <- (#peek struct ucred, gid) ptr_v :: IO CUInt
+  return $ OptValPeerCred (fromIntegral pid) (fromIntegral uid) (fromIntegral gid)
+#ifdef SO_LINGER
+unpackSocketOptionValue Linger ptr_v = do
+  onoff  <- (#peek struct linger, l_onoff) ptr_v  :: IO CInt
+  linger <- (#peek struct linger, l_linger) ptr_v :: IO CInt
+  return $ OptValLinger (onoff == 1) (fromIntegral linger)
+#ifdef SO_RCVTIMEO 
+unpackSocketOptionValue RecvTimeOut ptr_v = do
+  sec  <- (#peek struct timeval, tv_sec) ptr_v  :: IO CInt 
+  usec <- (#peek struct timeval, tv_usec) ptr_v :: IO CLong 
+  return $ OptValTimeVal (fromIntegral sec) (fromIntegral usec)
+unpackSocketOptionValue SendTimeOut ptr_v = do
+  sec  <- (#peek struct timeval, tv_sec) ptr_v  :: IO CInt 
+  usec <- (#peek struct timeval, tv_usec) ptr_v :: IO CLong 
+  return $ OptValTimeVal (fromIntegral sec) (fromIntegral usec)
+unpackSocketOptionValue so ptr_v 
+  | so `elem` booleanSocketOptions = 
+    (OptValBool . (> 0) . fromIntegral) `liftM` peek ptr_v
+-- assume Int by default
+unpackSocketOptionValue _ ptr_v = (OptValInt . fromIntegral) `liftM` peek ptr_v
+-- |
+-- Pack a SocketOptionValue into a memory region according
+-- to the C API specifications.
+packSocketOptionValue PeerCred (OptValPeerCred pid uid gid) ptr_v = do
+  (#poke struct ucred, pid) ptr_v (fromIntegral pid :: CInt)
+  (#poke struct ucred, uid) ptr_v (fromIntegral uid :: CUInt)
+  (#poke struct ucred, gid) ptr_v (fromIntegral gid :: CUInt)
+  return ()
+#ifdef SO_LINGER
+packSocketOptionValue Linger (OptValLinger onoff linger) ptr_v = do
+  (#poke struct linger, l_onoff) ptr_v (if onoff then 1 :: CInt else 0)
+  (#poke struct linger, l_linger) ptr_v (fromIntegral linger :: CInt)
+  return ()
+#ifdef SO_RCVTIMEO 
+packSocketOptionValue RecvTimeOut (OptValTimeVal sec usec) ptr_v = do
+  (#poke struct timeval, tv_sec) ptr_v (fromIntegral sec   :: CInt)
+  (#poke struct timeval, tv_usec) ptr_v (fromIntegral usec :: CInt)
+  return ()
+packSocketOptionValue SendTimeOut (OptValTimeVal sec usec) ptr_v = do
+  (#poke struct timeval, tv_sec) ptr_v (fromIntegral sec   :: CInt)
+  (#poke struct timeval, tv_usec) ptr_v (fromIntegral usec :: CLong)
+  return ()
+packSocketOptionValue so (OptValBool v) ptr_v
+  | so `elem` booleanSocketOptions = poke ptr_v (if v then 1 else 0)
+-- assume Int by default
+packSocketOptionValue _ (OptValInt v) ptr_v = poke ptr_v (fromIntegral v)
+-- |
+-- Set a socket option with a supplied SocketOptionValue.  The
+-- proper constructor must be used, or else an error will be raised.
+setSockOpt :: Socket 
+    -> SocketOption 
+    -> SocketOptionValue 
+    -> IO ()
+setSockOpt sock so v = do
+  if not (socketOptionValueCheck so v)
+    then fail 
+           $ "Failed sanity check on socket option " 
+             ++ show so ++ " and value " ++ show v
+    else return ()
+  let fd = fdSocket sock
+  let sz = socketOptionValueSize so
+  allocaBytes sz $ \ ptr_v -> do
+    packSocketOptionValue so v ptr_v
+    throwErrnoIfMinus1 "setSockOpt" $
+      c_setsockopt fd (socketOptLevel so) (packSocketOption so) ptr_v (fromIntegral sz)
+  return ()
+-- |
+-- Get a socket option and fill in the appropriate SocketOptionValue
+-- constructor with the returned value.
+getSockOpt :: Socket 
+    -> SocketOption 
+    -> IO SocketOptionValue
+getSockOpt sock so = do
+  let fd = fdSocket sock
+  let sz = socketOptionValueSize so
+  allocaBytes sz $ \ ptr_v -> do
+    with (fromIntegral sz) $ \ ptr_sz -> do
+      throwErrnoIfMinus1 "getSockOpt" $
+        c_getsockopt fd (socketOptLevel so) (packSocketOption so) ptr_v ptr_sz
+      unpackSocketOptionValue so ptr_v
+-- END new socket option API


[Follow openFd -> fdToHandle' rename
Ian Lynagh <igloo at>**20070722184622] 
[Sleep for a second before trying to connect in the net001 test
Ian Lynagh <igloo at>**20070717122449
 With just a yield, in threaded1/2 ways the client was sometimes trying
 to connect before the server was listening.
[Quieten build on OS X.
Bryan O'Sullivan <bos at>**20070627213703] 
[Fix use of autoconf HAVE_DECL_* macros.
Bryan O'Sullivan <bos at>**20070627213617
 It turns out that the macros are always defined, unlike most others.
[Make IPv6 address handling more portable and robust.
Bryan O'Sullivan <bos at>**20070627182816
 1.  No longer rely on the in6_addr structure's s6_addr32 field, which
     is not available on many platforms.  Use s6_addr instead.
 2.  Add a number of AI_* flags that are required by RFC 3493.  Not all
     of these flags are implemented on all systems, but on systems
     where they *are* implemented, we get runtime exceptions if we
     don't make them available.
 3.  To let users check whether a particular AI_* flag is implemented,
     we introduce the addrInfoFlagImplemented function.
 4.  Fix the autoconf macro used to check for AI_* flag availability.
     The previous check wasn't portable, and caused flags to appear not
     to be present when they really were.
[FIX net001 (Windows): get some calling conventions right
Simon Marlow <simonmar at>**20070703082831] 
[Fix further build problems when IPv6 isn't available
Simon Marlow <simonmar at>**20070604105407] 
[Try a hopefully more portable test for RFC 3493 API compatibility.
Bryan O'Sullivan <bos at>**20070602050225] 
[Fix build failure if IPv6 is not available.
Bryan O'Sullivan <bos at>**20070601160943] 
[Fixed support for platforms with IPv6 but no AI_ADDRCONFIG
Michael D. Adams <t-madams at>**20070604153642] 
[--configure-option and --ghc-option are now provided by Cabal
Ross Paterson <ross at>**20070604115612] 
[Invoke the preprocessor portably.
Bryan O'Sullivan <bos at>**20070408171912] 
[Add IPv6 support to Network.
Bryan O'Sullivan <bos at>**20070404223751
 The public API remains unchanged; it can now transparently handle IPv6
 addresses and sockets.
[Add IPv6 support to Network.Socket.
Bryan O'Sullivan <bos at>**20070404222036
 The only public API changes are to Network.Socket, which has the following
 exported names added (no existing names have been removed):
     -- IPv6 address components
     -- Name -> address lookup
     -- Address -> name lookup
 The SockAddr type acquires a new branch, SockAddr6.  (This could cause
 new "non-exhaustive matches" warnings when compiling pre-existing client
 code that pattern-matches on SockAddr values.  However, it will not
 cause runtime pattern failure errors in clients using the pre-existing
 IPv4 entry points, as they will never see IPv6 addresses.)
 This change moves a few type names from Network.BSD to Network.Socket:
 These names are still re-exported from Network.BSD, so pre-existing code
 should not be affected.
[Remove Makefile and (used in the old GHC build system)
Ian Lynagh <igloo at>**20070524145815] 
[add includes: field
Simon Marlow <simonmar at>**20070517095001] 
[TAG GHC 6.6.1 release
Ian Lynagh <igloo at>**20070428195851] 
Patch bundle hash:

More information about the Libraries mailing list