Patch with new API for get/setsockopt
Matthew Danish
mdanish at andrew.cmu.edu
Sat Sep 8 21:07:55 EDT 2007
Hi,
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: cmu.edu
-- OpenPGP public key: C24B6010 on keyring.debian.org
-------------- next part --------------
New patches:
[The old socket option API only supported the getting/setting of Int
mrd at debian.org**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
+#ifdef SO_PEERCRED
+ | PeerCred {- SO_PEERCRED -}
+#endif
+#ifdef SO_PRIORITY
+ | Priority {- SO_PRIORITY -}
+#endif
hunk ./Network/Socket.hsc 1043
+ deriving (Show, Eq)
hunk ./Network/Socket.hsc 1085
+#ifdef SO_PEERCRED
+ PeerCred -> #const SO_PEERCRED
+#endif
+#ifdef SO_PRIORITY
+ Priority -> #const SO_PRIORITY
+#endif
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
+#ifdef SO_PEERCRED
+ -- | pid, uid, gid
+ | OptValPeerCred Int
+ Word32
+ Word32
+#endif
+#ifdef SO_LINGER
+ -- | on or off, linger time
+ | OptValLinger Bool
+ Int
+#endif
+#ifdef SO_RCVTIMEO
+ -- | seconds, microseconds
+ | OptValTimeVal Int
+ Word64
+#endif
+ 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.
+#ifdef SO_PEERCRED
+socketOptionValueCheck PeerCred (OptValPeerCred _ _ _) = True
+socketOptionValueCheck PeerCred _ = False
+#endif
+#ifdef SO_LINGER
+socketOptionValueCheck Linger (OptValLinger _ _) = True
+socketOptionValueCheck Linger _ = False
+#endif
+#ifdef SO_RCVTIMEO
+socketOptionValueCheck RecvTimeOut (OptValTimeVal _ _) = True
+socketOptionValueCheck RecvTimeOut _ = False
+#endif
+#ifdef SO_SNDTIMEO
+socketOptionValueCheck SendTimeOut (OptValTimeVal _ _) = True
+socketOptionValueCheck SendTimeOut _ = False
+#endif
+socketOptionValueCheck so (OptValBool _)
+ | so `elem` booleanSocketOptions = True
+-- assume Int by default
+socketOptionValueCheck _ (OptValInt _) = True
+socketOptionValueCheck _ _ = False
+
+-- |
+-- Size of the associated option value in bytes.
+#ifdef SO_PEERCRED
+socketOptionValueSize PeerCred = fromIntegral (#const sizeof(struct ucred))
+#endif
+#ifdef SO_LINGER
+socketOptionValueSize Linger = fromIntegral (#const sizeof(struct linger))
+#endif
+#ifdef SO_RCVTIMEO
+socketOptionValueSize RecvTimeOut = fromIntegral (#const sizeof(struct timeval))
+#endif
+#ifdef SO_SNDTIMEO
+socketOptionValueSize SendTimeOut = fromIntegral (#const sizeof(struct timeval))
+#endif
+-- assume Int or Bool by default
+socketOptionValueSize _ = fromIntegral (sizeOf (undefined :: CInt))
+
+-- |
+-- Assemble a SocketOptionValue from a pointer to the C result.
+#ifdef SO_PEERCRED
+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)
+#endif
+#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)
+#endif
+#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)
+#endif
+#ifdef SO_SNDTIMEO
+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)
+#endif
+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.
+#ifdef SO_PEERCRED
+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 ()
+#endif
+#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 ()
+#endif
+#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 ()
+#endif
+#ifdef SO_SNDTIMEO
+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 ()
+#endif
+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
+
}
Context:
[Follow openFd -> fdToHandle' rename
Ian Lynagh <igloo at earth.li>**20070722184622]
[Sleep for a second before trying to connect in the net001 test
Ian Lynagh <igloo at earth.li>**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 serpentine.com>**20070627213703]
[Fix use of autoconf HAVE_DECL_* macros.
Bryan O'Sullivan <bos at serpentine.com>**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 serpentine.com>**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 microsoft.com>**20070703082831]
[Fix further build problems when IPv6 isn't available
Simon Marlow <simonmar at microsoft.com>**20070604105407]
[Try a hopefully more portable test for RFC 3493 API compatibility.
Bryan O'Sullivan <bos at serpentine.com>**20070602050225]
[Fix build failure if IPv6 is not available.
Bryan O'Sullivan <bos at serpentine.com>**20070601160943]
[Fixed support for platforms with IPv6 but no AI_ADDRCONFIG
Michael D. Adams <t-madams at microsoft.com>**20070604153642]
[--configure-option and --ghc-option are now provided by Cabal
Ross Paterson <ross at soi.city.ac.uk>**20070604115612]
[Invoke the preprocessor portably.
Bryan O'Sullivan <bos at serpentine.com>**20070408171912]
[Add IPv6 support to Network.
Bryan O'Sullivan <bos at serpentine.com>**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 serpentine.com>**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
HostAddress6
FlowInfo
ScopeID
-- Name -> address lookup
getAddrInfo
AddrInfo
AddrInfoFlag
defaultHints
-- Address -> name lookup
getNameInfo
NameInfoFlag
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:
HostName
ServiceName
These names are still re-exported from Network.BSD, so pre-existing code
should not be affected.
]
[Remove Makefile and package.conf.in (used in the old GHC build system)
Ian Lynagh <igloo at earth.li>**20070524145815]
[add includes: field
Simon Marlow <simonmar at microsoft.com>**20070517095001]
[TAG GHC 6.6.1 release
Ian Lynagh <igloo at earth.li>**20070428195851]
Patch bundle hash:
996d176d4957210dff5f3882d7e2779a6c972b78
More information about the Libraries
mailing list