diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,20 @@ -## Version 2.6.3.6 - * Removed unnecessary withMVar, which caused locking on close. - [#330](https://github.com/haskell/network/pull/330) +## Version 2.7.0.0 + * Obsoleting the Network module. + * Obsoleting the Network.BSD module. + * Obsoleting APIs: MkSocket, htonl, ntohl, + getPeerCred, getPeerEid, + send, sendTo, recv, recvFrom, recvLen, + inet_addr, inet_ntoa, + isConnected, isBound, isListening, isReadable, isWritable, + aNY_PORT, iNADDR_ANY, iN6ADDR_ANY, sOMAXCONN, + sOL_SOCKET, sCM_RIGHTS, + packFamily, unpackFamily, packSocketType + * Do not closeFd within sendFd + [#271](https://github.com/haskell/network/pull/271) + * Exporting ifNameToIndex and ifIndexToName from Network.Socket. + * New APIs: setCloseOnExecIfNeeded, getCloseOnExec and getNonBlock + * New APIs: isUnixDomainSocketAvailable and getPeerCredential + * socketPair, sendFd and recvFd are exported even on Windows. ## Version 2.6.3.5 * Reverting "Do not closeFd within sendFd" diff --git a/Network.hs b/Network.hs --- a/Network.hs +++ b/Network.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Network @@ -25,7 +26,7 @@ #define IPV6_SOCKET_SUPPORT 1 #endif -module Network +module Network {-# DEPRECATED "The high level Network interface is no longer supported. Please use Network.Socket." #-} ( -- * Basic data types Socket diff --git a/Network/BSD.hsc b/Network/BSD.hsc --- a/Network/BSD.hsc +++ b/Network/BSD.hsc @@ -1,4 +1,6 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Network.BSD @@ -16,7 +18,7 @@ #include "HsNet.h" -module Network.BSD +module Network.BSD {-# DEPRECATED "This platform dependent module is no longer supported." #-} ( -- * Host names HostName @@ -102,7 +104,7 @@ #if defined(HAVE_WINSOCK2_H) import Foreign.C.Types ( CShort ) #endif -import Foreign.C.Types ( CInt(..), CUInt(..), CULong(..), CSize(..) ) +import Foreign.C.Types ( CInt(..), CULong(..), CSize(..) ) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (Storable(..)) import Foreign.Marshal.Array (allocaArray0, peekArray0) @@ -512,24 +514,6 @@ setNetworkEntry stayOpen getEntries (getNetworkEntry) (endNetworkEntry) #endif - --- --------------------------------------------------------------------------- --- Interface names - -#if defined(HAVE_IF_NAMETOINDEX) - --- returns the index of the network interface corresponding to the name ifname. -ifNameToIndex :: String -> IO (Maybe Int) -ifNameToIndex ifname = do - index <- withCString ifname c_if_nametoindex - -- On failure zero is returned. We'll return Nothing. - return $ if index == 0 then Nothing else Just $ fromIntegral index - -foreign import CALLCONV safe "if_nametoindex" - c_if_nametoindex :: CString -> IO CUInt - -#endif - -- Mutex for name service lockdown diff --git a/Network/Socket.hsc b/Network/Socket.hsc --- a/Network/Socket.hsc +++ b/Network/Socket.hsc @@ -1,5 +1,6 @@ {-# LANGUAGE CPP, ScopedTypeVariables, RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Network.Socket @@ -10,13 +11,9 @@ -- Stability : provisional -- Portability : portable -- --- The "Network.Socket" module is for when you want full control over --- sockets. Essentially the entire C socket API is exposed through --- this module; in general the operations follow the behaviour of the C --- functions of the same name (consult your favourite Unix networking book). --- --- A higher level interface to networking operations is provided --- through the module "Network". +-- This is the main module of the network package supposed to be +-- used with either "Network.Socket.ByteString" or +-- "Network.Socket.ByteString.Lazy" for sending/receiving. -- -- Here are two minimal example programs using the TCP/IP protocol: a -- server that echoes all data that it receives back (servicing only @@ -48,6 +45,10 @@ -- > sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) -- > setSocketOption sock ReuseAddr 1 -- > bind sock (addrAddress addr) +-- > -- If the prefork technique is not used, +-- > -- set CloseOnExec for the security reasons. +-- > let fd = fdSocket sock +-- > setCloseOnExecIfNeeded fd -- > listen sock 10 -- > return sock -- > loop sock = forever $ do @@ -95,121 +96,125 @@ module Network.Socket ( - -- * Types - Socket(..) - , Family(..) - , isSupportedFamily + -- * Initialisation + withSocketsDo + -- * Address information + , getAddrInfo + -- ** Types + , HostName + , ServiceName + , AddrInfo(..) + , defaultHints + -- ** Flags + , AddrInfoFlag(..) + , addrInfoFlagImplemented + -- * Socket operations + , connect + , bind + , listen + , accept + -- ** Closing + , close + , shutdown + , ShutdownCmd(..) + -- * Socket options + , SocketOption(..) + , isSupportedSocketOption + , getSocketOption + , setSocketOption + -- * Socket + , Socket(..) + , socket + , fdSocket + , mkSocket + , socketToHandle + -- ** Types of Socket , SocketType(..) , isSupportedSocketType + -- ** Family + , Family(..) + , isSupportedFamily + -- ** Protocol number + , ProtocolNumber + , defaultProtocol + -- * Socket address , SockAddr(..) , isSupportedSockAddr - , SocketStatus(..) + , getPeerName + , getSocketName + -- ** Host address , HostAddress , hostAddressToTuple , tupleToHostAddress #if defined(IPV6_SOCKET_SUPPORT) + -- ** Host address6 , HostAddress6 , hostAddress6ToTuple , tupleToHostAddress6 + -- ** Flow Info , FlowInfo + -- ** Scope ID , ScopeID +# if defined(HAVE_IF_NAMETOINDEX) + , ifNameToIndex + , ifIndexToName +# endif #endif - , htonl - , ntohl - , ShutdownCmd(..) - , ProtocolNumber - , defaultProtocol + -- ** Port number , PortNumber(..) - -- PortNumber is used non-abstractly in Network.BSD. ToDo: remove - -- this use and make the type abstract. - - -- * Address operations - - , HostName - , ServiceName - + , defaultPort + , socketPort + -- * UNIX-domain socket + , isUnixDomainSocketAvailable + , socketPair + , sendFd + , recvFd + , getPeerCredential #if defined(IPV6_SOCKET_SUPPORT) - , AddrInfo(..) - - , AddrInfoFlag(..) - , addrInfoFlagImplemented - - , defaultHints - - , getAddrInfo - + -- * Name information , NameInfoFlag(..) - , getNameInfo #endif - - -- * Socket operations - , socket -#if defined(DOMAIN_SOCKET_SUPPORT) - , socketPair -#endif - , connect - , bind - , listen - , accept - , getPeerName - , getSocketName - -#if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID) - -- get the credentials of our domain socket peer. - , getPeerCred -#if defined(HAVE_GETPEEREID) - , getPeerEid -#endif -#endif - - , socketPort - - , socketToHandle - - -- ** Sending and receiving data - -- *** Sending and receiving with String - -- $sendrecv + -- * Low level operations + , setCloseOnExecIfNeeded + , getCloseOnExec + , setNonBlockIfNeeded + , getNonBlock + -- * Sending and receiving data + , sendBuf + , recvBuf + , sendBufTo + , recvBufFrom + -- * Special constants + , maxListenQueue + -- * Deprecated + -- ** Deprecated sending and receiving , send , sendTo , recv , recvFrom , recvLen - - -- *** Sending and receiving with a buffer - , sendBuf - , recvBuf - , sendBufTo - , recvBufFrom - - -- ** Misc + -- ** Deprecated address functions + , htonl + , ntohl , inet_addr , inet_ntoa - - , shutdown - , close - - -- ** Predicates on sockets + -- ** Deprecated socket operations + , bindSocket + , sClose + -- ** Deprecated socket status + , SocketStatus(..) -- fixme , isConnected , isBound , isListening , isReadable , isWritable - - -- * Socket options - , SocketOption(..) - , isSupportedSocketOption - , getSocketOption - , setSocketOption - - -- * File descriptor transmission -#ifdef DOMAIN_SOCKET_SUPPORT - , sendFd - , recvFd - -#endif - - -- * Special constants + , sIsConnected + , sIsBound + , sIsListening + , sIsReadable + , sIsWritable + -- ** Deprecated special constants , aNY_PORT , iNADDR_ANY #if defined(IPV6_SOCKET_SUPPORT) @@ -220,35 +225,18 @@ #ifdef SCM_RIGHTS , sCM_RIGHTS #endif - , maxListenQueue - - -- * Initialisation - , withSocketsDo - - -- * Very low level operations - -- in case you ever want to get at the underlying file descriptor.. - , fdSocket - , mkSocket - , setNonBlockIfNeeded - - -- * Deprecated aliases - -- $deprecated-aliases - , bindSocket - , sClose - , sIsConnected - , sIsBound - , sIsListening - , sIsReadable - , sIsWritable - - -- * Internal - - -- | The following are exported ONLY for use in the BSD module and - -- should not be used anywhere else. - + -- ** Decrecated internal functions , packFamily , unpackFamily , packSocketType + -- ** Decrecated UNIX-domain functions +#if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID) + -- get the credentials of our domain socket peer. + , getPeerCred +#if defined(HAVE_GETPEEREID) + , getPeerEid +#endif +#endif ) where import Data.Bits @@ -260,7 +248,7 @@ import Foreign.Storable (Storable(..)) import Foreign.C.Error import Foreign.C.String (CString, withCString, withCStringLen, peekCString, peekCStringLen) -import Foreign.C.Types (CUInt, CChar) +import Foreign.C.Types (CUInt(..), CChar) import Foreign.C.Types (CInt(..), CSize(..)) import Foreign.Marshal.Alloc ( alloca, allocaBytes ) import Foreign.Marshal.Array ( peekArray ) @@ -269,6 +257,7 @@ import System.IO import Control.Monad (liftM, when) +import qualified Control.Exception as E import Control.Concurrent.MVar import Data.Typeable import System.IO.Error @@ -281,7 +270,6 @@ import GHC.Conc (closeFdWith) ##endif # if defined(mingw32_HOST_OS) -import qualified Control.Exception as E import GHC.Conc (asyncDoProc) import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr) import Foreign (FunPtr) @@ -350,6 +338,7 @@ withSocketsDo $ return () return $ MkSocket fd fam sType pNum mStat +-- | Obtaining the file descriptor from a socket. fdSocket :: Socket -> CInt fdSocket (MkSocket fd _ _ _ _) = fd @@ -405,11 +394,7 @@ -- -- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream } -- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "5000") --- >>> sock@(MkSocket _ fam stype _ _) <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) --- >>> fam --- AF_INET --- >>> stype --- Stream +-- >>> sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) -- >>> bind sock (addrAddress addr) -- >>> getSocketName sock -- 127.0.0.1:5000 @@ -442,11 +427,11 @@ -- family, socket type, and protocol number. Address family, socket -- type, and protocol number are as for the 'socket' function above. -- Availability: Unix. -#if defined(DOMAIN_SOCKET_SUPPORT) socketPair :: Family -- Family Name (usually AF_INET or AF_INET6) -> SocketType -- Socket Type (usually Stream) -> ProtocolNumber -- Protocol Number -> IO (Socket, Socket) -- unnamed and connected. +#if defined(DOMAIN_SOCKET_SUPPORT) socketPair family stype protocol = do allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do c_stype <- packSocketTypeOrThrow "socketPair" stype @@ -463,23 +448,87 @@ foreign import ccall unsafe "socketpair" c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt +#else +socketPair _ _ _ = error "Network.Socket.socketPair" #endif --- | Set the socket to nonblocking, if applicable to this platform. --- --- Depending on the platform this is required when using sockets from file --- descriptors that are passed in through 'recvFd' or other means. +----------------------------------------------------------------------------- + +#if defined(mingw32_HOST_OS) +#else +fGetFd :: CInt +fGetFd = #const F_GETFD +fGetFl :: CInt +fGetFl = #const F_GETFL +fdCloexec :: CInt +fdCloexec = #const FD_CLOEXEC +oNonBlock :: CInt +oNonBlock = #const O_NONBLOCK +# if defined(HAVE_ACCEPT4) +sockNonBlock :: CInt +sockNonBlock = #const SOCK_NONBLOCK +sockCloexec :: CInt +sockCloexec = #const SOCK_CLOEXEC +# endif +#endif + +-- | Set the nonblocking flag on Unix. +-- On Windows, nothing is done. setNonBlockIfNeeded :: CInt -> IO () setNonBlockIfNeeded fd = System.Posix.Internals.setNonBlockingFD fd True +-- | Set the close_on_exec flag on Unix. +-- On Windows, nothing is done. +-- +-- Since 2.7.0.0. +setCloseOnExecIfNeeded :: CInt -> IO () +#if defined(mingw32_HOST_OS) +setCloseOnExecIfNeeded _ = return () +#else +setCloseOnExecIfNeeded fd = System.Posix.Internals.setCloseOnExec fd +#endif + +#if !defined(mingw32_HOST_OS) +foreign import ccall unsafe "fcntl" + c_fcntl_read :: CInt -> CInt -> CInt -> IO CInt +#endif + +-- | Get the nonblocking flag. +-- On Windows, this function always returns 'False'. +-- +-- Since 2.7.0.0. +getCloseOnExec :: CInt -> IO Bool +#if defined(mingw32_HOST_OS) +getCloseOnExec _ = return False +#else +getCloseOnExec fd = do + flags <- c_fcntl_read fd fGetFd 0 + let ret = flags .&. fdCloexec + return (ret /= 0) +#endif + +-- | Get the close_on_exec flag. +-- On Windows, this function always returns 'False'. +-- +-- Since 2.7.0.0. +getNonBlock :: CInt -> IO Bool +#if defined(mingw32_HOST_OS) +getNonBlock _ = return False +#else +getNonBlock fd = do + flags <- c_fcntl_read fd fGetFl 0 + let ret = flags .&. oNonBlock + return (ret /= 0) +#endif + ----------------------------------------------------------------------------- -- Binding a socket -- | Bind the socket to an address. The socket must not already be -- bound. The 'Family' passed to @bind@ must be the -- same as that passed to 'socket'. If the special port number --- 'aNY_PORT' is passed then the system assigns the next available +-- 'defaultPort' is passed then the system assigns the next available -- use port. bind :: Socket -- Unconnected Socket -> SockAddr -- Address to Bind to @@ -578,8 +627,7 @@ -> IO (Socket, -- Readable Socket SockAddr) -- Peer details -accept sock@(MkSocket s family stype protocol status) = do - currentStatus <- readMVar status +accept sock@(MkSocket s family stype protocol status) = withMVar status $ \currentStatus -> do if not $ isAcceptable family stype currentStatus then ioError $ userError $ @@ -608,11 +656,12 @@ # ifdef HAVE_ACCEPT4 new_sock <- throwSocketErrorIfMinus1RetryMayBlock "Network.Socket.accept" (threadWaitRead (fromIntegral s)) - (c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK)) + (c_accept4 s sockaddr ptr_len (sockNonBlock .|. sockCloexec)) # else new_sock <- throwSocketErrorWaitRead sock "Network.Socket.accept" (c_accept s sockaddr ptr_len) setNonBlockIfNeeded new_sock + setCloseOnExecIfNeeded new_sock # endif /* HAVE_ACCEPT4 */ #endif addr <- peekSockAddr sockaddr @@ -651,7 +700,7 @@ -- -- NOTE: blocking on Windows unless you compile with -threaded (see -- GHC ticket #1129) -{-# WARNING sendTo "Use sendTo defined in \"Network.Socket.ByteString\"" #-} +{-# DEPRECATED sendTo "Use sendTo defined in \"Network.Socket.ByteString\"" #-} sendTo :: Socket -- (possibly) bound/connected Socket -> String -- Data to send -> SockAddr @@ -683,7 +732,7 @@ -- -- NOTE: blocking on Windows unless you compile with -threaded (see -- GHC ticket #1129) -{-# WARNING recvFrom "Use recvFrom defined in \"Network.Socket.ByteString\"" #-} +{-# DEPRECATED recvFrom "Use recvFrom defined in \"Network.Socket.ByteString\"" #-} recvFrom :: Socket -> Int -> IO (String, Int, SockAddr) recvFrom sock nbytes = allocaBytes nbytes $ \ptr -> do @@ -732,7 +781,7 @@ -- responsible for ensuring that all data has been sent. -- -- Sending data to closed socket may lead to undefined behaviour. -{-# WARNING send "Use send defined in \"Network.Socket.ByteString\"" #-} +{-# DEPRECATED send "Use send defined in \"Network.Socket.ByteString\"" #-} send :: Socket -- Bound/Connected Socket -> String -- Data to send -> IO Int -- Number of Bytes sent @@ -780,11 +829,11 @@ -- closed its half side of the connection. -- -- Receiving data from closed socket may lead to undefined behaviour. -{-# WARNING recv "Use recv defined in \"Network.Socket.ByteString\"" #-} +{-# DEPRECATED recv "Use recv defined in \"Network.Socket.ByteString\"" #-} recv :: Socket -> Int -> IO String recv sock l = fst <$> recvLen sock l -{-# WARNING recvLen "Use recv defined in \"Network.Socket.ByteString\" with \"Data.Bytestring.length\"" #-} +{-# DEPRECATED recvLen "Use recv defined in \"Network.Socket.ByteString\" with \"Data.Bytestring.length\"" #-} recvLen :: Socket -> Int -> IO (String, Int) recvLen sock nbytes = allocaBytes nbytes $ \ptr -> do @@ -1046,7 +1095,36 @@ fromIntegral `liftM` peek ptr_v +-- | Getting process ID, user ID and group ID for UNIX-domain sockets. +-- +-- This is implemented with SO_PEERCRED on Linux and getpeereid() +-- on BSD variants. Unfortunately, on some BSD variants +-- getpeereid() returns unexpected results, rather than an error, +-- for AF_INET sockets. It is the user's responsibility to make sure +-- that the socket is a UNIX-domain socket. +-- Also, on some BSD variants, getpeereid() does not return credentials +-- for sockets created via 'socketPair', only separately created and then +-- explicitly connected UNIX-domain sockets work on such systems. +-- +-- Since 2.7.0.0. +getPeerCredential :: Socket -> IO (Maybe CUInt, Maybe CUInt, Maybe CUInt) +#ifdef HAVE_STRUCT_UCRED +getPeerCredential sock = do + (pid, uid, gid) <- getPeerCred sock + if uid == maxBound then + return (Nothing, Nothing, Nothing) + else + return (Just pid, Just uid, Just gid) +#elif defined(HAVE_GETPEEREID) +getPeerCredential sock = E.handle (\(E.SomeException _) -> return (Nothing,Nothing,Nothing)) $ do + (uid, gid) <- getPeerEid sock + return (Nothing, Just uid, Just gid) +#else +getPeerCredential _ = return (Nothing, Nothing, Nothing) +#endif + #if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID) +{-# DEPRECATED getPeerCred "Use getPeerCredential instead" #-} -- | Returns the processID, userID and groupID of the socket's peer. -- -- Only available on platforms that support SO_PEERCRED or GETPEEREID(3) @@ -1071,6 +1149,7 @@ #endif #ifdef HAVE_GETPEEREID +{-# DEPRECATED getPeerEid "Use getPeerCredential instead" #-} -- | The getpeereid() function returns the effective user and group IDs of the -- peer connected to a UNIX-domain socket getPeerEid :: Socket -> IO (CUInt, CUInt) @@ -1086,43 +1165,59 @@ #endif #endif +-- | Whether or not UNIX-domain sockets are available. +-- +-- Since 3.0.0.0. +isUnixDomainSocketAvailable :: Bool +#if defined(DOMAIN_SOCKET_SUPPORT) +isUnixDomainSocketAvailable = True +#else +isUnixDomainSocketAvailable = False +#endif + ##if !(MIN_VERSION_base(4,3,1)) closeFdWith closer fd = closer fd ##endif -#if defined(DOMAIN_SOCKET_SUPPORT) -- sending/receiving ancillary socket data; low-level mechanism -- for transmitting file descriptors, mainly. sendFd :: Socket -> CInt -> IO () +#if defined(DOMAIN_SOCKET_SUPPORT) sendFd sock outfd = do - _ <- ($) throwSocketErrorWaitWrite sock "Network.Socket.sendFd" $ - c_sendFd (fdSocket sock) outfd - -- Note: If Winsock supported FD-passing, thi would have been - -- incorrect (since socket FDs need to be closed via closesocket().) - closeFd outfd + _ <- throwSocketErrorWaitWrite sock "Network.Socket.sendFd" $ c_sendFd (fdSocket sock) outfd + return () +foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt +#else +sendFd _ _ = error "Network.Socket.sendFd" +#endif -- | Receive a file descriptor over a domain socket. Note that the resulting -- file descriptor may have to be put into non-blocking mode in order to be -- used safely. See 'setNonBlockIfNeeded'. recvFd :: Socket -> IO CInt +#if defined(DOMAIN_SOCKET_SUPPORT) recvFd sock = do theFd <- throwSocketErrorWaitRead sock "Network.Socket.recvFd" $ c_recvFd (fdSocket sock) return theFd - -foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt - +#else +recvFd _ = error "Network.Socket.recvFd" #endif -- --------------------------------------------------------------------------- -- Utility Functions +{-# DEPRECATED aNY_PORT "Use defaultPort instead" #-} aNY_PORT :: PortNumber aNY_PORT = 0 +defaultPort :: PortNumber +defaultPort = 0 + -- | The IPv4 wild card address. +{-# DEPRECATED iNADDR_ANY "Use getAddrInfo instead" #-} iNADDR_ANY :: HostAddress iNADDR_ANY = htonl (#const INADDR_ANY) @@ -1131,20 +1226,27 @@ -- | Converts the from network byte order to host byte order. foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32 +{-# DEPRECATED htonl "Use getAddrInfo instead" #-} +{-# DEPRECATED ntohl "Use getAddrInfo instead" #-} + #if defined(IPV6_SOCKET_SUPPORT) -- | The IPv6 wild card address. +{-# DEPRECATED iN6ADDR_ANY "Use getAddrInfo instead" #-} iN6ADDR_ANY :: HostAddress6 iN6ADDR_ANY = (0, 0, 0, 0) #endif +{-# DEPRECATED sOMAXCONN "Use maxListenQueue instead" #-} sOMAXCONN :: Int sOMAXCONN = #const SOMAXCONN +{-# DEPRECATED sOL_SOCKET "This is not necessary anymore" #-} sOL_SOCKET :: Int sOL_SOCKET = #const SOL_SOCKET #ifdef SCM_RIGHTS +{-# DEPRECATED sCM_RIGHTS "This is not necessary anymore" #-} sCM_RIGHTS :: Int sCM_RIGHTS = #const SCM_RIGHTS #endif @@ -1203,6 +1305,7 @@ isConnected (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Connected) +{-# DEPRECATED isConnected "SocketStatus will be removed" #-} -- ----------------------------------------------------------------------------- -- Socket Predicates @@ -1211,19 +1314,23 @@ isBound (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Bound) +{-# DEPRECATED isBound "SocketStatus will be removed" #-} isListening :: Socket -> IO Bool isListening (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening) +{-# DEPRECATED isListening "SocketStatus will be removed" #-} isReadable :: Socket -> IO Bool isReadable (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening || value == Connected) +{-# DEPRECATED isReadable "SocketStatus will be removed" #-} isWritable :: Socket -> IO Bool isWritable = isReadable -- sort of. +{-# DEPRECATED isWritable "SocketStatus will be removed" #-} isAcceptable :: Family -> SocketType -> SocketStatus -> Bool #if defined(DOMAIN_SOCKET_SUPPORT) @@ -1233,10 +1340,12 @@ isAcceptable AF_UNIX _ _ = False #endif isAcceptable _ _ status = status == Connected || status == Listening +{-# DEPRECATED isAcceptable "SocketStatus will be removed" #-} -- ----------------------------------------------------------------------------- -- Internet address manipulation routines: +{-# DEPRECATED inet_addr "Use \"getNameInfo\" instead" #-} inet_addr :: String -> IO HostAddress inet_addr ipstr = withSocketsDo $ do withCString ipstr $ \str -> do @@ -1246,6 +1355,7 @@ "Network.Socket.inet_addr: Malformed address: " ++ ipstr else return had -- network byte order +{-# DEPRECATED inet_ntoa "Use \"getNameInfo\" instead" #-} inet_ntoa :: HostAddress -> IO String inet_ntoa haddr = withSocketsDo $ do pstr <- c_inet_ntoa haddr @@ -1323,8 +1433,8 @@ | AI_NUMERICSERV -- | If no 'HostName' value is provided, the network -- address in each 'SockAddr' - -- will be left as a "wild card", i.e. as either 'iNADDR_ANY' - -- or 'iN6ADDR_ANY'. This is useful for server applications that + -- will be left as a "wild card". + -- This is useful for server applications that -- will accept connections from any client. | AI_PASSIVE -- | If an IPv6 lookup is performed, and no IPv6 @@ -1758,32 +1868,55 @@ sClose :: Socket -> IO () sClose = close -{-# DEPRECATED sIsConnected "use 'isConnected'" #-} +{-# DEPRECATED sIsConnected "SocketStatus will be removed" #-} --- | Deprecated alias for 'isConnected'. sIsConnected :: Socket -> IO Bool sIsConnected = isConnected -{-# DEPRECATED sIsBound "use 'isBound'" #-} +{-# DEPRECATED sIsBound "SocketStatus will be removed" #-} --- | Deprecated alias for 'isBound'. sIsBound :: Socket -> IO Bool sIsBound = isBound -{-# DEPRECATED sIsListening "use 'isListening'" #-} +{-# DEPRECATED sIsListening "SocketStatus will be removed" #-} --- | Deprecated alias for 'isListening'. sIsListening :: Socket -> IO Bool sIsListening = isListening -{-# DEPRECATED sIsReadable "use 'isReadable'" #-} +{-# DEPRECATED sIsReadable "SocketStatus will be removed" #-} --- | Deprecated alias for 'isReadable'. sIsReadable :: Socket -> IO Bool sIsReadable = isReadable -{-# DEPRECATED sIsWritable "use 'isWritable'" #-} +{-# DEPRECATED sIsWritable "SocketStatus will be removed" #-} --- | Deprecated alias for 'isWritable'. sIsWritable :: Socket -> IO Bool sIsWritable = isWritable + +#if defined(HAVE_IF_NAMETOINDEX) +-- | Returns the index corresponding to the interface name. +-- +-- Since 2.7.0.0. +ifNameToIndex :: String -> IO (Maybe Int) +ifNameToIndex ifname = do + index <- withCString ifname c_if_nametoindex + -- On failure zero is returned. We'll return Nothing. + return $ if index == 0 then Nothing else Just $ fromIntegral index + +-- | Returns the interface name corresponding to the index. +-- +-- Since 2.7.0.0. +ifIndexToName :: Int -> IO (Maybe String) +ifIndexToName ifn = allocaBytes 16 $ \ptr -> do -- 16 == IFNAMSIZ + r <- c_if_indextoname (fromIntegral ifn) ptr + if r == nullPtr then + return Nothing + else + Just <$> peekCString ptr + +foreign import CALLCONV safe "if_nametoindex" + c_if_nametoindex :: CString -> IO CUInt + +foreign import CALLCONV safe "if_indextoname" + c_if_indextoname :: CUInt -> CString -> IO CString +#endif diff --git a/Network/Socket/ByteString.hsc b/Network/Socket/ByteString.hsc --- a/Network/Socket/ByteString.hsc +++ b/Network/Socket/ByteString.hsc @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE CPP, ForeignFunctionInterface #-} #include "HsNet.h" @@ -263,7 +264,7 @@ -- | @withIOVec cs f@ executes the computation @f@, passing as argument a pair -- consisting of a pointer to a temporarily allocated array of pointers to --- 'IOVec' made from @cs@ and the number of pointers (@length cs@). +-- IOVec made from @cs@ and the number of pointers (@length cs@). -- /Unix only/. withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a withIOVec cs f = diff --git a/Network/Socket/ByteString/Lazy/Posix.hs b/Network/Socket/ByteString/Lazy/Posix.hs --- a/Network/Socket/ByteString/Lazy/Posix.hs +++ b/Network/Socket/ByteString/Lazy/Posix.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE BangPatterns #-} module Network.Socket.ByteString.Lazy.Posix ( diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc --- a/Network/Socket/Types.hsc +++ b/Network/Socket/Types.hsc @@ -72,18 +72,7 @@ import Foreign.Ptr import Foreign.Storable --- | Represents a socket. The fields are, respectively: --- --- * File descriptor --- * Socket family --- * Socket type --- * Protocol number --- * Status flag --- --- If you are calling the 'MkSocket' constructor directly you should ensure --- you have called 'Network.withSocketsDo' and that the file descriptor is --- in non-blocking mode. See 'Network.Socket.setNonBlockIfNeeded'. --- +-- | A socket data type. -- 'Socket's are not GCed unless they are closed by 'close'. data Socket = MkSocket @@ -94,6 +83,8 @@ (MVar SocketStatus) -- Status Flag deriving Typeable +{-# DEPRECATED MkSocket "'MkSocket' will not be available in version 3.0.0.0 or later. Use fdSocket instead" #-} + sockFd :: Socket -> CInt sockFd (MkSocket n _ _ _ _) = n @@ -133,6 +124,8 @@ | Closed -- ^ Closed was closed by 'close' deriving (Eq, Show, Typeable) +{-# DEPRECATED SocketStatus "SocketStatus will be removed" #-} + ----------------------------------------------------------------------------- -- Socket types @@ -191,6 +184,8 @@ #endif _ -> Nothing +{-# DEPRECATED packSocketType "packSocketType will not be available in version 3.0.0.0 or later." #-} + packSocketType :: SocketType -> CInt packSocketType stype = fromMaybe (error errMsg) (packSocketType' stype) where @@ -310,6 +305,8 @@ | AF_CAN -- Controller Area Network deriving (Eq, Ord, Read, Show) +{-# DEPRECATED packFamily "packFamily will not be available in version 3.0.0.0 or later." #-} + packFamily :: Family -> CInt packFamily f = case packFamily' f of Just fam -> fam @@ -526,6 +523,8 @@ --------- ---------- +{-# DEPRECATED unpackFamily "unpackFamily will not be available in version 3.0.0.0 or later." #-} + unpackFamily :: CInt -> Family unpackFamily f = case f of (#const AF_UNSPEC) -> AF_UNSPEC @@ -807,11 +806,11 @@ -- to type cast the Internet socket address into a struct sockaddr. -- Instances of the structure for different families might *not* be -- the same size. Same casting is required of other families of --- sockets such as Xerox NS. Similarly for Unix domain sockets. +-- sockets such as Xerox NS. Similarly for UNIX-domain sockets. -- To represent these socket addresses in Haskell-land, we do what BSD -- didn't do, and use a union/algebraic type for the different --- families. Currently only Unix domain sockets and the Internet +-- families. Currently only UNIX-domain sockets and the Internet -- families are supported. #if defined(IPV6_SOCKET_SUPPORT) diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -AC_INIT([Haskell network package], [2.6.3.6], [libraries@haskell.org], [network]) +AC_INIT([Haskell network package], [2.7.0.0], [libraries@haskell.org], [network]) ac_includes_default="$ac_includes_default #ifdef HAVE_SYS_SOCKET_H @@ -101,7 +101,7 @@ fi dnl -------------------------------------------------- -dnl * test for GETPEEREID(3) +dnl * test for GETPEEREID(3) dnl -------------------------------------------------- AC_MSG_CHECKING(for getpeereid in unistd.h) AC_CHECK_FUNC( getpeereid, AC_DEFINE([HAVE_GETPEEREID], [1], [Define to 1 if you have getpeereid.] )) diff --git a/examples/EchoServer.hs b/examples/EchoServer.hs --- a/examples/EchoServer.hs +++ b/examples/EchoServer.hs @@ -23,6 +23,10 @@ open addr = do sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) setSocketOption sock ReuseAddr 1 + -- If the prefork technique is not used, + -- set CloseOnExec for the security reasons. + let fd = fdSocket sock + setCloseOnExecIfNeeded fd bind sock (addrAddress addr) listen sock 10 return sock diff --git a/network.cabal b/network.cabal --- a/network.cabal +++ b/network.cabal @@ -1,5 +1,5 @@ name: network -version: 2.6.3.6 +version: 2.7.0.0 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto, Evan Borden @@ -84,6 +84,7 @@ build-depends: base < 5, bytestring, + directory, HUnit, network, hspec diff --git a/tests/SimpleSpec.hs b/tests/SimpleSpec.hs --- a/tests/SimpleSpec.hs +++ b/tests/SimpleSpec.hs @@ -13,6 +13,7 @@ import qualified Data.ByteString.Char8 as C import Network.Socket hiding (send, sendTo, recv, recvFrom) import Network.Socket.ByteString +import System.Directory import System.Timeout (timeout) import Test.Hspec @@ -119,6 +120,44 @@ getSocketOption sock UserTimeout `shouldReturn` 2000 close sock + -- On various BSD systems the peer credentials are exchanged during + -- connect(), and this does not happen with `socketpair()`. Therefore, + -- we must actually set up a listener and connect, rather than use a + -- socketpair(). + -- + describe "getPeerCredential" $ do + it "can return something" $ do + when isUnixDomainSocketAvailable $ do + -- It would be useful to check that we did not get garbage + -- back, but rather the actual uid of the test program. For + -- that we'd need System.Posix.User, but that is not available + -- under Windows. For now, accept the risk that we did not get + -- the right answer. + -- + let client sock = do + (_, uid, _) <- getPeerCredential sock + uid `shouldNotBe` Nothing + server (sock, _) = do + (_, uid, _) <- getPeerCredential sock + uid `shouldNotBe` Nothing + unixTest client server + {- The below test fails on many *BSD systems, because the getsockopt() + call that underlies getpeereid() does not have the same meaning for + all address families, but the C-library was not checking that the + provided sock is an AF_UNIX socket. This will fixed some day, but + we should not fail on those systems in the mean-time. The upstream + C-library fix is to call getsockname() and check the address family + before calling `getpeereid()`. We could duplicate that in our own + code, and then this test would work on those platforms that have + `getpeereid()` and not the SO_PEERCRED socket option. + + it "return nothing for non-UNIX-domain socket" $ do + when isUnixDomainSocketAvailable $ do + s <- socket AF_INET Stream defaultProtocol + cred1 <- getPeerCredential s + cred1 `shouldBe` (Nothing,Nothing,Nothing) + -} + describe "getAddrInfo" $ do it "works for IPv4 address" $ do let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] } @@ -143,12 +182,47 @@ testMsg :: ByteString testMsg = "This is a test message." +unixAddr :: String +unixAddr = "/tmp/network-test" + ------------------------------------------------------------------------ -- Test helpers -- | Establish a connection between client and server and then run -- 'clientAct' and 'serverAct', in different threads. Both actions -- get passed a connected 'Socket', used for communicating between +-- client and server. 'unixTest' makes sure that the 'Socket' is +-- closed after the actions have run. +unixTest :: (Socket -> IO a) -> ((Socket, SockAddr) -> IO b) -> IO () +unixTest clientAct serverAct = do + test clientSetup clientAct serverSetup server + where + clientSetup = do + sock <- socket AF_UNIX Stream defaultProtocol + connect sock (SockAddrUnix unixAddr) + return sock + + serverSetup = do + sock <- socket AF_UNIX Stream defaultProtocol + unlink unixAddr -- just in case + bind sock (SockAddrUnix unixAddr) + listen sock 1 + return sock + + server sock = E.bracket (accept sock) (killClientSock . fst) serverAct + + unlink file = do + exist <- doesFileExist file + when exist $ removeFile file + + killClientSock sock = do + shutdown sock ShutdownBoth + close sock + unlink unixAddr + +-- | Establish a connection between client and server and then run +-- 'clientAct' and 'serverAct', in different threads. Both actions +-- get passed a connected 'Socket', used for communicating between -- client and server. 'tcpTest' makes sure that the 'Socket' is -- closed after the actions have run. tcpTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO () @@ -161,6 +235,11 @@ serverPort <- readMVar portVar addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort) sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) +#if !defined(mingw32_HOST_OS) + let fd = fdSocket sock + getNonBlock fd `shouldReturn` True + getCloseOnExec fd `shouldReturn` False +#endif connect sock $ addrAddress addr return sock @@ -171,7 +250,16 @@ } addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) + let fd = fdSocket sock +#if !defined(mingw32_HOST_OS) + getNonBlock fd `shouldReturn` True + getCloseOnExec fd `shouldReturn` False +#endif setSocketOption sock ReuseAddr 1 + setCloseOnExecIfNeeded fd +#if !defined(mingw32_HOST_OS) + getCloseOnExec fd `shouldReturn` True +#endif bind sock $ addrAddress addr listen sock 1 serverPort <- socketPort sock @@ -180,6 +268,11 @@ server sock = do (clientSock, _) <- accept sock +#if !defined(mingw32_HOST_OS) + let fd = fdSocket clientSock + getNonBlock fd `shouldReturn` True + getCloseOnExec fd `shouldReturn` True +#endif _ <- serverAct clientSock close clientSock