New patches: [The old socket option API only supported the getting/setting of Int mrd@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 **20070722184622] [Sleep for a second before trying to connect in the net001 test Ian Lynagh **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 **20070627213703] [Fix use of autoconf HAVE_DECL_* macros. Bryan O'Sullivan **20070627213617 It turns out that the macros are always defined, unlike most others. ] [Make IPv6 address handling more portable and robust. Bryan O'Sullivan **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 **20070703082831] [Fix further build problems when IPv6 isn't available Simon Marlow **20070604105407] [Try a hopefully more portable test for RFC 3493 API compatibility. Bryan O'Sullivan **20070602050225] [Fix build failure if IPv6 is not available. Bryan O'Sullivan **20070601160943] [Fixed support for platforms with IPv6 but no AI_ADDRCONFIG Michael D. Adams **20070604153642] [--configure-option and --ghc-option are now provided by Cabal Ross Paterson **20070604115612] [Invoke the preprocessor portably. Bryan O'Sullivan **20070408171912] [Add IPv6 support to Network. Bryan O'Sullivan **20070404223751 The public API remains unchanged; it can now transparently handle IPv6 addresses and sockets. ] [Add IPv6 support to Network.Socket. Bryan O'Sullivan **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 **20070524145815] [add includes: field Simon Marlow **20070517095001] [TAG GHC 6.6.1 release Ian Lynagh **20070428195851] Patch bundle hash: 996d176d4957210dff5f3882d7e2779a6c972b78