packages feed

network 2.8.0.1 → 3.0.0.0

raw patch · 51 files changed

+3756/−5449 lines, 51 filesdep +deepseq

Dependencies added: deepseq

Files

CHANGELOG.md view
@@ -1,10 +1,26 @@-## Version 2.8.0.1+## Version 3.0.0.0 -* Eensuring that accept returns a correct sockaddr for unix domain.-  [#400](https://github.com/haskell/network/pull/400)-* Avoid out of bounds writes in pokeSockAddr.-  [#400](https://github.com/haskell/network/pull/400)+* Breaking change: the Network and Network.BSD are removed.+  Network.BSD is provided a new package: network-bsd.+* Breaking change: the signatures are changed:+```+old fdSocket :: Socket -> CInt+new fdSocket :: Socket -> IO CInt +old mkSocket :: CInt -> Family -> SocketType -> ProtocolNumber -> SocketStatus -> IO Socket+new mkSocket :: CInt Socket+```+* Breaking change: the deprecated APIs are removed: send, sendTo, recv, recvFrom, recvLen, htonl, ntohl, inet_addr, int_ntoa, bindSocket, sClose, SocketStatus, isConnected, isBound, isListening, isReadable, isWritable, sIsConnected, sIsBound, sIsListening, sIsReadable, sIsWritable, aNY_PORT, iNADDR_ANY, iN6ADDR_ANY, sOMAXCONN, sOL_SOCKET, sCM_RIGHTS, packSocketType, getPeerCred.+* Breaking chage: SockAddrCan is removed from SockAddr.+* Socket addresses are extendable with Network.Socket.Address.+* "socket" is now asynchronous-exception-safe.+  [#336](https://github.com/haskell/network/pull/336)+* "recvFrom" returns (0, addr) instead of throwing an error on EOF.+  [#360](https://github.com/haskell/network/pull/360)+* All APIs are available on any platforms.+* Build system is simplified.+* Bug fixes.+ ## Version 2.8.0.0  * Breaking change: PortNumber originally contained Word16 in network@@ -51,7 +67,7 @@               aNY_PORT, iNADDR_ANY, iN6ADDR_ANY, sOMAXCONN,               sOL_SOCKET, sCM_RIGHTS,               packFamily, unpackFamily, packSocketType- * Do not closeFd within sendFd.+ * Breaking change: 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@@ -74,10 +90,9 @@ ## Version 2.6.3.3   * Adds a function to show the defaultHints without reading their undefined fields-   [#291](https://github.com/haskell/network/pull/291)+   [#291](https://github.com/haskell/network/pull/292)  * Improve exception error messages for getAddrInfo and getNameInfo    [#289](https://github.com/haskell/network/pull/289)- * Deprecating SockAddrCan.  ## Version 2.6.3.2 @@ -142,15 +157,15 @@  ## Version 2.6.2.1 - * Regenerate configure and HsNetworkConfig.h.in.+ * Regenerate configure and `HsNetworkConfig.h.in`.   * Better detection of CAN sockets.  ## Version 2.6.2.0 - * Add support for TCP_USER_TIMEOUT.+ * Add support for `TCP_USER_TIMEOUT`. - * Don't conditionally export the SockAddr constructors.+ * Don't conditionally export the `SockAddr` constructors. - * Add isSupportSockAddr to allow checking for supported address types+ * Add `isSupportSockAddr` to allow checking for supported address types    at runtime.
− Network.hs 
@@ -1,480 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-{-# OPTIONS_HADDOCK hide #-}--------------------------------------------------------------------------------- |--- Module      :  Network--- Copyright   :  (c) The University of Glasgow 2001--- License     :  BSD-style (see the file libraries/network/LICENSE)------ Maintainer  :  libraries@haskell.org--- Stability   :  provisional--- Portability :  portable------ This module is kept for backwards-compatibility. New users are--- encouraged to use "Network.Socket" instead.------ "Network" was intended as a \"higher-level\" interface to networking--- facilities, and only supports TCP.-----------------------------------------------------------------------------------#include "HsNetworkConfig.h"--#ifdef HAVE_GETADDRINFO--- Use IPv6-capable function definitions if the OS supports it.-#define IPV6_SOCKET_SUPPORT 1-#endif--module Network {-# DEPRECATED "The high level Network interface is no longer supported. Please use Network.Socket." #-}-    (-    -- * Basic data types-      Socket-    , PortID(..)-    , HostName-    , PortNumber--    -- * Initialisation-    , withSocketsDo--    -- * Server-side connections-    , listenOn-    , accept-    , sClose--    -- * Client-side connections-    , connectTo--    -- * Simple sending and receiving-    {-$sendrecv-}-    , sendTo-    , recvFrom--    -- * Miscellaneous-    , socketPort--    -- * Networking Issues-    -- ** Buffering-    {-$buffering-}--    -- ** Improving I\/O Performance over sockets-    {-$performance-}-    ) where--import Control.Monad (liftM)-import Data.Maybe (fromJust)-import Network.BSD-import Network.Socket hiding (accept, socketPort, recvFrom,-                              sendTo, PortNumber, sClose)-import qualified Network.Socket as Socket (accept)-import System.IO-import Prelude-import qualified Control.Exception as Exception---- ------------------------------------------------------------------------------ High Level ``Setup'' functions---- If the @PortID@ specifies a unix family socket and the @Hostname@--- differs from that returned by @getHostname@ then an error is--- raised. Alternatively an empty string may be given to @connectTo@--- signalling that the current hostname applies.--data PortID =-          Service String                -- Service Name eg "ftp"-        | PortNumber PortNumber         -- User defined Port Number-#if !defined(mingw32_HOST_OS)-        | UnixSocket String             -- Unix family socket in file system-#endif-        deriving (Show, Eq)---- | Calling 'connectTo' creates a client side socket which is--- connected to the given host and port.  The Protocol and socket type is--- derived from the given port identifier.  If a port number is given--- then the result is always an internet family 'Stream' socket.--connectTo :: HostName           -- Hostname-          -> PortID             -- Port Identifier-          -> IO Handle          -- Connected Socket--#if defined(IPV6_SOCKET_SUPPORT)--- IPv6 and IPv4.--connectTo hostname (Service serv) = connect' "Network.connectTo" hostname serv--connectTo hostname (PortNumber port) = connect' "Network.connectTo" hostname (show port)-#else--- IPv4 only.--connectTo hostname (Service serv) = do-    proto <- getProtocolNumber "tcp"-    bracketOnError-        (socket AF_INET Stream proto)-        (sClose)  -- only done if there's an error-        (\sock -> do-          port  <- getServicePortNumber serv-          he    <- getHostByName hostname-          connect sock (SockAddrInet port (hostAddress he))-          socketToHandle sock ReadWriteMode-        )--connectTo hostname (PortNumber port) = do-    proto <- getProtocolNumber "tcp"-    bracketOnError-        (socket AF_INET Stream proto)-        (sClose)  -- only done if there's an error-        (\sock -> do-          he <- getHostByName hostname-          connect sock (SockAddrInet port (hostAddress he))-          socketToHandle sock ReadWriteMode-        )-#endif--#if !defined(mingw32_HOST_OS)-connectTo _ (UnixSocket path) = do-    bracketOnError-        (socket AF_UNIX Stream 0)-        (sClose)-        (\sock -> do-          connect sock (SockAddrUnix path)-          socketToHandle sock ReadWriteMode-        )-#endif--#if defined(IPV6_SOCKET_SUPPORT)-connect' :: String -> HostName -> ServiceName -> IO Handle--connect' caller host serv = do-    proto <- getProtocolNumber "tcp"-    let hints = defaultHints { addrFlags = [AI_ADDRCONFIG]-                             , addrProtocol = proto-                             , addrSocketType = Stream }-    addrs <- getAddrInfo (Just hints) (Just host) (Just serv)-    firstSuccessful caller $ map tryToConnect addrs-  where-  tryToConnect addr =-    bracketOnError-        (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))-        (sClose)  -- only done if there's an error-        (\sock -> do-          connect sock (addrAddress addr)-          socketToHandle sock ReadWriteMode-        )-#endif---- | Creates the server side socket which has been bound to the--- specified port.------ 'maxListenQueue' (typically 128) is specified to the listen queue.--- This is good enough for normal network servers but is too small--- for high performance servers.------ To avoid the \"Address already in use\" problems,--- the 'ReuseAddr' socket option is set on the listening socket.------ If available, the 'IPv6Only' socket option is set to 0--- so that both IPv4 and IPv6 can be accepted with this socket.------ If you don't like the behavior above, please use the lower level--- 'Network.Socket.listen' instead.--listenOn :: PortID      -- ^ Port Identifier-         -> IO Socket   -- ^ Listening Socket--#if defined(IPV6_SOCKET_SUPPORT)--- IPv6 and IPv4.--listenOn (Service serv) = listen' serv--listenOn (PortNumber port) = listen' (show port)-#else--- IPv4 only.--listenOn (Service serv) = do-    proto <- getProtocolNumber "tcp"-    bracketOnError-        (socket AF_INET Stream proto)-        (sClose)-        (\sock -> do-            port    <- getServicePortNumber serv-            setSocketOption sock ReuseAddr 1-            bind sock (SockAddrInet port iNADDR_ANY)-            listen sock maxListenQueue-            return sock-        )--listenOn (PortNumber port) = do-    proto <- getProtocolNumber "tcp"-    bracketOnError-        (socket AF_INET Stream proto)-        (sClose)-        (\sock -> do-            setSocketOption sock ReuseAddr 1-            bind sock (SockAddrInet port iNADDR_ANY)-            listen sock maxListenQueue-            return sock-        )-#endif--#if !defined(mingw32_HOST_OS)-listenOn (UnixSocket path) =-    bracketOnError-        (socket AF_UNIX Stream 0)-        (sClose)-        (\sock -> do-            setSocketOption sock ReuseAddr 1-            bind sock (SockAddrUnix path)-            listen sock maxListenQueue-            return sock-        )-#endif--#if defined(IPV6_SOCKET_SUPPORT)-listen' :: ServiceName -> IO Socket--listen' serv = do-    proto <- getProtocolNumber "tcp"-    -- We should probably specify addrFamily = AF_INET6 and the filter-    -- code below should be removed. AI_ADDRCONFIG is probably not-    -- necessary. But this code is well-tested. So, let's keep it.-    let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_PASSIVE]-                             , addrSocketType = Stream-                             , addrProtocol = proto }-    addrs <- getAddrInfo (Just hints) Nothing (Just serv)-    -- Choose an IPv6 socket if exists.  This ensures the socket can-    -- handle both IPv4 and IPv6 if v6only is false.-    let addrs' = filter (\x -> addrFamily x == AF_INET6) addrs-        addr = if null addrs' then head addrs else head addrs'-    bracketOnError-        (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))-        (sClose)-        (\sock -> do-            setSocketOption sock ReuseAddr 1-            bind sock (addrAddress addr)-            listen sock maxListenQueue-            return sock-        )-#endif---- -------------------------------------------------------------------------------- accept---- | Accept a connection on a socket created by 'listenOn'.  Normal--- I\/O operations (see "System.IO") can be used on the 'Handle'--- returned to communicate with the client.--- Notice that although you can pass any Socket to Network.accept,--- only sockets of either AF_UNIX, AF_INET, or AF_INET6 will work--- (this shouldn't be a problem, though). When using AF_UNIX, HostName--- will be set to the path of the socket and PortNumber to -1.----accept :: Socket                -- ^ Listening Socket-       -> IO (Handle,-              HostName,-              PortNumber)       -- ^ Triple of: read\/write 'Handle' for-                                -- communicating with the client,-                                -- the 'HostName' of the peer socket, and-                                -- the 'PortNumber' of the remote connection.-accept sock@(MkSocket _ AF_INET _ _ _) = do- ~(sock', (SockAddrInet port haddr)) <- Socket.accept sock- peer <- catchIO-          (do-             (HostEntry peer _ _ _) <- getHostByAddr AF_INET haddr-             return peer-          )-          (\_e -> inet_ntoa haddr)-                -- if getHostByName fails, we fall back to the IP address- handle <- socketToHandle sock' ReadWriteMode- return (handle, peer, port)-#if defined(IPV6_SOCKET_SUPPORT)-accept sock@(MkSocket _ AF_INET6 _ _ _) = do- (sock', addr) <- Socket.accept sock- peer <- catchIO ((fromJust . fst) `liftM` getNameInfo [] True False addr) $-         \_ -> case addr of-                 SockAddrInet  _   a   -> inet_ntoa a-                 SockAddrInet6 _ _ a _ -> return (show a)-#if defined(mingw32_HOST_OS)-                 SockAddrUnix {}       -> ioError $ userError "Network.accept: peer socket address 'SockAddrUnix' not supported on this platform."-#else-                 SockAddrUnix      a   -> return a-#endif-#if defined(CAN_SOCKET_SUPPORT)-                 SockAddrCan {}        -> ioError $ userError "Network.accept: peer socket address 'SockAddrCan' not supported."-#else-                 SockAddrCan {}        -> ioError $ userError "Network.accept: peer socket address 'SockAddrCan' not supported on this platform."-#endif- handle <- socketToHandle sock' ReadWriteMode- let port = case addr of-              SockAddrInet  p _     -> p-              SockAddrInet6 p _ _ _ -> p-              _                     -> -1- return (handle, peer, port)-#endif-#if !defined(mingw32_HOST_OS)-accept sock@(MkSocket _ AF_UNIX _ _ _) = do- ~(sock', (SockAddrUnix path)) <- Socket.accept sock- handle <- socketToHandle sock' ReadWriteMode- return (handle, path, -1)-#endif-accept (MkSocket _ family _ _ _) =-  ioError $ userError $ "Network.accept: address family '" ++-    show family ++ "' not supported."----- | Close the socket. Sending data to or receiving data from closed socket--- may lead to undefined behaviour.-sClose :: Socket -> IO ()-sClose = close -- Explicit redefinition because Network.sClose is deprecated,-               -- hence the re-export would also be marked as such.---- -------------------------------------------------------------------------------- sendTo/recvFrom--{-$sendrecv-Send and receive data from\/to the given host and port number.  These-should normally only be used where the socket will not be required for-further calls. Also, note that due to the use of 'hGetContents' in 'recvFrom'-the socket will remain open (i.e. not available) even if the function already-returned. Their use is strongly discouraged except for small test-applications-or invocations from the command line.--}--sendTo :: HostName      -- Hostname-       -> PortID        -- Port Number-       -> String        -- Message to send-       -> IO ()-sendTo h p msg = do-  s <- connectTo h p-  hPutStr s msg-  hClose s--recvFrom :: HostName    -- Hostname-         -> PortID      -- Port Number-         -> IO String   -- Received Data--#if defined(IPV6_SOCKET_SUPPORT)-recvFrom host port = do-    proto <- getProtocolNumber "tcp"-    let hints = defaultHints { addrFlags = [AI_ADDRCONFIG]-                             , addrProtocol = proto-                             , addrSocketType = Stream }-    allowed <- map addrAddress `liftM` getAddrInfo (Just hints) (Just host)-                                                   Nothing-    s <- listenOn port-    let waiting = do-        (s', addr) <- Socket.accept s-        if not (addr `oneOf` allowed)-         then sClose s' >> waiting-         else socketToHandle s' ReadMode >>= hGetContents-    waiting-  where-    a@(SockAddrInet _ ha) `oneOf` ((SockAddrInet _ hb):bs)-        | ha == hb = True-        | otherwise = a `oneOf` bs-    a@(SockAddrInet6 _ _ ha _) `oneOf` ((SockAddrInet6 _ _ hb _):bs)-        | ha == hb = True-        | otherwise = a `oneOf` bs-    _ `oneOf` _ = False-#else-recvFrom host port = do- ip  <- getHostByName host- let ipHs = hostAddresses ip- s   <- listenOn port- let-  waiting = do-     ~(s', SockAddrInet _ haddr)  <-  Socket.accept s-     he <- getHostByAddr AF_INET haddr-     if not (any (`elem` ipHs) (hostAddresses he))-      then do-         sClose s'-         waiting-      else do-        h <- socketToHandle s' ReadMode-        msg <- hGetContents h-        return msg-- message <- waiting- return message-#endif---- ------------------------------------------------------------------------------ Access function returning the port type/id of socket.---- | Returns the 'PortID' associated with a given socket.-socketPort :: Socket -> IO PortID-socketPort s = do-    sockaddr <- getSocketName s-    case sockaddr of-      SockAddrInet port _      -> return $ PortNumber port-#if defined(IPV6_SOCKET_SUPPORT)-      SockAddrInet6 port _ _ _ -> return $ PortNumber port-#else-      SockAddrInet6 {}         -> ioError $ userError "Network.socketPort: socket address 'SockAddrInet6' not supported on this platform."-#endif-#if defined(mingw32_HOST_OS)-      SockAddrUnix {}          -> ioError $ userError "Network.socketPort: socket address 'SockAddrUnix' not supported on this platform."-#else-      SockAddrUnix path        -> return $ UnixSocket path-#endif-      SockAddrCan {}           -> ioError $ userError "Network.socketPort: socket address 'SockAddrCan' not supported."---- ------------------------------------------------------------------------------ Utils---- Like bracket, but only performs the final action if there was an--- exception raised by the middle bit.-bracketOnError-        :: IO a         -- ^ computation to run first (\"acquire resource\")-        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")-        -> (a -> IO c)  -- ^ computation to run in-between-        -> IO c         -- returns the value from the in-between computation-bracketOnError = Exception.bracketOnError---------------------------------------------------------------------------------- Extra documentation--{-$buffering--The 'Handle' returned by 'connectTo' and 'accept' is 'NoBuffering' by-default.  For an interactive application you may want to set the-buffering mode on the 'Handle' to-'LineBuffering' or 'BlockBuffering', like so:--> h <- connectTo host port-> hSetBuffering h LineBuffering--}--{-$performance--For really fast I\/O, it might be worth looking at the 'hGetBuf' and-'hPutBuf' family of functions in "System.IO".--}--catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a-#if MIN_VERSION_base(4,0,0)-catchIO = Exception.catch-#else-catchIO = Exception.catchJust Exception.ioErrors-#endif---- Version of try implemented in terms of the locally defined catchIO-tryIO :: IO a -> IO (Either Exception.IOException a)-tryIO m = catchIO (liftM Right m) (return . Left)---- Returns the first action from a list which does not throw an exception.--- If all the actions throw exceptions (and the list of actions is not empty),--- the last exception is thrown.--- The operations are run outside of the catchIO cleanup handler because--- catchIO masks asynchronous exceptions in the cleanup handler.--- In the case of complete failure, the last exception is actually thrown.-firstSuccessful :: String -> [IO a] -> IO a-firstSuccessful caller = go Nothing-  where-  -- Attempt the next operation, remember exception on failure-  go _ (p:ps) =-    do r <- tryIO p-       case r of-         Right x -> return x-         Left  e -> go (Just e) ps--  -- All operations failed, throw error if one exists-  go Nothing  [] = ioError $ userError $ caller ++ ": firstSuccessful: empty list"-  go (Just e) [] = Exception.throwIO e
− Network/BSD.hsc 
@@ -1,574 +0,0 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}-{-# OPTIONS_HADDOCK hide #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}--------------------------------------------------------------------------------- |--- Module      :  Network.BSD--- Copyright   :  (c) The University of Glasgow 2001--- License     :  BSD-style (see the file libraries/network/LICENSE)------ Maintainer  :  libraries@haskell.org--- Stability   :  experimental--- Portability :  non-portable------ The "Network.BSD" module defines Haskell bindings to network--- programming functionality provided by BSD Unix derivatives.-----------------------------------------------------------------------------------#include "HsNet.h"-##include "HsNetDef.h"--module Network.BSD  {-# DEPRECATED "This platform dependent module is no longer supported." #-}-    (-    -- * Host names-      HostName-    , getHostName--    , HostEntry(..)-    , getHostByName-    , getHostByAddr-    , hostAddress--#if defined(HAVE_GETHOSTENT) && !defined(mingw32_HOST_OS)-    , getHostEntries--    -- ** Low level functionality-    , setHostEntry-    , getHostEntry-    , endHostEntry-#endif--    -- * Service names-    , ServiceEntry(..)-    , ServiceName-    , getServiceByName-    , getServiceByPort-    , getServicePortNumber--#if !defined(mingw32_HOST_OS)-    , getServiceEntries--    -- ** Low level functionality-    , getServiceEntry-    , setServiceEntry-    , endServiceEntry-#endif--    -- * Protocol names-    , ProtocolName-    , ProtocolNumber-    , ProtocolEntry(..)-    , getProtocolByName-    , getProtocolByNumber-    , getProtocolNumber-    , defaultProtocol--#if !defined(mingw32_HOST_OS)-    , getProtocolEntries-    -- ** Low level functionality-    , setProtocolEntry-    , getProtocolEntry-    , endProtocolEntry-#endif--    -- * Port numbers-    , PortNumber--    -- * Network names-    , NetworkName-    , NetworkAddr-    , NetworkEntry(..)--#if !defined(mingw32_HOST_OS)-    , getNetworkByName-    , getNetworkByAddr-    , getNetworkEntries-    -- ** Low level functionality-    , setNetworkEntry-    , getNetworkEntry-    , endNetworkEntry-#endif--#if defined(HAVE_IF_NAMETOINDEX)-    -- * Interface names-    , ifNameToIndex-#endif--    ) where--import Network.Socket--import Control.Concurrent (MVar, newMVar, withMVar)-import qualified Control.Exception as E-import Foreign.C.String (CString, peekCString, withCString)-#if defined(HAVE_WINSOCK2_H)-import Foreign.C.Types ( CShort )-#endif-import Foreign.C.Types ( CInt(..), CULong(..), CSize(..) )-import Foreign.Ptr (Ptr, nullPtr)-import Foreign.Storable (Storable(..))-import Foreign.Marshal.Array (allocaArray0, peekArray0)-import Foreign.Marshal.Utils (with, fromBool)-import Data.Typeable-import System.IO.Error (ioeSetErrorString, mkIOError)-import System.IO.Unsafe (unsafePerformIO)--import GHC.IO.Exception--import Control.Monad (liftM)--import Network.Socket.Internal (throwSocketErrorIfMinus1_)---- ------------------------------------------------------------------------------ Basic Types--type ProtocolName = String---- ------------------------------------------------------------------------------ Service Database Access---- Calling getServiceByName for a given service and protocol returns--- the systems service entry.  This should be used to find the port--- numbers for standard protocols such as SMTP and FTP.  The remaining--- three functions should be used for browsing the service database--- sequentially.---- Calling setServiceEntry with True indicates that the service--- database should be left open between calls to getServiceEntry.  To--- close the database a call to endServiceEntry is required.  This--- database file is usually stored in the file /etc/services.--data ServiceEntry  =-  ServiceEntry  {-     serviceName     :: ServiceName,    -- Official Name-     serviceAliases  :: [ServiceName],  -- aliases-     servicePort     :: PortNumber,     -- Port Number  ( network byte order )-     serviceProtocol :: ProtocolName    -- Protocol-  } deriving (Show, Typeable)--instance Storable ServiceEntry where-   sizeOf    _ = #const sizeof(struct servent)-   alignment _ = alignment (undefined :: CInt) -- ???--   peek p = do-        s_name    <- (#peek struct servent, s_name) p >>= peekCString-        s_aliases <- (#peek struct servent, s_aliases) p-                           >>= peekArray0 nullPtr-                           >>= mapM peekCString-        s_port    <- (#peek struct servent, s_port) p-        s_proto   <- (#peek struct servent, s_proto) p >>= peekCString-        return (ServiceEntry {-                        serviceName     = s_name,-                        serviceAliases  = s_aliases,-#if defined(HAVE_WINSOCK2_H)-                        servicePort     = (fromIntegral (s_port :: CShort)),-#else-                           -- s_port is already in network byte order, but it-                           -- might be the wrong size.-                        servicePort     = (fromIntegral (s_port :: CInt)),-#endif-                        serviceProtocol = s_proto-                })--   poke = throwUnsupportedOperationPoke "ServiceEntry"----- | Get service by name.-getServiceByName :: ServiceName         -- Service Name-                 -> ProtocolName        -- Protocol Name-                 -> IO ServiceEntry     -- Service Entry-getServiceByName name proto = withLock $ do- withCString name  $ \ cstr_name  -> do- withCString proto $ \ cstr_proto -> do- throwNoSuchThingIfNull "Network.BSD.getServiceByName" "no such service entry"-   $ c_getservbyname cstr_name cstr_proto- >>= peek--foreign import CALLCONV unsafe "getservbyname"-  c_getservbyname :: CString -> CString -> IO (Ptr ServiceEntry)---- | Get the service given a 'PortNumber' and 'ProtocolName'.-getServiceByPort :: PortNumber -> ProtocolName -> IO ServiceEntry-getServiceByPort port proto = withLock $ do- withCString proto $ \ cstr_proto -> do- throwNoSuchThingIfNull "Network.BSD.getServiceByPort" "no such service entry"-   $ c_getservbyport (fromIntegral port) cstr_proto- >>= peek--foreign import CALLCONV unsafe "getservbyport"-  c_getservbyport :: CInt -> CString -> IO (Ptr ServiceEntry)---- | Get the 'PortNumber' corresponding to the 'ServiceName'.-getServicePortNumber :: ServiceName -> IO PortNumber-getServicePortNumber name = do-    (ServiceEntry _ _ port _) <- getServiceByName name "tcp"-    return port--#if !defined(mingw32_HOST_OS)-getServiceEntry :: IO ServiceEntry-getServiceEntry = withLock $ do- throwNoSuchThingIfNull "Network.BSD.getServiceEntry" "no such service entry"-   $ c_getservent- >>= peek--foreign import ccall unsafe "getservent" c_getservent :: IO (Ptr ServiceEntry)--setServiceEntry :: Bool -> IO ()-setServiceEntry flg = withLock $ c_setservent (fromBool flg)--foreign import ccall unsafe  "setservent" c_setservent :: CInt -> IO ()--endServiceEntry :: IO ()-endServiceEntry = withLock $ c_endservent--foreign import ccall unsafe  "endservent" c_endservent :: IO ()--getServiceEntries :: Bool -> IO [ServiceEntry]-getServiceEntries stayOpen = do-  setServiceEntry stayOpen-  getEntries (getServiceEntry) (endServiceEntry)-#endif---- ------------------------------------------------------------------------------ Protocol Entries---- The following relate directly to the corresponding UNIX C--- calls for returning the protocol entries. The protocol entry is--- represented by the Haskell type ProtocolEntry.---- As for setServiceEntry above, calling setProtocolEntry.--- determines whether or not the protocol database file, usually--- @/etc/protocols@, is to be kept open between calls of--- getProtocolEntry. Similarly,--data ProtocolEntry =-  ProtocolEntry  {-     protoName    :: ProtocolName,      -- Official Name-     protoAliases :: [ProtocolName],    -- aliases-     protoNumber  :: ProtocolNumber     -- Protocol Number-  } deriving (Read, Show, Typeable)--instance Storable ProtocolEntry where-   sizeOf    _ = #const sizeof(struct protoent)-   alignment _ = alignment (undefined :: CInt) -- ???--   peek p = do-        p_name    <- (#peek struct protoent, p_name) p >>= peekCString-        p_aliases <- (#peek struct protoent, p_aliases) p-                           >>= peekArray0 nullPtr-                           >>= mapM peekCString-#if defined(HAVE_WINSOCK2_H)-         -- With WinSock, the protocol number is only a short;-         -- hoist it in as such, but represent it on the Haskell side-         -- as a CInt.-        p_proto_short  <- (#peek struct protoent, p_proto) p-        let p_proto = fromIntegral (p_proto_short :: CShort)-#else-        p_proto        <- (#peek struct protoent, p_proto) p-#endif-        return (ProtocolEntry {-                        protoName    = p_name,-                        protoAliases = p_aliases,-                        protoNumber  = p_proto-                })--   poke = throwUnsupportedOperationPoke "ProtocolEntry"---getProtocolByName :: ProtocolName -> IO ProtocolEntry-getProtocolByName name = withLock $ do- withCString name $ \ name_cstr -> do- throwNoSuchThingIfNull "Network.BSD.getProtocolByName" ("no such protocol name: " ++ name)-   $ c_getprotobyname name_cstr- >>= peek--foreign import  CALLCONV unsafe  "getprotobyname"-   c_getprotobyname :: CString -> IO (Ptr ProtocolEntry)---getProtocolByNumber :: ProtocolNumber -> IO ProtocolEntry-getProtocolByNumber num = withLock $ do- throwNoSuchThingIfNull "Network.BSD.getProtocolByNumber" ("no such protocol number: " ++ show num)-   $ c_getprotobynumber (fromIntegral num)- >>= peek--foreign import CALLCONV unsafe  "getprotobynumber"-   c_getprotobynumber :: CInt -> IO (Ptr ProtocolEntry)---getProtocolNumber :: ProtocolName -> IO ProtocolNumber-getProtocolNumber proto = do- (ProtocolEntry _ _ num) <- getProtocolByName proto- return num--#if !defined(mingw32_HOST_OS)-getProtocolEntry :: IO ProtocolEntry    -- Next Protocol Entry from DB-getProtocolEntry = withLock $ do- ent <- throwNoSuchThingIfNull "Network.BSD.getProtocolEntry" "no such protocol entry"-                $ c_getprotoent- peek ent--foreign import ccall unsafe  "getprotoent" c_getprotoent :: IO (Ptr ProtocolEntry)--setProtocolEntry :: Bool -> IO ()       -- Keep DB Open ?-setProtocolEntry flg = withLock $ c_setprotoent (fromBool flg)--foreign import ccall unsafe "setprotoent" c_setprotoent :: CInt -> IO ()--endProtocolEntry :: IO ()-endProtocolEntry = withLock $ c_endprotoent--foreign import ccall unsafe "endprotoent" c_endprotoent :: IO ()--getProtocolEntries :: Bool -> IO [ProtocolEntry]-getProtocolEntries stayOpen = withLock $ do-  setProtocolEntry stayOpen-  getEntries (getProtocolEntry) (endProtocolEntry)-#endif---- ------------------------------------------------------------------------------ Host lookups--data HostEntry =-  HostEntry  {-     hostName      :: HostName,         -- Official Name-     hostAliases   :: [HostName],       -- aliases-     hostFamily    :: Family,           -- Host Type (currently AF_INET)-     hostAddresses :: [HostAddress]     -- Set of Network Addresses  (in network byte order)-  } deriving (Read, Show, Typeable)--instance Storable HostEntry where-   sizeOf    _ = #const sizeof(struct hostent)-   alignment _ = alignment (undefined :: CInt) -- ???--   peek p = do-        h_name       <- (#peek struct hostent, h_name) p >>= peekCString-        h_aliases    <- (#peek struct hostent, h_aliases) p-                                >>= peekArray0 nullPtr-                                >>= mapM peekCString-        h_addrtype   <- (#peek struct hostent, h_addrtype) p-        -- h_length       <- (#peek struct hostent, h_length) p-        h_addr_list  <- (#peek struct hostent, h_addr_list) p-                                >>= peekArray0 nullPtr-                                >>= mapM peek-        return (HostEntry {-                        hostName       = h_name,-                        hostAliases    = h_aliases,-#if defined(HAVE_WINSOCK2_H)-                        hostFamily     = unpackFamily (fromIntegral (h_addrtype :: CShort)),-#else-                        hostFamily     = unpackFamily h_addrtype,-#endif-                        hostAddresses  = h_addr_list-                })--   poke = throwUnsupportedOperationPoke "HostEntry"----- convenience function:-hostAddress :: HostEntry -> HostAddress-hostAddress (HostEntry nm _ _ ls) =- case ls of-   []    -> error $ "Network.BSD.hostAddress: empty network address list for " ++ nm-   (x:_) -> x---- getHostByName must use the same lock as the *hostent functions--- may cause problems if called concurrently.---- | Resolve a 'HostName' to IPv4 address.-getHostByName :: HostName -> IO HostEntry-getHostByName name = withLock $ do-  withCString name $ \ name_cstr -> do-   ent <- throwNoSuchThingIfNull "Network.BSD.getHostByName" "no such host entry"-                $ c_gethostbyname name_cstr-   peek ent--foreign import CALLCONV safe "gethostbyname"-   c_gethostbyname :: CString -> IO (Ptr HostEntry)----- The locking of gethostbyaddr is similar to gethostbyname.--- | Get a 'HostEntry' corresponding to the given address and family.--- Note that only IPv4 is currently supported.-getHostByAddr :: Family -> HostAddress -> IO HostEntry-getHostByAddr family addr = do- with addr $ \ ptr_addr -> withLock $ do- throwNoSuchThingIfNull "Network.BSD.getHostByAddr" "no such host entry"-   $ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (packFamily family)- >>= peek--foreign import CALLCONV safe "gethostbyaddr"-   c_gethostbyaddr :: Ptr HostAddress -> CInt -> CInt -> IO (Ptr HostEntry)--#if defined(HAVE_GETHOSTENT) && !defined(mingw32_HOST_OS)-getHostEntry :: IO HostEntry-getHostEntry = withLock $ do- throwNoSuchThingIfNull "Network.BSD.getHostEntry" "unable to retrieve host entry"-   $ c_gethostent- >>= peek--foreign import ccall unsafe "gethostent" c_gethostent :: IO (Ptr HostEntry)--setHostEntry :: Bool -> IO ()-setHostEntry flg = withLock $ c_sethostent (fromBool flg)--foreign import ccall unsafe "sethostent" c_sethostent :: CInt -> IO ()--endHostEntry :: IO ()-endHostEntry = withLock $ c_endhostent--foreign import ccall unsafe "endhostent" c_endhostent :: IO ()--getHostEntries :: Bool -> IO [HostEntry]-getHostEntries stayOpen = do-  setHostEntry stayOpen-  getEntries (getHostEntry) (endHostEntry)-#endif---- ------------------------------------------------------------------------------ Accessing network information---- Same set of access functions as for accessing host,protocol and--- service system info, this time for the types of networks supported.---- network addresses are represented in host byte order.-type NetworkAddr = CULong--type NetworkName = String--data NetworkEntry =-  NetworkEntry {-     networkName        :: NetworkName,   -- official name-     networkAliases     :: [NetworkName], -- aliases-     networkFamily      :: Family,         -- type-     networkAddress     :: NetworkAddr-   } deriving (Read, Show, Typeable)--instance Storable NetworkEntry where-   sizeOf    _ = #const sizeof(struct hostent)-   alignment _ = alignment (undefined :: CInt) -- ???--   peek p = do-        n_name         <- (#peek struct netent, n_name) p >>= peekCString-        n_aliases      <- (#peek struct netent, n_aliases) p-                                >>= peekArray0 nullPtr-                                >>= mapM peekCString-        n_addrtype     <- (#peek struct netent, n_addrtype) p-        n_net          <- (#peek struct netent, n_net) p-        return (NetworkEntry {-                        networkName      = n_name,-                        networkAliases   = n_aliases,-                        networkFamily    = unpackFamily (fromIntegral-                                                        (n_addrtype :: CInt)),-                        networkAddress   = n_net-                })--   poke = throwUnsupportedOperationPoke "NetworkEntry"---#if !defined(mingw32_HOST_OS)-getNetworkByName :: NetworkName -> IO NetworkEntry-getNetworkByName name = withLock $ do- withCString name $ \ name_cstr -> do-  throwNoSuchThingIfNull "Network.BSD.getNetworkByName" "no such network entry"-    $ c_getnetbyname name_cstr-  >>= peek--foreign import ccall unsafe "getnetbyname"-   c_getnetbyname  :: CString -> IO (Ptr NetworkEntry)--getNetworkByAddr :: NetworkAddr -> Family -> IO NetworkEntry-getNetworkByAddr addr family = withLock $ do- throwNoSuchThingIfNull "Network.BSD.getNetworkByAddr" "no such network entry"-   $ c_getnetbyaddr addr (packFamily family)- >>= peek--foreign import ccall unsafe "getnetbyaddr"-   c_getnetbyaddr  :: NetworkAddr -> CInt -> IO (Ptr NetworkEntry)--getNetworkEntry :: IO NetworkEntry-getNetworkEntry = withLock $ do- throwNoSuchThingIfNull "Network.BSD.getNetworkEntry" "no more network entries"-          $ c_getnetent- >>= peek--foreign import ccall unsafe "getnetent" c_getnetent :: IO (Ptr NetworkEntry)---- | Open the network name database. The parameter specifies--- whether a connection is maintained open between various--- networkEntry calls-setNetworkEntry :: Bool -> IO ()-setNetworkEntry flg = withLock $ c_setnetent (fromBool flg)--foreign import ccall unsafe "setnetent" c_setnetent :: CInt -> IO ()---- | Close the connection to the network name database.-endNetworkEntry :: IO ()-endNetworkEntry = withLock $ c_endnetent--foreign import ccall unsafe "endnetent" c_endnetent :: IO ()---- | Get the list of network entries.-getNetworkEntries :: Bool -> IO [NetworkEntry]-getNetworkEntries stayOpen = do-  setNetworkEntry stayOpen-  getEntries (getNetworkEntry) (endNetworkEntry)-#endif---- Mutex for name service lockdown--{-# NOINLINE lock #-}-lock :: MVar ()-lock = unsafePerformIO $ withSocketsDo $ newMVar ()--withLock :: IO a -> IO a-withLock act = withMVar lock (\_ -> act)---- ------------------------------------------------------------------------------ Miscellaneous Functions---- | Calling getHostName returns the standard host name for the current--- processor, as set at boot time.--getHostName :: IO HostName-getHostName = do-  let size = 256-  allocaArray0 size $ \ cstr -> do-    throwSocketErrorIfMinus1_ "Network.BSD.getHostName" $ c_gethostname cstr (fromIntegral size)-    peekCString cstr--foreign import CALLCONV unsafe "gethostname"-   c_gethostname :: CString -> CSize -> IO CInt---- Helper function used by the exported functions that provides a--- Haskellised view of the enumerator functions:--getEntries :: IO a  -- read-           -> IO () -- at end-           -> IO [a]-getEntries getOne atEnd = loop-  where-    loop = do-      vv <- E.catch (liftM Just getOne)-            (\ e -> let _types = e :: IOException in return Nothing)-      case vv of-        Nothing -> return []-        Just v  -> loop >>= \ vs -> atEnd >> return (v:vs)---throwNoSuchThingIfNull :: String -> String -> IO (Ptr a) -> IO (Ptr a)-throwNoSuchThingIfNull loc desc act = do-  ptr <- act-  if (ptr == nullPtr)-   then ioError (ioeSetErrorString (mkIOError NoSuchThing loc Nothing Nothing) desc)-   else return ptr--throwUnsupportedOperationPoke :: String -> Ptr a -> a -> IO ()-throwUnsupportedOperationPoke typ _ _ =-  ioError $ ioeSetErrorString ioe "Operation not implemented"-  where-    ioe = mkIOError UnsupportedOperation-                    ("Network.BSD: instance Storable " ++ typ ++ ": poke")-                    Nothing-                    Nothing
+ Network/Socket.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE CPP #-}++#include "HsNetDef.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Network.Socket+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/network/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- 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+-- one client) and a client using it.+--+-- > -- Echo server program+-- > module Main (main) where+-- >+-- > import Control.Concurrent (forkFinally)+-- > import qualified Control.Exception as E+-- > import Control.Monad (unless, forever, void)+-- > import qualified Data.ByteString as S+-- > import Network.Socket+-- > import Network.Socket.ByteString (recv, sendAll)+-- >+-- > main :: IO ()+-- > main = withSocketsDo $ do+-- >     addr <- resolve "3000"+-- >     E.bracket (open addr) close loop+-- >   where+-- >     resolve port = do+-- >         let hints = defaultHints {+-- >                 addrFlags = [AI_PASSIVE]+-- >               , addrSocketType = Stream+-- >               }+-- >         addr:_ <- getAddrInfo (Just hints) Nothing (Just port)+-- >         return addr+-- >     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.+-- >         fd <- fdSocket sock+-- >         setCloseOnExecIfNeeded fd+-- >         bind sock (addrAddress addr)+-- >         listen sock 10+-- >         return sock+-- >     loop sock = forever $ do+-- >         (conn, peer) <- accept sock+-- >         putStrLn $ "Connection from " ++ show peer+-- >         void $ forkFinally (talk conn) (\_ -> close conn)+-- >     talk conn = do+-- >         msg <- recv conn 1024+-- >         unless (S.null msg) $ do+-- >           sendAll conn msg+-- >           talk conn+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > -- Echo client program+-- > module Main (main) where+-- >+-- > import qualified Control.Exception as E+-- > import qualified Data.ByteString.Char8 as C+-- > import Network.Socket+-- > import Network.Socket.ByteString (recv, sendAll)+-- >+-- > main :: IO ()+-- > main = withSocketsDo $ do+-- >     addr <- resolve "127.0.0.1" "3000"+-- >     E.bracket (open addr) close talk+-- >   where+-- >     resolve host port = do+-- >         let hints = defaultHints { addrSocketType = Stream }+-- >         addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)+-- >         return addr+-- >     open addr = do+-- >         sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+-- >         connect sock $ addrAddress addr+-- >         return sock+-- >     talk sock = do+-- >         sendAll sock "Hello, world!"+-- >         msg <- recv sock 1024+-- >         putStr "Received: "+-- >         C.putStrLn msg+--+-- The proper programming model is that one 'Socket' is handled by+-- a single thread. If multiple threads use one 'Socket' concurrently,+-- unexpected things would happen. There is one exception for multiple+-- threads vs a single 'Socket': one thread reads data from a 'Socket'+-- only and the other thread writes data to the 'Socket' only.+-----------------------------------------------------------------------------++-- In order to process this file, you need to have CALLCONV defined.++module Network.Socket+    (+    -- * Initialisation+      withSocketsDo++    -- * Address information+    , getAddrInfo+    -- ** Types+    , HostName+    , ServiceName+    , AddrInfo(..)+    , defaultHints+    -- ** Flags+    , AddrInfoFlag(..)+    , addrInfoFlagImplemented++    -- * Socket operations+    , connect+    , bind+    , listen+    , accept+    -- ** Closing+    , close+    , close'+    , shutdown+    , ShutdownCmd(..)++    -- * Socket options+    , SocketOption(..)+    , isSupportedSocketOption+    , getSocketOption+    , setSocketOption++    -- * Socket+    , Socket+    , socket+    , fdSocket+    , mkSocket+    , socketToHandle+    -- ** Types of Socket+    , SocketType(..)+    , isSupportedSocketType+    -- ** Family+    , Family(..)+    , isSupportedFamily+    , packFamily+    , unpackFamily+    -- ** Protocol number+    , ProtocolNumber+    , defaultProtocol+    -- * Basic socket address type+    , SockAddr(..)+    , isSupportedSockAddr+    , getPeerName+    , getSocketName+    -- ** Host address+    , HostAddress+    , hostAddressToTuple+    , tupleToHostAddress+    -- ** Host address6+    , HostAddress6+    , hostAddress6ToTuple+    , tupleToHostAddress6+    -- ** Flow Info+    , FlowInfo+    -- ** Scope ID+    , ScopeID+    , ifNameToIndex+    , ifIndexToName+    -- ** Port number+    , PortNumber+    , defaultPort+    , socketPortSafe+    , socketPort++    -- * UNIX-domain socket+    , isUnixDomainSocketAvailable+    , socketPair+    , sendFd+    , recvFd+    , getPeerCredential++    -- * Name information+    , getNameInfo+    , NameInfoFlag(..)++    -- * Low level+    -- ** socket operations+    , setCloseOnExecIfNeeded+    , getCloseOnExec+    , setNonBlockIfNeeded+    , getNonBlock+    -- ** Sending and receiving data+    , sendBuf+    , recvBuf+    , sendBufTo+    , recvBufFrom++    -- * Special constants+    , maxListenQueue+    ) where++import Network.Socket.Buffer hiding (sendBufTo, recvBufFrom)+import Network.Socket.Cbits+import Network.Socket.Fcntl+import Network.Socket.Handle+import Network.Socket.If+import Network.Socket.Info+import Network.Socket.Internal+import Network.Socket.Name hiding (getPeerName, getSocketName)+import Network.Socket.Options+import Network.Socket.Shutdown+import Network.Socket.SockAddr+import Network.Socket.Syscall hiding (connect, bind, accept)+import Network.Socket.Types+import Network.Socket.Unix
− Network/Socket.hsc 
@@ -1,1966 +0,0 @@-{-# LANGUAGE CPP, ScopedTypeVariables, RecordWildCards #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}--------------------------------------------------------------------------------- |--- Module      :  Network.Socket--- Copyright   :  (c) The University of Glasgow 2001--- License     :  BSD-style (see the file libraries/network/LICENSE)------ Maintainer  :  libraries@haskell.org--- Stability   :  provisional--- Portability :  portable------ 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--- one client) and a client using it.------ > -- Echo server program--- > module Main (main) where--- >--- > import Control.Concurrent (forkFinally)--- > import qualified Control.Exception as E--- > import Control.Monad (unless, forever, void)--- > import qualified Data.ByteString as S--- > import Network.Socket hiding (recv)--- > import Network.Socket.ByteString (recv, sendAll)--- >--- > main :: IO ()--- > main = withSocketsDo $ do--- >     addr <- resolve "3000"--- >     E.bracket (open addr) close loop--- >   where--- >     resolve port = do--- >         let hints = defaultHints {--- >                 addrFlags = [AI_PASSIVE]--- >               , addrSocketType = Stream--- >               }--- >         addr:_ <- getAddrInfo (Just hints) Nothing (Just port)--- >         return addr--- >     open addr = do--- >         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--- >         (conn, peer) <- accept sock--- >         putStrLn $ "Connection from " ++ show peer--- >         void $ forkFinally (talk conn) (\_ -> close conn)--- >     talk conn = do--- >         msg <- recv conn 1024--- >         unless (S.null msg) $ do--- >           sendAll conn msg--- >           talk conn------ > {-# LANGUAGE OverloadedStrings #-}--- > -- Echo client program--- > module Main (main) where--- >--- > import qualified Control.Exception as E--- > import qualified Data.ByteString.Char8 as C--- > import Network.Socket hiding (recv)--- > import Network.Socket.ByteString (recv, sendAll)--- >--- > main :: IO ()--- > main = withSocketsDo $ do--- >     addr <- resolve "127.0.0.1" "3000"--- >     E.bracket (open addr) close talk--- >   where--- >     resolve host port = do--- >         let hints = defaultHints { addrSocketType = Stream }--- >         addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)--- >         return addr--- >     open addr = do--- >         sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)--- >         connect sock $ addrAddress addr--- >         return sock--- >     talk sock = do--- >         sendAll sock "Hello, world!"--- >         msg <- recv sock 1024--- >         putStr "Received: "--- >         C.putStrLn msg------ The proper programming model is that one 'Socket' is handled by--- a single thread. If multiple threads use one 'Socket' concurrently,--- unexpected things would happen. There is one exception for multiple--- threads vs a single 'Socket': one thread reads data from a 'Socket'--- only and the other thread writes data to the 'Socket' only.--------------------------------------------------------------------------------#include "HsNet.h"-##include "HsNetDef.h"--module Network.Socket-    (-    -- * Initialisation-      withSocketsDo-    -- * Address information-    , getAddrInfo-    -- ** Types-    , HostName-    , ServiceName-    , AddrInfo(..)-    , defaultHints-    -- ** Flags-    , AddrInfoFlag(..)-    , addrInfoFlagImplemented-    -- * Socket operations-    , connect-    , bind-    , listen-    , accept-    -- ** Closing-    , close-    , 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-    , 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-    -- ** Port number-    , PortNumber-    , defaultPort-    , socketPortSafe-    , socketPort-    -- * UNIX-domain socket-    , isUnixDomainSocketAvailable-    , socketPair-    , sendFd-    , recvFd-    , getPeerCredential-#if defined(IPV6_SOCKET_SUPPORT)-    -- * Name information-    , NameInfoFlag(..)-    , getNameInfo-#endif-    -- * 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-    -- ** Deprecated address functions-    , htonl-    , ntohl-    , inet_addr-    , inet_ntoa-    -- ** Deprecated socket operations-    , bindSocket-    , sClose-    -- ** Deprecated socket status-    , SocketStatus(..) -- fixme-    , isConnected-    , isBound-    , isListening-    , isReadable-    , isWritable-    , sIsConnected-    , sIsBound-    , sIsListening-    , sIsReadable-    , sIsWritable-    -- ** Deprecated special constants-    , aNY_PORT-    , iNADDR_ANY-#if defined(IPV6_SOCKET_SUPPORT)-    , iN6ADDR_ANY-#endif-    , sOMAXCONN-    , sOL_SOCKET-#ifdef SCM_RIGHTS-    , sCM_RIGHTS-#endif-    -- ** 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-import Data.Functor-import Data.List (foldl')-import Data.Maybe (isJust)-import Data.Word (Word8, Word32)-import Foreign.Ptr (Ptr, castPtr, nullPtr)-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 (CInt(..), CSize(..))-import Foreign.Marshal.Alloc ( alloca, allocaBytes )-import Foreign.Marshal.Array ( peekArray )-import Foreign.Marshal.Utils ( maybeWith, with )--import System.IO-import Control.Monad (liftM, when, void)--import qualified Control.Exception as E-import Control.Concurrent.MVar-import Data.Typeable-import System.IO.Error--import GHC.Conc (threadWaitWrite)-# ifdef HAVE_ACCEPT4-import GHC.Conc (threadWaitRead)-# endif-##if MIN_VERSION_base(4,3,1)-import GHC.Conc (closeFdWith)-##endif-# if defined(mingw32_HOST_OS)-import GHC.Conc (asyncDoProc)-import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr)-import Foreign (FunPtr)-# endif-# if defined(darwin_HOST_OS)-import Data.List (delete)-# endif-import qualified GHC.IO.Device-import GHC.IO.Handle.FD-import GHC.IO.Exception-import GHC.IO-import qualified System.Posix.Internals--import Network.Socket.Internal-import Network.Socket.Types--import Prelude -- Silence AMP warnings---- | Either a host name e.g., @\"haskell.org\"@ or a numeric host--- address string consisting of a dotted decimal IPv4 address or an--- IPv6 address e.g., @\"192.168.0.1\"@.-type HostName       = String-type ServiceName    = String---- ------------------------------------------------------------------------------- On Windows, our sockets are not put in non-blocking mode (non-blocking--- is not supported for regular file descriptors on Windows, and it would--- be a pain to support it only for sockets).  So there are two cases:------  - the threaded RTS uses safe calls for socket operations to get---    non-blocking I/O, just like the rest of the I/O library------  - with the non-threaded RTS, only some operations on sockets will be---    non-blocking.  Reads and writes go through the normal async I/O---    system.  accept() uses asyncDoProc so is non-blocking.  A handful---    of others (recvFrom, sendFd, recvFd) will block all threads - if this---    is a problem, -threaded is the workaround.----##if defined(mingw32_HOST_OS)-##define SAFE_ON_WIN safe-##else-##define SAFE_ON_WIN unsafe-##endif---------------------------------------------------------------------------------- Socket types--#if defined(mingw32_HOST_OS)-socket2FD  (MkSocket fd _ _ _ _) =-  -- HACK, 1 means True-  FD{fdFD = fd,fdIsSocket_ = 1}-#endif---- | Smart constructor for constructing a 'Socket'. It should only be--- called once for every new file descriptor. The caller must make--- sure that the socket is in non-blocking mode. See--- 'setNonBlockIfNeeded'.-mkSocket :: CInt-         -> Family-         -> SocketType-         -> ProtocolNumber-         -> SocketStatus-         -> IO Socket-mkSocket fd fam sType pNum stat = do-   mStat <- newMVar stat-   withSocketsDo $ return ()-   return $ MkSocket fd fam sType pNum mStat---- | This is the default protocol for a given service.-defaultProtocol :: ProtocolNumber-defaultProtocol = 0---------------------------------------------------------------------------------- SockAddr--instance Show SockAddr where-#if defined(DOMAIN_SOCKET_SUPPORT)-  showsPrec _ (SockAddrUnix str) = showString str-#endif-  showsPrec _ (SockAddrInet port ha)-   = showString (unsafePerformIO (inet_ntoa ha))-   . showString ":"-   . shows port-#if defined(IPV6_SOCKET_SUPPORT)-  showsPrec _ addr@(SockAddrInet6 port _ _ _)-   = showChar '['-   . showString (unsafePerformIO $-                 fst `liftM` getNameInfo [NI_NUMERICHOST] True False addr >>=-                 maybe (fail "showsPrec: impossible internal error") return)-   . showString "]:"-   . shows port-#endif-#if defined(CAN_SOCKET_SUPPORT)-  showsPrec _ (SockAddrCan ifidx) = shows ifidx-#endif-#if !(defined(IPV6_SOCKET_SUPPORT) \-      && defined(DOMAIN_SOCKET_SUPPORT) && defined(CAN_SOCKET_SUPPORT))-  showsPrec _ _ = error "showsPrec: not supported"-#endif---------------------------------------------------------------------------------- Connection Functions---- In the following connection and binding primitives.  The names of--- the equivalent C functions have been preserved where possible. It--- should be noted that some of these names used in the C library,--- \tr{bind} in particular, have a different meaning to many Haskell--- programmers and have thus been renamed by appending the prefix--- Socket.---- | Create a new socket using the given address family, socket type--- and protocol number.  The address family is usually 'AF_INET',--- 'AF_INET6', or 'AF_UNIX'.  The socket type is usually 'Stream' or--- 'Datagram'.  The protocol number is usually 'defaultProtocol'.--- If 'AF_INET6' is used and the socket type is 'Stream' or 'Datagram',--- the 'IPv6Only' socket option is set to 0 so that both IPv4 and IPv6--- can be handled with one socket.------ >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream }--- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "5000")--- >>> sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)--- >>> bind sock (addrAddress addr)--- >>> getSocketName sock--- 127.0.0.1:5000-socket :: Family         -- Family Name (usually AF_INET)-       -> SocketType     -- Socket Type (usually Stream)-       -> ProtocolNumber -- Protocol Number (getProtocolByName to find value)-       -> IO Socket      -- Unconnected Socket-socket family stype protocol = do-    c_stype <- packSocketTypeOrThrow "socket" stype-    fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $-                c_socket (packFamily family) c_stype protocol-    setNonBlockIfNeeded fd-    sock <- mkSocket fd family stype protocol NotConnected-#if HAVE_DECL_IPV6_V6ONLY-    -- The default value of the IPv6Only option is platform specific,-    -- so we explicitly set it to 0 to provide a common default.-# if defined(mingw32_HOST_OS)-    -- The IPv6Only option is only supported on Windows Vista and later,-    -- so trying to change it might throw an error.-    when (family == AF_INET6 && (stype == Stream || stype == Datagram)) $-      E.catch (setSocketOption sock IPv6Only 0) $ (\(_ :: E.IOException) -> return ())-# elif !defined(__OpenBSD__)-    when (family == AF_INET6 && (stype == Stream || stype == Datagram)) $-      setSocketOption sock IPv6Only 0 `onException` close sock-# endif-#endif-    return sock---- | Build a pair of connected socket objects using the given address--- family, socket type, and protocol number.  Address family, socket--- type, and protocol number are as for the 'socket' function above.--- Availability: Unix.-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-    _rc <- throwSocketErrorIfMinus1Retry "Network.Socket.socketpair" $-                c_socketpair (packFamily family) c_stype protocol fdArr-    [fd1,fd2] <- peekArray 2 fdArr-    s1 <- mkNonBlockingSocket fd1-    s2 <- mkNonBlockingSocket fd2-    return (s1,s2)-  where-    mkNonBlockingSocket fd = do-       setNonBlockIfNeeded fd-       mkSocket fd family stype protocol Connected--foreign import ccall unsafe "socketpair"-  c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt-#else-socketPair _ _ _ = error "Network.Socket.socketPair"-#endif---------------------------------------------------------------------------------#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--- 'defaultPort' is passed then the system assigns the next available--- use port.-bind :: Socket    -- Unconnected Socket-           -> SockAddr  -- Address to Bind to-           -> IO ()-bind (MkSocket s _family _stype _protocol socketStatus) addr = do- modifyMVar_ socketStatus $ \ status -> do- if status /= NotConnected-  then-   ioError $ userError $-     "Network.Socket.bind: can't bind to socket with status " ++ show status-  else do-   withSockAddr addr $ \p_addr sz -> do-   _status <- throwSocketErrorIfMinus1Retry "Network.Socket.bind" $-     c_bind s p_addr (fromIntegral sz)-   return Bound---------------------------------------------------------------------------------- Connecting a socket---- | Connect to a remote socket at address.-connect :: Socket    -- Unconnected Socket-        -> SockAddr  -- Socket address stuff-        -> IO ()-connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = withSocketsDo $ do- modifyMVar_ socketStatus $ \currentStatus -> do- if currentStatus /= NotConnected && currentStatus /= Bound-  then-    ioError $ userError $-      errLoc ++ ": can't connect to socket with status " ++ show currentStatus-  else do-    withSockAddr addr $ \p_addr sz -> do--    let connectLoop = do-           r <- c_connect s p_addr (fromIntegral sz)-           if r == -1-               then do-#if !(defined(HAVE_WINSOCK2_H))-                   err <- getErrno-                   case () of-                     _ | err == eINTR       -> connectLoop-                     _ | err == eINPROGRESS -> connectBlocked---                   _ | err == eAGAIN      -> connectBlocked-                     _otherwise             -> throwSocketError errLoc-#else-                   throwSocketError errLoc-#endif-               else return ()--        connectBlocked = do-           threadWaitWrite (fromIntegral s)-           err <- getSocketOption sock SoError-           if (err == 0)-                then return ()-                else throwSocketErrorCode errLoc (fromIntegral err)--    connectLoop-    return Connected- where-   errLoc = "Network.Socket.connect: " ++ show sock---------------------------------------------------------------------------------- Listen---- | Listen for connections made to the socket.  The second argument--- specifies the maximum number of queued connections and should be at--- least 1; the maximum value is system-dependent (usually 5).-listen :: Socket  -- Connected & Bound Socket-       -> Int     -- Queue Length-       -> IO ()-listen (MkSocket s _family _stype _protocol socketStatus) backlog = do- modifyMVar_ socketStatus $ \ status -> do- if status /= Bound-   then-     ioError $ userError $-       "Network.Socket.listen: can't listen on socket with status " ++ show status-   else do-     throwSocketErrorIfMinus1Retry_ "Network.Socket.listen" $-       c_listen s (fromIntegral backlog)-     return Listening---------------------------------------------------------------------------------- Accept------ A call to `accept' only returns when data is available on the given--- socket, unless the socket has been set to non-blocking.  It will--- return a new socket which should be used to read the incoming data and--- should then be closed. Using the socket returned by `accept' allows--- incoming requests to be queued on the original socket.---- | Accept a connection.  The socket must be bound to an address and--- listening for connections.  The return value is a pair @(conn,--- address)@ where @conn@ is a new socket object usable to send and--- receive data on the connection, and @address@ is the address bound--- to the socket on the other end of the connection.-accept :: Socket                        -- Queue Socket-       -> IO (Socket,                   -- Readable Socket-              SockAddr)                 -- Peer details--accept sock@(MkSocket s family stype protocol status) = do- currentStatus <- readMVar status- if not $ isAcceptable family stype currentStatus-   then-     ioError $ userError $-       "Network.Socket.accept: can't accept socket (" ++-         show (family, stype, protocol) ++ ") with status " ++-         show currentStatus-   else do-     let sz = sizeOfSockAddrByFamily family-     allocaBytes sz $ \ sockaddr -> do-     zeroMemory sockaddr $ fromIntegral sz-#if defined(mingw32_HOST_OS)-     new_sock <--        if threaded-           then with (fromIntegral sz) $ \ ptr_len ->-                  throwSocketErrorIfMinus1Retry "Network.Socket.accept" $-                    c_accept_safe s sockaddr ptr_len-           else do-                paramData <- c_newAcceptParams s (fromIntegral sz) sockaddr-                rc        <- asyncDoProc c_acceptDoProc paramData-                new_sock  <- c_acceptNewSock    paramData-                c_free paramData-                when (rc /= 0) $-                     throwSocketErrorCode "Network.Socket.accept" (fromIntegral rc)-                return new_sock-#else-     with (fromIntegral sz) $ \ ptr_len -> do-# ifdef HAVE_ACCEPT4-     new_sock <- throwSocketErrorIfMinus1RetryMayBlock "Network.Socket.accept"-                        (threadWaitRead (fromIntegral s))-                        (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-     sock' <- mkSocket new_sock family stype protocol Connected-     return (sock', addr)--#if defined(mingw32_HOST_OS)-foreign import ccall unsafe "HsNet.h acceptNewSock"-  c_acceptNewSock :: Ptr () -> IO CInt-foreign import ccall unsafe "HsNet.h newAcceptParams"-  c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ())-foreign import ccall unsafe "HsNet.h &acceptDoProc"-  c_acceptDoProc :: FunPtr (Ptr () -> IO Int)-foreign import ccall unsafe "free"-  c_free:: Ptr a -> IO ()-#endif---------------------------------------------------------------------------------- ** Sending and receiving data---- $sendrecv------ Do not use the @send@ and @recv@ functions defined in this section--- in new code, as they incorrectly represent binary data as a Unicode--- string.  As a result, these functions are inefficient and may lead--- to bugs in the program.  Instead use the @send@ and @recv@--- functions defined in the "Network.Socket.ByteString" module.---------------------------------------------------------------------------------- sendTo & recvFrom---- | Send data to the socket.  The recipient can be specified--- explicitly, so the socket need not be in a connected state.--- Returns the number of bytes sent.  Applications are responsible for--- ensuring that all data has been sent.------ NOTE: blocking on Windows unless you compile with -threaded (see--- GHC ticket #1129)-{-# DEPRECATED sendTo "Use sendTo defined in \"Network.Socket.ByteString\"" #-}-sendTo :: Socket        -- (possibly) bound/connected Socket-       -> String        -- Data to send-       -> SockAddr-       -> IO Int        -- Number of Bytes sent-sendTo sock xs addr = do- withCStringLen xs $ \(str, len) -> do-   sendBufTo sock str len addr---- | Send data to the socket.  The recipient can be specified--- explicitly, so the socket need not be in a connected state.--- Returns the number of bytes sent.  Applications are responsible for--- ensuring that all data has been sent.-sendBufTo :: Socket            -- (possibly) bound/connected Socket-          -> Ptr a -> Int  -- Data to send-          -> SockAddr-          -> IO Int            -- Number of Bytes sent-sendBufTo sock@(MkSocket s _family _stype _protocol _status) ptr nbytes addr = do- withSockAddr addr $ \p_addr sz -> do-   liftM fromIntegral $-     throwSocketErrorWaitWrite sock "Network.Socket.sendBufTo" $-        c_sendto s ptr (fromIntegral $ nbytes) 0{-flags-}-                        p_addr (fromIntegral sz)---- | Receive data from the socket. The socket need not be in a--- connected state. Returns @(bytes, nbytes, address)@ where @bytes@--- is a @String@ of length @nbytes@ representing the data received and--- @address@ is a 'SockAddr' representing the address of the sending--- socket.------ NOTE: blocking on Windows unless you compile with -threaded (see--- GHC ticket #1129)-{-# DEPRECATED recvFrom "Use recvFrom defined in \"Network.Socket.ByteString\"" #-}-recvFrom :: Socket -> Int -> IO (String, Int, SockAddr)-recvFrom sock nbytes =-  allocaBytes nbytes $ \ptr -> do-    (len, sockaddr) <- recvBufFrom sock ptr nbytes-    str <- peekCStringLen (ptr, len)-    return (str, len, sockaddr)---- | Receive data from the socket, writing it into buffer instead of--- creating a new string.  The socket need not be in a connected--- state. Returns @(nbytes, address)@ where @nbytes@ is the number of--- bytes received and @address@ is a 'SockAddr' representing the--- address of the sending socket.------ NOTE: blocking on Windows unless you compile with -threaded (see--- GHC ticket #1129)-recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr)-recvBufFrom sock@(MkSocket s family _stype _protocol _status) ptr nbytes- | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBufFrom")- | otherwise   =-    withNewSockAddr family $ \ptr_addr sz -> do-      alloca $ \ptr_len -> do-        poke ptr_len (fromIntegral sz)-        len <- throwSocketErrorWaitRead sock "Network.Socket.recvBufFrom" $-                   c_recvfrom s ptr (fromIntegral nbytes) 0{-flags-}-                                ptr_addr ptr_len-        let len' = fromIntegral len-        if len' == 0-         then ioError (mkEOFError "Network.Socket.recvFrom")-         else do-           flg <- isConnected sock-             -- For at least one implementation (WinSock 2), recvfrom() ignores-             -- filling in the sockaddr for connected TCP sockets. Cope with-             -- this by using getPeerName instead.-           sockaddr <--                if flg then-                   getPeerName sock-                else-                   peekSockAddr ptr_addr-           return (len', sockaddr)---------------------------------------------------------------------------------- send & recv---- | Send data to the socket. The socket must be connected to a remote--- socket. Returns the number of bytes sent.  Applications are--- responsible for ensuring that all data has been sent.------ Sending data to closed socket may lead to undefined behaviour.-{-# DEPRECATED send "Use send defined in \"Network.Socket.ByteString\"" #-}-send :: Socket  -- Bound/Connected Socket-     -> String  -- Data to send-     -> IO Int  -- Number of Bytes sent-send sock xs = withCStringLen xs $ \(str, len) ->-    sendBuf sock (castPtr str) len---- | Send data to the socket. The socket must be connected to a remote--- socket. Returns the number of bytes sent.  Applications are--- responsible for ensuring that all data has been sent.------ Sending data to closed socket may lead to undefined behaviour.-sendBuf :: Socket     -- Bound/Connected Socket-        -> Ptr Word8  -- Pointer to the data to send-        -> Int        -- Length of the buffer-        -> IO Int     -- Number of Bytes sent-sendBuf sock@(MkSocket s _family _stype _protocol _status) str len = do-   liftM fromIntegral $-#if defined(mingw32_HOST_OS)--- writeRawBufferPtr is supposed to handle checking for errors, but it's broken--- on x86_64 because of GHC bug #12010 so we duplicate the check here. The call--- to throwSocketErrorIfMinus1Retry can be removed when no GHC version with the--- bug is supported.-    throwSocketErrorIfMinus1Retry "Network.Socket.sendBuf" $ writeRawBufferPtr-      "Network.Socket.sendBuf"-      (socket2FD sock)-      (castPtr str)-      0-      (fromIntegral len)-#else-     throwSocketErrorWaitWrite sock "Network.Socket.sendBuf" $-        c_send s str (fromIntegral len) 0{-flags-}-#endif----- | Receive data from the socket.  The socket must be in a connected--- state. This function may return fewer bytes than specified.  If the--- message is longer than the specified length, it may be discarded--- depending on the type of socket.  This function may block until a--- message arrives.------ Considering hardware and network realities, the maximum number of--- bytes to receive should be a small power of 2, e.g., 4096.------ For TCP sockets, a zero length return value means the peer has--- closed its half side of the connection.------ Receiving data from closed socket may lead to undefined behaviour.-{-# DEPRECATED recv "Use recv defined in \"Network.Socket.ByteString\"" #-}-recv :: Socket -> Int -> IO String-recv sock l = fst <$> recvLen sock l--{-# 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-        len <- recvBuf sock ptr nbytes-        s <- peekCStringLen (castPtr ptr,len)-        return (s, len)---- | Receive data from the socket.  The socket must be in a connected--- state. This function may return fewer bytes than specified.  If the--- message is longer than the specified length, it may be discarded--- depending on the type of socket.  This function may block until a--- message arrives.------ Considering hardware and network realities, the maximum number of--- bytes to receive should be a small power of 2, e.g., 4096.------ For TCP sockets, a zero length return value means the peer has--- closed its half side of the connection.------ Receiving data from closed socket may lead to undefined behaviour.-recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int-recvBuf sock@(MkSocket s _family _stype _protocol _status) ptr nbytes- | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf")- | otherwise   = do-        len <--#if defined(mingw32_HOST_OS)--- see comment in sendBuf above.-            throwSocketErrorIfMinus1Retry "Network.Socket.recvBuf" $-                readRawBufferPtr "Network.Socket.recvBuf"-                (socket2FD sock) ptr 0 (fromIntegral nbytes)-#else-               throwSocketErrorWaitRead sock "Network.Socket.recvBuf" $-                   c_recv s (castPtr ptr) (fromIntegral nbytes) 0{-flags-}-#endif-        let len' = fromIntegral len-        if len' == 0-         then ioError (mkEOFError "Network.Socket.recvBuf")-         else return len'----- ------------------------------------------------------------------------------ socketPort------ The port number the given socket is currently connected to can be--- determined by calling $port$, is generally only useful when bind--- was given $aNY\_PORT$.---- | Getting the port of socket.---   `IOError` is thrown if a port is not available.-socketPort :: Socket            -- Connected & Bound Socket-           -> IO PortNumber     -- Port Number of Socket-socketPort sock@(MkSocket _ AF_INET _ _ _) = do-    (SockAddrInet port _) <- getSocketName sock-    return port-#if defined(IPV6_SOCKET_SUPPORT)-socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do-    (SockAddrInet6 port _ _ _) <- getSocketName sock-    return port-#endif-socketPort (MkSocket _ family _ _ _) =-    ioError $ userError $-      "Network.Socket.socketPort: address family '" ++ show family ++-      "' not supported."----- ------------------------------------------------------------------------------ socketPortSafe--- | Getting the port of socket.-socketPortSafe :: Socket                -- Connected & Bound Socket-               -> IO (Maybe PortNumber) -- Port Number of Socket-socketPortSafe s = do-    sa <- getSocketName s-    return $ case sa of-      SockAddrInet port _      -> Just port-#if defined(IPV6_SOCKET_SUPPORT)-      SockAddrInet6 port _ _ _ -> Just port-#endif-      _                        -> Nothing---- ------------------------------------------------------------------------------ getPeerName---- Calling $getPeerName$ returns the address details of the machine,--- other than the local one, which is connected to the socket. This is--- used in programs such as FTP to determine where to send the--- returning data.  The corresponding call to get the details of the--- local machine is $getSocketName$.--getPeerName   :: Socket -> IO SockAddr-getPeerName (MkSocket s family _ _ _) = do- withNewSockAddr family $ \ptr sz -> do-   with (fromIntegral sz) $ \int_star -> do-   throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerName" $-     c_getpeername s ptr int_star-   _sz <- peek int_star-   peekSockAddr ptr--getSocketName :: Socket -> IO SockAddr-getSocketName (MkSocket s family _ _ _) = do- withNewSockAddr family $ \ptr sz -> do-   with (fromIntegral sz) $ \int_star -> do-   throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketName" $-     c_getsockname s ptr int_star-   peekSockAddr ptr---------------------------------------------------------------------------------- Socket Properties---- | Socket options for use with 'setSocketOption' and 'getSocketOption'.------ The existence of a constructor does not imply that the relevant option--- is supported on your system: see 'isSupportedSocketOption'-data SocketOption-    = Debug         -- ^ SO_DEBUG-    | ReuseAddr     -- ^ SO_REUSEADDR-    | Type          -- ^ SO_TYPE-    | SoError       -- ^ SO_ERROR-    | DontRoute     -- ^ SO_DONTROUTE-    | Broadcast     -- ^ SO_BROADCAST-    | SendBuffer    -- ^ SO_SNDBUF-    | RecvBuffer    -- ^ SO_RCVBUF-    | KeepAlive     -- ^ SO_KEEPALIVE-    | OOBInline     -- ^ SO_OOBINLINE-    | TimeToLive    -- ^ IP_TTL-    | MaxSegment    -- ^ TCP_MAXSEG-    | NoDelay       -- ^ TCP_NODELAY-    | Cork          -- ^ TCP_CORK-    | Linger        -- ^ SO_LINGER-    | ReusePort     -- ^ SO_REUSEPORT-    | RecvLowWater  -- ^ SO_RCVLOWAT-    | SendLowWater  -- ^ SO_SNDLOWAT-    | RecvTimeOut   -- ^ SO_RCVTIMEO-    | SendTimeOut   -- ^ SO_SNDTIMEO-    | UseLoopBack   -- ^ SO_USELOOPBACK-    | UserTimeout   -- ^ TCP_USER_TIMEOUT-    | IPv6Only      -- ^ IPV6_V6ONLY-    | CustomSockOpt (CInt, CInt)-    deriving (Show, Typeable)---- | Does the 'SocketOption' exist on this system?-isSupportedSocketOption :: SocketOption -> Bool-isSupportedSocketOption = isJust . packSocketOption---- | For a socket option, return Just (level, value) where level is the--- corresponding C option level constant (e.g. SOL_SOCKET) and value is--- the option constant itself (e.g. SO_DEBUG)--- If either constant does not exist, return Nothing.-packSocketOption :: SocketOption -> Maybe (CInt, CInt)-packSocketOption so =-  -- The Just here is a hack to disable GHC's overlapping pattern detection:-  -- the problem is if all constants are present, the fallback pattern is-  -- redundant, but if they aren't then it isn't. Hence we introduce an-  -- extra pattern (Nothing) that can't possibly happen, so that the-  -- fallback is always (in principle) necessary.-  -- I feel a little bad for including this, but such are the sacrifices we-  -- make while working with CPP - excluding the fallback pattern correctly-  -- would be a serious nuisance.-  -- (NB: comments elsewhere in this file refer to this one)-  case Just so of-#ifdef SOL_SOCKET-#ifdef SO_DEBUG-    Just Debug         -> Just ((#const SOL_SOCKET), (#const SO_DEBUG))-#endif-#ifdef SO_REUSEADDR-    Just ReuseAddr     -> Just ((#const SOL_SOCKET), (#const SO_REUSEADDR))-#endif-#ifdef SO_TYPE-    Just Type          -> Just ((#const SOL_SOCKET), (#const SO_TYPE))-#endif-#ifdef SO_ERROR-    Just SoError       -> Just ((#const SOL_SOCKET), (#const SO_ERROR))-#endif-#ifdef SO_DONTROUTE-    Just DontRoute     -> Just ((#const SOL_SOCKET), (#const SO_DONTROUTE))-#endif-#ifdef SO_BROADCAST-    Just Broadcast     -> Just ((#const SOL_SOCKET), (#const SO_BROADCAST))-#endif-#ifdef SO_SNDBUF-    Just SendBuffer    -> Just ((#const SOL_SOCKET), (#const SO_SNDBUF))-#endif-#ifdef SO_RCVBUF-    Just RecvBuffer    -> Just ((#const SOL_SOCKET), (#const SO_RCVBUF))-#endif-#ifdef SO_KEEPALIVE-    Just KeepAlive     -> Just ((#const SOL_SOCKET), (#const SO_KEEPALIVE))-#endif-#ifdef SO_OOBINLINE-    Just OOBInline     -> Just ((#const SOL_SOCKET), (#const SO_OOBINLINE))-#endif-#ifdef SO_LINGER-    Just Linger        -> Just ((#const SOL_SOCKET), (#const SO_LINGER))-#endif-#ifdef SO_REUSEPORT-    Just ReusePort     -> Just ((#const SOL_SOCKET), (#const SO_REUSEPORT))-#endif-#ifdef SO_RCVLOWAT-    Just RecvLowWater  -> Just ((#const SOL_SOCKET), (#const SO_RCVLOWAT))-#endif-#ifdef SO_SNDLOWAT-    Just SendLowWater  -> Just ((#const SOL_SOCKET), (#const SO_SNDLOWAT))-#endif-#ifdef SO_RCVTIMEO-    Just RecvTimeOut   -> Just ((#const SOL_SOCKET), (#const SO_RCVTIMEO))-#endif-#ifdef SO_SNDTIMEO-    Just SendTimeOut   -> Just ((#const SOL_SOCKET), (#const SO_SNDTIMEO))-#endif-#ifdef SO_USELOOPBACK-    Just UseLoopBack   -> Just ((#const SOL_SOCKET), (#const SO_USELOOPBACK))-#endif-#endif // SOL_SOCKET-#if HAVE_DECL_IPPROTO_IP-#ifdef IP_TTL-    Just TimeToLive    -> Just ((#const IPPROTO_IP), (#const IP_TTL))-#endif-#endif // HAVE_DECL_IPPROTO_IP-#if HAVE_DECL_IPPROTO_TCP-#ifdef TCP_MAXSEG-    Just MaxSegment    -> Just ((#const IPPROTO_TCP), (#const TCP_MAXSEG))-#endif-#ifdef TCP_NODELAY-    Just NoDelay       -> Just ((#const IPPROTO_TCP), (#const TCP_NODELAY))-#endif-#ifdef TCP_USER_TIMEOUT-    Just UserTimeout   -> Just ((#const IPPROTO_TCP), (#const TCP_USER_TIMEOUT))-#endif-#ifdef TCP_CORK-    Just Cork          -> Just ((#const IPPROTO_TCP), (#const TCP_CORK))-#endif-#endif // HAVE_DECL_IPPROTO_TCP-#if HAVE_DECL_IPPROTO_IPV6-#if HAVE_DECL_IPV6_V6ONLY-    Just IPv6Only      -> Just ((#const IPPROTO_IPV6), (#const IPV6_V6ONLY))-#endif-#endif // HAVE_DECL_IPPROTO_IPV6-    Just (CustomSockOpt opt) -> Just opt-    _             -> Nothing---- | Return the option level and option value if they exist,--- otherwise throw an error that begins "Network.Socket." ++ the String--- parameter-packSocketOption' :: String -> SocketOption -> IO (CInt, CInt)-packSocketOption' caller so = maybe err return (packSocketOption so)- where-  err = ioError . userError . concat $ ["Network.Socket.", caller,-    ": socket option ", show so, " unsupported on this system"]---- | Set a socket option that expects an Int value.--- There is currently no API to set e.g. the timeval socket options-setSocketOption :: Socket-                -> SocketOption -- Option Name-                -> Int          -- Option Value-                -> IO ()-setSocketOption (MkSocket s _ _ _ _) so v = do-   (level, opt) <- packSocketOption' "setSocketOption" so-   with (fromIntegral v) $ \ptr_v -> do-   throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $-       c_setsockopt s level opt ptr_v-          (fromIntegral (sizeOf (undefined :: CInt)))-   return ()----- | Get a socket option that gives an Int value.--- There is currently no API to get e.g. the timeval socket options-getSocketOption :: Socket-                -> SocketOption  -- Option Name-                -> IO Int        -- Option Value-getSocketOption (MkSocket s _ _ _ _) so = do-   (level, opt) <- packSocketOption' "getSocketOption" so-   alloca $ \ptr_v ->-     with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do-       throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketOption" $-         c_getsockopt s level opt ptr_v ptr_sz-       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)--- on domain sockets.--- GETPEEREID(3) returns userID and groupID. processID is always 0.-getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt)-getPeerCred sock = do-#ifdef HAVE_STRUCT_UCRED-  let fd = fdSocket sock-  let sz = (#const sizeof(struct ucred))-  allocaBytes sz $ \ ptr_cr ->-   with (fromIntegral sz) $ \ ptr_sz -> do-     _ <- ($) throwSocketErrorIfMinus1Retry "Network.Socket.getPeerCred" $-       c_getsockopt fd (#const SOL_SOCKET) (#const SO_PEERCRED) ptr_cr ptr_sz-     pid <- (#peek struct ucred, pid) ptr_cr-     uid <- (#peek struct ucred, uid) ptr_cr-     gid <- (#peek struct ucred, gid) ptr_cr-     return (pid, uid, gid)-#else-  (uid,gid) <- getPeerEid sock-  return (0,uid,gid)-#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)-getPeerEid sock = do-  let fd = fdSocket sock-  alloca $ \ ptr_uid ->-    alloca $ \ ptr_gid -> do-      throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerEid" $-        c_getpeereid fd ptr_uid ptr_gid-      uid <- peek ptr_uid-      gid <- peek ptr_gid-      return (uid, gid)-#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---- 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-  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 "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)---- | Converts the from host byte order to network byte order.-foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32--- | 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---- | This is the value of SOMAXCONN, typically 128.--- 128 is good enough for normal network servers but--- is too small for high performance servers.-maxListenQueue :: Int-maxListenQueue = sOMAXCONN---- -------------------------------------------------------------------------------data ShutdownCmd- = ShutdownReceive- | ShutdownSend- | ShutdownBoth- deriving Typeable--sdownCmdToInt :: ShutdownCmd -> CInt-sdownCmdToInt ShutdownReceive = 0-sdownCmdToInt ShutdownSend    = 1-sdownCmdToInt ShutdownBoth    = 2---- | Shut down one or both halves of the connection, depending on the--- second argument to the function.  If the second argument is--- 'ShutdownReceive', further receives are disallowed.  If it is--- 'ShutdownSend', further sends are disallowed.  If it is--- 'ShutdownBoth', further sends and receives are disallowed.-shutdown :: Socket -> ShutdownCmd -> IO ()-shutdown (MkSocket s _ _ _ _) stype = do-  throwSocketErrorIfMinus1Retry_ "Network.Socket.shutdown" $-    c_shutdown s (sdownCmdToInt stype)-  return ()---- --------------------------------------------------------------------------------- | Close the socket. This function does not throw exceptions even if---   the underlying system call returns errors.------   Sending data to or receiving data from closed socket---   may lead to undefined behaviour.------   If multiple threads use the same socket and one uses 'fdSocket' and---   the other use 'close', unexpected behavior may happen.---   For more information, please refer to the documentation of 'fdSocket'.-close :: Socket -> IO ()-close (MkSocket s _ _ _ socketStatus) = modifyMVar_ socketStatus $ \ status ->-   case status of-     ConvertedToHandle -> return ConvertedToHandle-     Closed            -> return Closed-     _                 -> do-         -- closeFdWith avoids the deadlock of IO manager.-         closeFdWith (void . c_close . fromIntegral) (fromIntegral s)-         return Closed---- | Close the socket. This function throws exceptions if---   the underlying system call returns errors.------   Sending data to or receiving data from closed socket---   may lead to undefined behaviour.-close' :: Socket -> IO ()-close' (MkSocket s _ _ _ socketStatus) = modifyMVar_ socketStatus $ \ status ->-   case status of-     ConvertedToHandle -> ioError (userError ("close: converted to a Handle, use hClose instead"))-     Closed            -> return Closed-     _                 -> do-         -- closeFdWith avoids the deadlock of IO manager.-         -- closeFd throws exceptions.-         closeFdWith (closeFd . fromIntegral) (fromIntegral s)-         return Closed---- --------------------------------------------------------------------------------- | Determines whether 'close' has been used on the 'Socket'. This--- does /not/ indicate any status about the socket beyond this. If the--- socket has been closed remotely, this function can still return--- 'True'.-isConnected :: Socket -> IO Bool-isConnected (MkSocket _ _ _ _ status) = do-    value <- readMVar status-    return (value == Connected)-{-# DEPRECATED isConnected "SocketStatus will be removed" #-}---- -------------------------------------------------------------------------------- Socket Predicates--isBound :: Socket -> IO Bool-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)-isAcceptable AF_UNIX sockTyp status-    | sockTyp == Stream || sockTyp == SeqPacket =-        status == Connected || status == Bound || status == Listening-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 \"getAddrInfo\" instead" #-}-inet_addr :: String -> IO HostAddress-inet_addr ipstr = withSocketsDo $ do-   withCString ipstr $ \str -> do-   had <- c_inet_addr str-   if had == maxBound-    then ioError $ userError $-      "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-  peekCString pstr---- | Turns a Socket into an 'Handle'. By default, the new handle is--- unbuffered. Use 'System.IO.hSetBuffering' to change the buffering.------ Note that since a 'Handle' is automatically closed by a finalizer--- when it is no longer referenced, you should avoid doing any more--- operations on the 'Socket' after calling 'socketToHandle'.  To--- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose'--- on the 'Handle'.--socketToHandle :: Socket -> IOMode -> IO Handle-socketToHandle s@(MkSocket fd _ _ _ socketStatus) mode = do- modifyMVar socketStatus $ \ status ->-    if status == ConvertedToHandle-        then ioError (userError ("socketToHandle: already a Handle"))-        else do-    h <- fdToHandle' (fromIntegral fd) (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-}-    hSetBuffering h NoBuffering-    return (ConvertedToHandle, h)---- | Pack a list of values into a bitmask.  The possible mappings from--- value to bit-to-set are given as the first argument.  We assume--- that each value can cause exactly one bit to be set; unpackBits will--- break if this property is not true.--packBits :: (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b--packBits mapping xs = foldl' pack 0 mapping-    where pack acc (k, v) | k `elem` xs = acc .|. v-                          | otherwise   = acc---- | Unpack a bitmask into a list of values.--unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a]---- Be permissive and ignore unknown bit values. At least on OS X,--- getaddrinfo returns an ai_flags field with bits set that have no--- entry in <netdb.h>.-unpackBits [] _    = []-unpackBits ((k,v):xs) r-    | r .&. v /= 0 = k : unpackBits xs (r .&. complement v)-    | otherwise    = unpackBits xs r---------------------------------------------------------------------------------- Address and service lookups--#if defined(IPV6_SOCKET_SUPPORT)---- | Flags that control the querying behaviour of 'getAddrInfo'.---   For more information, see <https://tools.ietf.org/html/rfc3493#page-25>-data AddrInfoFlag =-    -- | The list of returned 'AddrInfo' values will-    --   only contain IPv4 addresses if the local system has at least-    --   one IPv4 interface configured, and likewise for IPv6.-    --   (Only some platforms support this.)-      AI_ADDRCONFIG-    -- | If 'AI_ALL' is specified, return all matching IPv6 and-    --   IPv4 addresses.  Otherwise, this flag has no effect.-    --   (Only some platforms support this.)-    | AI_ALL-    -- | The 'addrCanonName' field of the first returned-    --   'AddrInfo' will contain the "canonical name" of the host.-    | AI_CANONNAME-    -- | The 'HostName' argument /must/ be a numeric-    --   address in string form, and network name lookups will not be-    --   attempted.-    | AI_NUMERICHOST-    -- | The 'ServiceName' argument /must/ be a port-    --   number in string form, and service name lookups will not be-    --   attempted. (Only some platforms support this.)-    | AI_NUMERICSERV-    -- | If no 'HostName' value is provided, the network-    --   address in each 'SockAddr'-    --   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-    --   addresses are found, IPv6-mapped IPv4 addresses will be-    --   returned. (Only some platforms support this.)-    | AI_V4MAPPED-    deriving (Eq, Read, Show, Typeable)--aiFlagMapping :: [(AddrInfoFlag, CInt)]--aiFlagMapping =-    [-#if HAVE_DECL_AI_ADDRCONFIG-     (AI_ADDRCONFIG, #const AI_ADDRCONFIG),-#else-     (AI_ADDRCONFIG, 0),-#endif-#if HAVE_DECL_AI_ALL-     (AI_ALL, #const AI_ALL),-#else-     (AI_ALL, 0),-#endif-     (AI_CANONNAME, #const AI_CANONNAME),-     (AI_NUMERICHOST, #const AI_NUMERICHOST),-#if HAVE_DECL_AI_NUMERICSERV-     (AI_NUMERICSERV, #const AI_NUMERICSERV),-#else-     (AI_NUMERICSERV, 0),-#endif-     (AI_PASSIVE, #const AI_PASSIVE),-#if HAVE_DECL_AI_V4MAPPED-     (AI_V4MAPPED, #const AI_V4MAPPED)-#else-     (AI_V4MAPPED, 0)-#endif-    ]---- | Indicate whether the given 'AddrInfoFlag' will have any effect on--- this system.-addrInfoFlagImplemented :: AddrInfoFlag -> Bool-addrInfoFlagImplemented f = packBits aiFlagMapping [f] /= 0--data AddrInfo =-    AddrInfo {-        addrFlags :: [AddrInfoFlag],-        addrFamily :: Family,-        addrSocketType :: SocketType,-        addrProtocol :: ProtocolNumber,-        addrAddress :: SockAddr,-        addrCanonName :: Maybe String-        }-    deriving (Eq, Show, Typeable)--instance Storable AddrInfo where-    sizeOf    _ = #const sizeof(struct addrinfo)-    alignment _ = alignment (undefined :: CInt)--    peek p = do-        ai_flags <- (#peek struct addrinfo, ai_flags) p-        ai_family <- (#peek struct addrinfo, ai_family) p-        ai_socktype <- (#peek struct addrinfo, ai_socktype) p-        ai_protocol <- (#peek struct addrinfo, ai_protocol) p-        ai_addr <- (#peek struct addrinfo, ai_addr) p >>= peekSockAddr-        ai_canonname_ptr <- (#peek struct addrinfo, ai_canonname) p--        ai_canonname <- if ai_canonname_ptr == nullPtr-                        then return Nothing-                        else liftM Just $ peekCString ai_canonname_ptr--        socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype-        return (AddrInfo-                {-                 addrFlags = unpackBits aiFlagMapping ai_flags,-                 addrFamily = unpackFamily ai_family,-                 addrSocketType = socktype,-                 addrProtocol = ai_protocol,-                 addrAddress = ai_addr,-                 addrCanonName = ai_canonname-                })--    poke p (AddrInfo flags family socketType protocol _ _) = do-        c_stype <- packSocketTypeOrThrow "AddrInfo.poke" socketType--        (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags)-        (#poke struct addrinfo, ai_family) p (packFamily family)-        (#poke struct addrinfo, ai_socktype) p c_stype-        (#poke struct addrinfo, ai_protocol) p protocol--        -- stuff below is probably not needed, but let's zero it for safety--        (#poke struct addrinfo, ai_addrlen) p (0::CSize)-        (#poke struct addrinfo, ai_addr) p nullPtr-        (#poke struct addrinfo, ai_canonname) p nullPtr-        (#poke struct addrinfo, ai_next) p nullPtr---- | Flags that control the querying behaviour of 'getNameInfo'.---   For more information, see <https://tools.ietf.org/html/rfc3493#page-30>-data NameInfoFlag =-    -- | Resolve a datagram-based service name.  This is-    --   required only for the few protocols that have different port-    --   numbers for their datagram-based versions than for their-    --   stream-based versions.-      NI_DGRAM-    -- | If the hostname cannot be looked up, an IO error is thrown.-    | NI_NAMEREQD-    -- | If a host is local, return only the hostname part of the FQDN.-    | NI_NOFQDN-    -- | The name of the host is not looked up.-    --   Instead, a numeric representation of the host's-    --   address is returned.  For an IPv4 address, this will be a-    --   dotted-quad string.  For IPv6, it will be colon-separated-    --   hexadecimal.-    | NI_NUMERICHOST-    -- | The name of the service is not-    --   looked up.  Instead, a numeric representation of the-    --   service is returned.-    | NI_NUMERICSERV-    deriving (Eq, Read, Show, Typeable)--niFlagMapping :: [(NameInfoFlag, CInt)]--niFlagMapping = [(NI_DGRAM, #const NI_DGRAM),-                 (NI_NAMEREQD, #const NI_NAMEREQD),-                 (NI_NOFQDN, #const NI_NOFQDN),-                 (NI_NUMERICHOST, #const NI_NUMERICHOST),-                 (NI_NUMERICSERV, #const NI_NUMERICSERV)]---- | Default hints for address lookup with 'getAddrInfo'.  The values--- of the 'addrAddress' and 'addrCanonName' fields are 'undefined',--- and are never inspected by 'getAddrInfo'.------ >>> addrFlags defaultHints--- []--- >>> addrFamily defaultHints--- AF_UNSPEC--- >>> addrSocketType defaultHints--- NoSocketType--- >>> addrProtocol defaultHints--- 0--defaultHints :: AddrInfo-defaultHints = AddrInfo {-                         addrFlags = [],-                         addrFamily = AF_UNSPEC,-                         addrSocketType = NoSocketType,-                         addrProtocol = defaultProtocol,-                         addrAddress = undefined,-                         addrCanonName = undefined-                        }---- | Shows the fields of 'defaultHints', without inspecting the by-default undefined fields 'addrAddress' and 'addrCanonName'.-showDefaultHints :: AddrInfo -> String-showDefaultHints AddrInfo{..} = concat-    [ "AddrInfo {"-    , "addrFlags = "-    , show addrFlags-    , ", addrFamily = "-    , show addrFamily-    , ", addrSocketType = "-    , show addrSocketType-    , ", addrProtocol = "-    , show addrProtocol-    , ", addrAddress = "-    , "<assumed to be undefined>"-    , ", addrCanonName = "-    , "<assumed to be undefined>"-    , "}"-    ]---- | Resolve a host or service name to one or more addresses.--- The 'AddrInfo' values that this function returns contain 'SockAddr'--- values that you can pass directly to 'connect' or--- 'bind'.------ This function is protocol independent.  It can return both IPv4 and--- IPv6 address information.------ The 'AddrInfo' argument specifies the preferred query behaviour,--- socket options, or protocol.  You can override these conveniently--- using Haskell's record update syntax on 'defaultHints', for example--- as follows:------ >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Stream }------ You must provide a 'Just' value for at least one of the 'HostName'--- or 'ServiceName' arguments.  'HostName' can be either a numeric--- network address (dotted quad for IPv4, colon-separated hex for--- IPv6) or a hostname.  In the latter case, its addresses will be--- looked up unless 'AI_NUMERICHOST' is specified as a hint.  If you--- do not provide a 'HostName' value /and/ do not set 'AI_PASSIVE' as--- a hint, network addresses in the result will contain the address of--- the loopback interface.------ If the query fails, this function throws an IO exception instead of--- returning an empty list.  Otherwise, it returns a non-empty list--- of 'AddrInfo' values.------ There are several reasons why a query might result in several--- values.  For example, the queried-for host could be multihomed, or--- the service might be available via several protocols.------ Note: the order of arguments is slightly different to that defined--- for @getaddrinfo@ in RFC 2553.  The 'AddrInfo' parameter comes first--- to make partial application easier.------ >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "http")--- >>> addrAddress addr--- 127.0.0.1:80--getAddrInfo :: Maybe AddrInfo -- ^ preferred socket type or protocol-            -> Maybe HostName -- ^ host name to look up-            -> Maybe ServiceName -- ^ service name to look up-            -> IO [AddrInfo] -- ^ resolved addresses, with "best" first--getAddrInfo hints node service = withSocketsDo $-  maybeWith withCString node $ \c_node ->-    maybeWith withCString service $ \c_service ->-      maybeWith with filteredHints $ \c_hints ->-        alloca $ \ptr_ptr_addrs -> do-          ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs-          case ret of-            0 -> do ptr_addrs <- peek ptr_ptr_addrs-                    ais <- followAddrInfo ptr_addrs-                    c_freeaddrinfo ptr_addrs-                    return ais-            _ -> do err <- gai_strerror ret-                    let message = concat-                            [ "Network.Socket.getAddrInfo (called with preferred socket type/protocol: "-                            , maybe (show hints) showDefaultHints hints-                            , ", host name: "-                            , show node-                            , ", service name: "-                            , show service-                            , ")"-                            ]-                    ioError (ioeSetErrorString-                             (mkIOError NoSuchThing message Nothing-                              Nothing) err)-    -- Leaving out the service and using AI_NUMERICSERV causes a-    -- segfault on OS X 10.8.2. This code removes AI_NUMERICSERV-    -- (which has no effect) in that case.-  where-#if defined(darwin_HOST_OS)-    filteredHints = case service of-        Nothing -> fmap (\ h -> h { addrFlags = delete AI_NUMERICSERV (addrFlags h) }) hints-        _       -> hints-#else-    filteredHints = hints-#endif--followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]--followAddrInfo ptr_ai | ptr_ai == nullPtr = return []-                      | otherwise = do-    a <- peek ptr_ai-    as <- (#peek struct addrinfo, ai_next) ptr_ai >>= followAddrInfo-    return (a:as)--foreign import ccall safe "hsnet_getaddrinfo"-    c_getaddrinfo :: CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo)-                  -> IO CInt--foreign import ccall safe "hsnet_freeaddrinfo"-    c_freeaddrinfo :: Ptr AddrInfo -> IO ()--gai_strerror :: CInt -> IO String--#ifdef HAVE_GAI_STRERROR-gai_strerror n = c_gai_strerror n >>= peekCString--foreign import ccall safe "gai_strerror"-    c_gai_strerror :: CInt -> IO CString-#else-gai_strerror n = ioError $ userError $ "Network.Socket.gai_strerror not supported: " ++ show n-#endif--withCStringIf :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a-withCStringIf False _ f = f 0 nullPtr-withCStringIf True n f = allocaBytes n (f (fromIntegral n))---- | Resolve an address to a host or service name.--- This function is protocol independent.--- The list of 'NameInfoFlag' values controls query behaviour.------ If a host or service's name cannot be looked up, then the numeric--- form of the address or service will be returned.------ If the query fails, this function throws an IO exception.------ Example:--- @---   (hostName, _) <- getNameInfo [] True False myAddress--- @--getNameInfo :: [NameInfoFlag] -- ^ flags to control lookup behaviour-            -> Bool -- ^ whether to look up a hostname-            -> Bool -- ^ whether to look up a service name-            -> SockAddr -- ^ the address to look up-            -> IO (Maybe HostName, Maybe ServiceName)--getNameInfo flags doHost doService addr = withSocketsDo $-  withCStringIf doHost (#const NI_MAXHOST) $ \c_hostlen c_host ->-    withCStringIf doService (#const NI_MAXSERV) $ \c_servlen c_serv -> do-      withSockAddr addr $ \ptr_addr sz -> do-        ret <- c_getnameinfo ptr_addr (fromIntegral sz) c_host c_hostlen-                             c_serv c_servlen (packBits niFlagMapping flags)-        case ret of-          0 -> do-            let peekIf doIf c_val = if doIf-                                     then liftM Just $ peekCString c_val-                                     else return Nothing-            host <- peekIf doHost c_host-            serv <- peekIf doService c_serv-            return (host, serv)-          _ -> do err <- gai_strerror ret-                  let message = concat-                        [ "Network.Socket.getNameInfo (called with flags: "-                        , show flags-                        , ", hostname lookup: "-                        , show doHost-                        , ", service name lookup: "-                        , show doService-                        , ", socket address: "-                        , show addr-                        , ")"-                        ]-                  ioError (ioeSetErrorString-                           (mkIOError NoSuchThing message Nothing-                            Nothing) err)--foreign import ccall safe "hsnet_getnameinfo"-    c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString-                  -> CSize -> CInt -> IO CInt-#endif--mkInvalidRecvArgError :: String -> IOError-mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError-                                    InvalidArgument-                                    loc Nothing Nothing) "non-positive length"--mkEOFError :: String -> IOError-mkEOFError loc = ioeSetErrorString (mkIOError EOF loc Nothing Nothing) "end of file"---- ------------------------------------------------------------------------------ foreign imports from the C library--foreign import ccall unsafe "hsnet_inet_ntoa"-  c_inet_ntoa :: HostAddress -> IO (Ptr CChar)--foreign import CALLCONV unsafe "inet_addr"-  c_inet_addr :: Ptr CChar -> IO HostAddress--foreign import CALLCONV unsafe "shutdown"-  c_shutdown :: CInt -> CInt -> IO CInt--closeFd :: CInt -> IO ()-closeFd fd = throwSocketErrorIfMinus1_ "Network.Socket.close" $ c_close fd--#if !defined(WITH_WINSOCK)-foreign import ccall unsafe "close"-  c_close :: CInt -> IO CInt-#else-foreign import stdcall unsafe "closesocket"-  c_close :: CInt -> IO CInt-#endif--foreign import CALLCONV unsafe "socket"-  c_socket :: CInt -> CInt -> CInt -> IO CInt-foreign import CALLCONV unsafe "bind"-  c_bind :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt-foreign import CALLCONV SAFE_ON_WIN "connect"-  c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt-#ifdef HAVE_ACCEPT4-foreign import CALLCONV unsafe "accept4"-  c_accept4 :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt-#else-foreign import CALLCONV unsafe "accept"-  c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt-#endif-foreign import CALLCONV unsafe "listen"-  c_listen :: CInt -> CInt -> IO CInt--#if defined(mingw32_HOST_OS)-foreign import CALLCONV safe "accept"-  c_accept_safe :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt--foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool-#endif--foreign import CALLCONV unsafe "send"-  c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt-foreign import CALLCONV SAFE_ON_WIN "sendto"-  c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> CInt -> IO CInt-foreign import CALLCONV unsafe "recv"-  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt-foreign import CALLCONV SAFE_ON_WIN "recvfrom"-  c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt-foreign import CALLCONV unsafe "getpeername"-  c_getpeername :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt-foreign import CALLCONV unsafe "getsockname"-  c_getsockname :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt--foreign import CALLCONV unsafe "getsockopt"-  c_getsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt-foreign import CALLCONV unsafe "setsockopt"-  c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt--#if defined(HAVE_GETPEEREID)-foreign import CALLCONV unsafe "getpeereid"-  c_getpeereid :: CInt -> Ptr CUInt -> Ptr CUInt -> IO CInt-#endif--- ------------------------------------------------------------------------------ * Deprecated aliases---- $deprecated-aliases------ These aliases are deprecated and should not be used in new code.--- They will be removed in some future version of the package.--{-# DEPRECATED bindSocket "use 'bind'" #-}---- | Deprecated alias for 'bind'.-bindSocket :: Socket    -- Unconnected Socket-           -> SockAddr  -- Address to Bind to-           -> IO ()-bindSocket = bind--{-# DEPRECATED sClose "use 'close'" #-}---- | Deprecated alias for 'close'.-sClose :: Socket -> IO ()-sClose = close--{-# DEPRECATED sIsConnected "SocketStatus will be removed" #-}--sIsConnected :: Socket -> IO Bool-sIsConnected = isConnected--{-# DEPRECATED sIsBound "SocketStatus will be removed" #-}--sIsBound :: Socket -> IO Bool-sIsBound = isBound--{-# DEPRECATED sIsListening "SocketStatus will be removed" #-}--sIsListening :: Socket -> IO Bool-sIsListening = isListening--{-# DEPRECATED sIsReadable "SocketStatus will be removed" #-}--sIsReadable  :: Socket -> IO Bool-sIsReadable = isReadable--{-# DEPRECATED sIsWritable "SocketStatus will be removed" #-}--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
+ Network/Socket/Address.hs view
@@ -0,0 +1,25 @@+-- | This module provides extensible APIs for socket addresses.+--+module Network.Socket.Address (+    -- * Socket Address+      SocketAddress(..)+    , getPeerName+    , getSocketName+    -- * Socket operations+    , connect+    , bind+    , accept+    -- * Sending and receiving ByteString+    , sendTo+    , sendAllTo+    , recvFrom+    -- * Sending and receiving data from a buffer+    , sendBufTo+    , recvBufFrom+    ) where++import Network.Socket.ByteString.IO+import Network.Socket.Buffer+import Network.Socket.Name+import Network.Socket.Syscall+import Network.Socket.Types
+ Network/Socket/Buffer.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE CPP #-}++#include "HsNetDef.h"++module Network.Socket.Buffer (+    sendBufTo+  , sendBuf+  , recvBufFrom+  , recvBuf+  ) where++import qualified Control.Exception as E+import Foreign.Marshal.Alloc (alloca)+import GHC.IO.Exception (IOErrorType(InvalidArgument))+import System.IO.Error (mkIOError, ioeSetErrorString)++#if defined(mingw32_HOST_OS)+import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr)+#endif++import Network.Socket.Imports+import Network.Socket.Internal+import Network.Socket.Name+import Network.Socket.Types++-- | Send data to the socket.  The recipient can be specified+-- explicitly, so the socket need not be in a connected state.+-- Returns the number of bytes sent.  Applications are responsible for+-- ensuring that all data has been sent.+sendBufTo :: SocketAddress sa =>+             Socket -- (possibly) bound/connected Socket+          -> Ptr a+          -> Int         -- Data to send+          -> sa+          -> IO Int      -- Number of Bytes sent+sendBufTo s ptr nbytes sa =+  withSocketAddress sa $ \p_sa siz -> fromIntegral <$> do+    fd <- fdSocket s+    let sz = fromIntegral siz+        n = fromIntegral nbytes+        flags = 0+    throwSocketErrorWaitWrite s "Network.Socket.sendBufTo" $+      c_sendto fd ptr n flags p_sa sz++#if defined(mingw32_HOST_OS)+socket2FD :: Socket -> IO FD+socket2FD s = do+  fd <- fdSocket s+  -- HACK, 1 means True+  return $ FD{ fdFD = fd, fdIsSocket_ = 1 }+#endif++-- | Send data to the socket. The socket must be connected to a remote+-- socket. Returns the number of bytes sent.  Applications are+-- responsible for ensuring that all data has been sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+sendBuf :: Socket    -- Bound/Connected Socket+        -> Ptr Word8  -- Pointer to the data to send+        -> Int        -- Length of the buffer+        -> IO Int     -- Number of Bytes sent+sendBuf s str len = fromIntegral <$> do+#if defined(mingw32_HOST_OS)+-- writeRawBufferPtr is supposed to handle checking for errors, but it's broken+-- on x86_64 because of GHC bug #12010 so we duplicate the check here. The call+-- to throwSocketErrorIfMinus1Retry can be removed when no GHC version with the+-- bug is supported.+    fd <- socket2FD s+    let clen = fromIntegral len+    throwSocketErrorIfMinus1Retry "Network.Socket.sendBuf" $+      writeRawBufferPtr "Network.Socket.sendBuf" fd (castPtr str) 0 clen+#else+    fd <- fdSocket s+    let flags = 0+        clen = fromIntegral len+    throwSocketErrorWaitWrite s "Network.Socket.sendBuf" $+      c_send fd str clen flags+#endif++-- | Receive data from the socket, writing it into buffer instead of+-- creating a new string.  The socket need not be in a connected+-- state. Returns @(nbytes, address)@ where @nbytes@ is the number of+-- bytes received and @address@ is a 'SockAddr' representing the+-- address of the sending socket.+--+-- If the first return value is zero, it means EOF.+--+-- For 'Stream' sockets, the second return value would be invalid.+--+-- NOTE: blocking on Windows unless you compile with -threaded (see+-- GHC ticket #1129)+recvBufFrom :: SocketAddress sa => Socket -> Ptr a -> Int -> IO (Int, sa)+recvBufFrom s ptr nbytes+    | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBufFrom")+    | otherwise = withNewSocketAddress $ \ptr_sa sz -> alloca $ \ptr_len -> do+        fd <- fdSocket s+        poke ptr_len (fromIntegral sz)+        let cnbytes = fromIntegral nbytes+            flags = 0+        len <- throwSocketErrorWaitRead s "Network.Socket.recvBufFrom" $+                 c_recvfrom fd ptr cnbytes flags ptr_sa ptr_len+        sockaddr <- peekSocketAddress ptr_sa+            `E.catch` \(E.SomeException _) -> getPeerName s+        return (fromIntegral len, sockaddr)++-- | Receive data from the socket.  The socket must be in a connected+-- state. This function may return fewer bytes than specified.  If the+-- message is longer than the specified length, it may be discarded+-- depending on the type of socket.  This function may block until a+-- message arrives.+--+-- Considering hardware and network realities, the maximum number of+-- bytes to receive should be a small power of 2, e.g., 4096.+--+-- The return value is the length of received data. Zero means+-- EOF. Historical note: Version 2.8.x.y or earlier,+-- an EOF error was thrown. This was changed in version 3.0.+--+-- Receiving data from closed socket may lead to undefined behaviour.+recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int+recvBuf s ptr nbytes+ | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf")+ | otherwise   = do+#if defined(mingw32_HOST_OS)+-- see comment in sendBuf above.+    fd <- socket2FD s+    let cnbytes = fromIntegral nbytes+    len <- throwSocketErrorIfMinus1Retry "Network.Socket.recvBuf" $+             readRawBufferPtr "Network.Socket.recvBuf" fd ptr 0 cnbytes+#else+    fd <- fdSocket s+    len <- throwSocketErrorWaitRead s "Network.Socket.recvBuf" $+             c_recv fd (castPtr ptr) (fromIntegral nbytes) 0{-flags-}+#endif+    return $ fromIntegral len++mkInvalidRecvArgError :: String -> IOError+mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError+                                    InvalidArgument+                                    loc Nothing Nothing) "non-positive length"++#if !defined(mingw32_HOST_OS)+foreign import ccall unsafe "send"+  c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt+foreign import ccall unsafe "recv"+  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt+#endif+foreign import CALLCONV SAFE_ON_WIN "sendto"+  c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> CInt -> IO CInt+foreign import CALLCONV SAFE_ON_WIN "recvfrom"+  c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> Ptr CInt -> IO CInt
+ Network/Socket/ByteString.hs view
@@ -0,0 +1,95 @@+-- |+-- Module      : Network.Socket.ByteString+-- Copyright   : (c) Johan Tibell 2007-2010+-- License     : BSD-style+--+-- Maintainer  : johan.tibell@gmail.com+-- Stability   : stable+-- Portability : portable+--+-- This module provides access to the BSD /socket/ interface.  This+-- module is generally more efficient than the 'String' based network+-- functions in 'Network.Socket'.  For detailed documentation, consult+-- your favorite POSIX socket reference. All functions communicate+-- failures by converting the error number to 'System.IO.IOError'.+--+-- This module is made to be imported with 'Network.Socket' like so:+--+-- > import Network.Socket+-- > import Network.Socket.ByteString+--+module Network.Socket.ByteString+    (+    -- * Send data to a socket+      send+    , sendAll+    , sendTo+    , sendAllTo++    -- ** Vectored I/O+    -- $vectored+    , sendMany+    , sendManyTo++    -- * Receive data from a socket+    , recv+    , recvFrom+    ) where++import Data.ByteString (ByteString)++import Network.Socket.ByteString.IO hiding (sendTo, sendAllTo, recvFrom)+import qualified Network.Socket.ByteString.IO as G+import Network.Socket.Types++-- ----------------------------------------------------------------------------+-- ** Vectored I/O++-- $vectored+--+-- Vectored I\/O, also known as scatter\/gather I\/O, allows multiple+-- data segments to be sent using a single system call, without first+-- concatenating the segments.  For example, given a list of+-- @ByteString@s, @xs@,+--+-- > sendMany sock xs+--+-- is equivalent to+--+-- > sendAll sock (concat xs)+--+-- but potentially more efficient.+--+-- Vectored I\/O are often useful when implementing network protocols+-- that, for example, group data into segments consisting of one or+-- more fixed-length headers followed by a variable-length body.++-- | Send data to the socket.  The recipient can be specified+-- explicitly, so the socket need not be in a connected state.+-- Returns the number of bytes sent. Applications are responsible for+-- ensuring that all data has been sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+sendTo :: Socket -> ByteString -> SockAddr -> IO Int+sendTo = G.sendTo++-- | Send data to the socket. The recipient can be specified+-- explicitly, so the socket need not be in a connected state.  Unlike+-- 'sendTo', this function continues to send data until either all+-- data has been sent or an error occurs.  On error, an exception is+-- raised, and there is no way to determine how much data, if any, was+-- successfully sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+sendAllTo :: Socket -> ByteString -> SockAddr -> IO ()+sendAllTo = G.sendAllTo++-- | Receive data from the socket.  The socket need not be in a+-- connected state.  Returns @(bytes, address)@ where @bytes@ is a+-- 'ByteString' representing the data received and @address@ is a+-- 'SockAddr' representing the address of the sending socket.+--+-- Receiving data from closed socket may lead to undefined behaviour.+recvFrom :: Socket -> Int -> IO (ByteString, SockAddr)+recvFrom = G.recvFrom+
− Network/Socket/ByteString.hsc 
@@ -1,285 +0,0 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-{-# LANGUAGE CPP, ForeignFunctionInterface #-}-{-# LANGUAGE OverloadedStrings #-}--#include "HsNet.h"---- |--- Module      : Network.Socket.ByteString--- Copyright   : (c) Johan Tibell 2007-2010--- License     : BSD-style------ Maintainer  : johan.tibell@gmail.com--- Stability   : stable--- Portability : portable------ This module provides access to the BSD /socket/ interface.  This--- module is generally more efficient than the 'String' based network--- functions in 'Network.Socket'.  For detailed documentation, consult--- your favorite POSIX socket reference. All functions communicate--- failures by converting the error number to 'System.IO.IOError'.------ This module is made to be imported with 'Network.Socket' like so:------ > import Network.Socket hiding (send, sendTo, recv, recvFrom)--- > import Network.Socket.ByteString----module Network.Socket.ByteString-    (-    -- * Send data to a socket-      send-    , sendAll-    , sendTo-    , sendAllTo--    -- ** Vectored I/O-    -- $vectored-    , sendMany-    , sendManyTo--    -- * Receive data from a socket-    , recv-    , recvFrom-    ) where--import Control.Exception as E (catch, throwIO)-import Control.Monad (when)-import Data.ByteString (ByteString)-import Data.ByteString.Internal (createAndTrim)-import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Foreign.Marshal.Alloc (allocaBytes)-import Foreign.Ptr (castPtr)-import Network.Socket (sendBuf, sendBufTo, recvBuf, recvBufFrom)-import System.IO.Error (isEOFError)--import qualified Data.ByteString as B--import Network.Socket.ByteString.Internal-import Network.Socket.Internal-import Network.Socket.Types--#if !defined(mingw32_HOST_OS)-import Control.Monad (liftM, zipWithM_)-import Foreign.Marshal.Array (allocaArray)-import Foreign.Marshal.Utils (with)-import Foreign.Ptr (Ptr, plusPtr)-import Foreign.Storable (Storable(..))--import Network.Socket.ByteString.IOVec (IOVec(..))-import Network.Socket.ByteString.MsgHdr (MsgHdr(..))-#endif---- ------------------------------------------------------------------------------- Sending---- | Send data to the socket.  The socket must be connected to a--- remote socket.  Returns the number of bytes sent. Applications are--- responsible for ensuring that all data has been sent.------ Sending data to closed socket may lead to undefined behaviour.-send :: Socket      -- ^ Connected socket-     -> ByteString  -- ^ Data to send-     -> IO Int      -- ^ Number of bytes sent-send sock xs = unsafeUseAsCStringLen xs $ \(str, len) ->-    sendBuf sock (castPtr str) len---- | Send data to the socket.  The socket must be connected to a--- remote socket.  Unlike 'send', this function continues to send data--- until either all data has been sent or an error occurs.  On error,--- an exception is raised, and there is no way to determine how much--- data, if any, was successfully sent.------ Sending data to closed socket may lead to undefined behaviour.-sendAll :: Socket      -- ^ Connected socket-        -> ByteString  -- ^ Data to send-        -> IO ()-sendAll _    "" = return ()-sendAll sock bs = do-    sent <- send sock bs-    waitWhen0 sent sock-    when (sent >= 0) $ sendAll sock $ B.drop sent bs---- | Send data to the socket.  The recipient can be specified--- explicitly, so the socket need not be in a connected state.--- Returns the number of bytes sent. Applications are responsible for--- ensuring that all data has been sent.------ Sending data to closed socket may lead to undefined behaviour.-sendTo :: Socket      -- ^ Socket-       -> ByteString  -- ^ Data to send-       -> SockAddr    -- ^ Recipient address-       -> IO Int      -- ^ Number of bytes sent-sendTo sock xs addr =-    unsafeUseAsCStringLen xs $ \(str, len) -> sendBufTo sock str len addr---- | Send data to the socket. The recipient can be specified--- explicitly, so the socket need not be in a connected state.  Unlike--- 'sendTo', this function continues to send data until either all--- data has been sent or an error occurs.  On error, an exception is--- raised, and there is no way to determine how much data, if any, was--- successfully sent.------ Sending data to closed socket may lead to undefined behaviour.-sendAllTo :: Socket      -- ^ Socket-          -> ByteString  -- ^ Data to send-          -> SockAddr    -- ^ Recipient address-          -> IO ()-sendAllTo _    "" _    = return ()-sendAllTo sock xs addr = do-    sent <- sendTo sock xs addr-    waitWhen0 sent sock-    when (sent >= 0) $ sendAllTo sock (B.drop sent xs) addr---- ------------------------------------------------------------------------------- ** Vectored I/O---- $vectored------ Vectored I\/O, also known as scatter\/gather I\/O, allows multiple--- data segments to be sent using a single system call, without first--- concatenating the segments.  For example, given a list of--- @ByteString@s, @xs@,------ > sendMany sock xs------ is equivalent to------ > sendAll sock (concat xs)------ but potentially more efficient.------ Vectored I\/O are often useful when implementing network protocols--- that, for example, group data into segments consisting of one or--- more fixed-length headers followed by a variable-length body.---- | Send data to the socket.  The socket must be in a connected--- state.  The data is sent as if the parts have been concatenated.--- This function continues to send data until either all data has been--- sent or an error occurs.  On error, an exception is raised, and--- there is no way to determine how much data, if any, was--- successfully sent.------ Sending data to closed socket may lead to undefined behaviour.-sendMany :: Socket        -- ^ Connected socket-         -> [ByteString]  -- ^ Data to send-         -> IO ()-#if !defined(mingw32_HOST_OS)-sendMany _                          [] = return ()-sendMany sock@(MkSocket fd _ _ _ _) cs = do-    sent <- sendManyInner-    waitWhen0 sent sock-    when (sent >= 0) $ sendMany sock (remainingChunks sent cs)-  where-    sendManyInner =-      liftM fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) ->-          throwSocketErrorWaitWrite sock "Network.Socket.ByteString.sendMany" $-              c_writev (fromIntegral fd) iovsPtr-              (fromIntegral (min iovsLen (#const IOV_MAX)))-#else-sendMany sock = sendAll sock . B.concat-#endif---- | Send data to the socket.  The recipient can be specified--- explicitly, so the socket need not be in a connected state.  The--- data is sent as if the parts have been concatenated.  This function--- continues to send data until either all data has been sent or an--- error occurs.  On error, an exception is raised, and there is no--- way to determine how much data, if any, was successfully sent.------ Sending data to closed socket may lead to undefined behaviour.-sendManyTo :: Socket        -- ^ Socket-           -> [ByteString]  -- ^ Data to send-           -> SockAddr      -- ^ Recipient address-           -> IO ()-#if !defined(mingw32_HOST_OS)-sendManyTo _                          [] _    = return ()-sendManyTo sock@(MkSocket fd _ _ _ _) cs addr = do-    sent <- liftM fromIntegral sendManyToInner-    waitWhen0 sent sock-    when (sent >= 0) $ sendManyTo sock (remainingChunks sent cs) addr-  where-    sendManyToInner =-      withSockAddr addr $ \addrPtr addrSize ->-        withIOVec cs $ \(iovsPtr, iovsLen) -> do-          let msgHdr = MsgHdr-                addrPtr (fromIntegral addrSize)-                iovsPtr (fromIntegral iovsLen)-          with msgHdr $ \msgHdrPtr ->-            throwSocketErrorWaitWrite sock "Network.Socket.ByteString.sendManyTo" $-              c_sendmsg (fromIntegral fd) msgHdrPtr 0-#else-sendManyTo sock cs = sendAllTo sock (B.concat cs)-#endif---- ------------------------------------------------------------------------------- Receiving---- | Receive data from the socket.  The socket must be in a connected--- state.  This function may return fewer bytes than specified.  If--- the message is longer than the specified length, it may be--- discarded depending on the type of socket.  This function may block--- until a message arrives.------ Considering hardware and network realities, the maximum number of bytes to--- receive should be a small power of 2, e.g., 4096.------ For TCP sockets, a zero length return value means the peer has--- closed its half side of the connection.------ Receiving data from closed socket may lead to undefined behaviour.-recv :: Socket         -- ^ Connected socket-     -> Int            -- ^ Maximum number of bytes to receive-     -> IO ByteString  -- ^ Data received-recv sock nbytes-    | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")-    | otherwise  = createAndTrim nbytes $ \ptr ->-        E.catch-          (recvBuf sock ptr nbytes)-          (\e -> if isEOFError e then return 0 else throwIO e)---- | Receive data from the socket.  The socket need not be in a--- connected state.  Returns @(bytes, address)@ where @bytes@ is a--- 'ByteString' representing the data received and @address@ is a--- 'SockAddr' representing the address of the sending socket.------ Receiving data from closed socket may lead to undefined behaviour.-recvFrom :: Socket                     -- ^ Socket-         -> Int                        -- ^ Maximum number of bytes to receive-         -> IO (ByteString, SockAddr)  -- ^ Data received and sender address-recvFrom sock nbytes =-    allocaBytes nbytes $ \ptr -> do-        (len, sockaddr) <- recvBufFrom sock ptr nbytes-        str <- B.packCStringLen (ptr, len)-        return (str, sockaddr)---- ------------------------------------------------------------------------------- Not exported--#if !defined(mingw32_HOST_OS)--- | Suppose we try to transmit a list of chunks @cs@ via a gathering write--- operation and find that @n@ bytes were sent. Then @remainingChunks n cs@ is--- list of chunks remaining to be sent.-remainingChunks :: Int -> [ByteString] -> [ByteString]-remainingChunks _ [] = []-remainingChunks i (x:xs)-    | i < len        = B.drop i x : xs-    | otherwise      = let i' = i - len in i' `seq` remainingChunks i' xs-  where-    len = B.length x---- | @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@).--- /Unix only/.-withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a-withIOVec cs f =-    allocaArray csLen $ \aPtr -> do-        zipWithM_ pokeIov (ptrs aPtr) cs-        f (aPtr, csLen)-  where-    csLen = length cs-    ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec))-    pokeIov ptr s =-        unsafeUseAsCStringLen s $ \(sPtr, sLen) ->-        poke ptr $ IOVec sPtr (fromIntegral sLen)-#endif
+ Network/Socket/ByteString/IO.hsc view
@@ -0,0 +1,271 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}++#include "HsNet.h"++-- |+-- Module      : Network.Socket.ByteString+-- Copyright   : (c) Johan Tibell 2007-2010+-- License     : BSD-style+--+-- Maintainer  : johan.tibell@gmail.com+-- Stability   : stable+-- Portability : portable+--+-- This module provides access to the BSD /socket/ interface.  This+-- module is generally more efficient than the 'String' based network+-- functions in 'Network.Socket'.  For detailed documentation, consult+-- your favorite POSIX socket reference. All functions communicate+-- failures by converting the error number to 'System.IO.IOError'.+--+-- This module is made to be imported with 'Network.Socket' like so:+--+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)+-- > import Network.Socket.ByteString+--+module Network.Socket.ByteString.IO+    (+    -- * Send data to a socket+      send+    , sendAll+    , sendTo+    , sendAllTo++    -- ** Vectored I/O+    -- $vectored+    , sendMany+    , sendManyTo++    -- * Receive data from a socket+    , recv+    , recvFrom+    , waitWhen0+    ) where++import Control.Concurrent (threadWaitWrite, rtsSupportsBoundThreads)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Internal (createAndTrim)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (castPtr)++import Network.Socket.Buffer+import Network.Socket.ByteString.Internal+import Network.Socket.Imports+import Network.Socket.Types++#if !defined(mingw32_HOST_OS)+import Control.Monad (zipWithM_)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (Storable(..))+import Network.Socket.Internal++import Network.Socket.ByteString.IOVec (IOVec(..))+import Network.Socket.ByteString.MsgHdr (MsgHdr(..))+#endif++-- ----------------------------------------------------------------------------+-- Sending++-- | Send data to the socket.  The socket must be connected to a+-- remote socket.  Returns the number of bytes sent. Applications are+-- responsible for ensuring that all data has been sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+send :: Socket     -- ^ Connected socket+     -> ByteString  -- ^ Data to send+     -> IO Int      -- ^ Number of bytes sent+send s xs = unsafeUseAsCStringLen xs $ \(str, len) ->+    sendBuf s (castPtr str) len++waitWhen0 :: Int -> Socket -> IO ()+waitWhen0 0 s = when rtsSupportsBoundThreads $ do+  fd <- fromIntegral <$> fdSocket s+  threadWaitWrite fd+waitWhen0 _ _ = return ()++-- | Send data to the socket.  The socket must be connected to a+-- remote socket.  Unlike 'send', this function continues to send data+-- until either all data has been sent or an error occurs.  On error,+-- an exception is raised, and there is no way to determine how much+-- data, if any, was successfully sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+sendAll :: Socket     -- ^ Connected socket+        -> ByteString  -- ^ Data to send+        -> IO ()+sendAll _ "" = return ()+sendAll s bs = do+    sent <- send s bs+    waitWhen0 sent s+    when (sent >= 0) $ sendAll s $ B.drop sent bs++-- | Send data to the socket.  The recipient can be specified+-- explicitly, so the socket need not be in a connected state.+-- Returns the number of bytes sent. Applications are responsible for+-- ensuring that all data has been sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+sendTo :: SocketAddress sa =>+          Socket     -- ^ Socket+       -> ByteString  -- ^ Data to send+       -> sa    -- ^ Recipient address+       -> IO Int      -- ^ Number of bytes sent+sendTo s xs sa =+    unsafeUseAsCStringLen xs $ \(str, len) -> sendBufTo s str len sa++-- | Send data to the socket. The recipient can be specified+-- explicitly, so the socket need not be in a connected state.  Unlike+-- 'sendTo', this function continues to send data until either all+-- data has been sent or an error occurs.  On error, an exception is+-- raised, and there is no way to determine how much data, if any, was+-- successfully sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+sendAllTo :: SocketAddress sa =>+             Socket     -- ^ Socket+          -> ByteString  -- ^ Data to send+          -> sa    -- ^ Recipient address+          -> IO ()+sendAllTo _ "" _  = return ()+sendAllTo s xs sa = do+    sent <- sendTo s xs sa+    waitWhen0 sent s+    when (sent >= 0) $ sendAllTo s (B.drop sent xs) sa++-- | Send data to the socket.  The socket must be in a connected+-- state.  The data is sent as if the parts have been concatenated.+-- This function continues to send data until either all data has been+-- sent or an error occurs.  On error, an exception is raised, and+-- there is no way to determine how much data, if any, was+-- successfully sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+sendMany :: Socket       -- ^ Connected socket+         -> [ByteString]  -- ^ Data to send+         -> IO ()+#if !defined(mingw32_HOST_OS)+sendMany _ [] = return ()+sendMany s cs = do+    sent <- sendManyInner+    waitWhen0 sent s+    when (sent >= 0) $ sendMany s $ remainingChunks sent cs+  where+    sendManyInner =+      fmap fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) -> do+          fd <- fdSocket s+          let len =  fromIntegral $ min iovsLen (#const IOV_MAX)+          throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $+              c_writev fd iovsPtr len+#else+sendMany s = sendAll s . B.concat+#endif++-- | Send data to the socket.  The recipient can be specified+-- explicitly, so the socket need not be in a connected state.  The+-- data is sent as if the parts have been concatenated.  This function+-- continues to send data until either all data has been sent or an+-- error occurs.  On error, an exception is raised, and there is no+-- way to determine how much data, if any, was successfully sent.+--+-- Sending data to closed socket may lead to undefined behaviour.+sendManyTo :: Socket       -- ^ Socket+           -> [ByteString]  -- ^ Data to send+           -> SockAddr      -- ^ Recipient address+           -> IO ()+#if !defined(mingw32_HOST_OS)+sendManyTo _ [] _    = return ()+sendManyTo s cs addr = do+    sent <- fromIntegral <$> sendManyToInner+    waitWhen0 sent s+    when (sent >= 0) $ sendManyTo s (remainingChunks sent cs) addr+  where+    sendManyToInner =+      withSockAddr addr $ \addrPtr addrSize ->+        withIOVec cs $ \(iovsPtr, iovsLen) -> do+          let msgHdr = MsgHdr+                addrPtr (fromIntegral addrSize)+                iovsPtr (fromIntegral iovsLen)+          fd <- fdSocket s+          with msgHdr $ \msgHdrPtr ->+            throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendManyTo" $+              c_sendmsg fd msgHdrPtr 0+#else+sendManyTo s cs = sendAllTo s (B.concat cs)+#endif++-- ----------------------------------------------------------------------------+-- Receiving++-- | Receive data from the socket.  The socket must be in a connected+-- state.  This function may return fewer bytes than specified.  If+-- the message is longer than the specified length, it may be+-- discarded depending on the type of socket.  This function may block+-- until a message arrives.+--+-- Considering hardware and network realities, the maximum number of bytes to+-- receive should be a small power of 2, e.g., 4096.+--+-- For TCP sockets, a zero length return value means the peer has+-- closed its half side of the connection.+--+-- Receiving data from closed socket may lead to undefined behaviour.+recv :: Socket        -- ^ Connected socket+     -> Int            -- ^ Maximum number of bytes to receive+     -> IO ByteString  -- ^ Data received+recv s nbytes+    | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")+    | otherwise  = createAndTrim nbytes $ \ptr -> recvBuf s ptr nbytes++-- | Receive data from the socket.  The socket need not be in a+-- connected state.  Returns @(bytes, address)@ where @bytes@ is a+-- 'ByteString' representing the data received and @address@ is a+-- 'SockAddr' representing the address of the sending socket.+--+-- If the first return value is zero, it means EOF.+--+-- Receiving data from closed socket may lead to undefined behaviour.+recvFrom :: SocketAddress sa =>+            Socket                     -- ^ Socket+         -> Int                        -- ^ Maximum number of bytes to receive+         -> IO (ByteString, sa)  -- ^ Data received and sender address+recvFrom sock nbytes =+    allocaBytes nbytes $ \ptr -> do+        (len, sockaddr) <- recvBufFrom sock ptr nbytes+        str <- B.packCStringLen (ptr, len)+        return (str, sockaddr)++-- ----------------------------------------------------------------------------+-- Not exported++#if !defined(mingw32_HOST_OS)+-- | Suppose we try to transmit a list of chunks @cs@ via a gathering write+-- operation and find that @n@ bytes were sent. Then @remainingChunks n cs@ is+-- list of chunks remaining to be sent.+remainingChunks :: Int -> [ByteString] -> [ByteString]+remainingChunks _ [] = []+remainingChunks i (x:xs)+    | i < len        = B.drop i x : xs+    | otherwise      = let i' = i - len in i' `seq` remainingChunks i' xs+  where+    len = B.length x++-- | @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@).+-- /Unix only/.+withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a+withIOVec cs f =+    allocaArray csLen $ \aPtr -> do+        zipWithM_ pokeIov (ptrs aPtr) cs+        f (aPtr, csLen)+  where+    csLen = length cs+    ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec))+    pokeIov ptr s =+        unsafeUseAsCStringLen s $ \(sPtr, sLen) ->+        poke ptr $ IOVec sPtr (fromIntegral sLen)+#endif
Network/Socket/ByteString/IOVec.hsc view
@@ -5,9 +5,7 @@     ( IOVec(..)     ) where -import Foreign.C.Types (CChar, CInt, CSize)-import Foreign.Ptr (Ptr)-import Foreign.Storable (Storable(..))+import Network.Socket.Imports  #include <sys/types.h> #include <sys/uio.h>
Network/Socket/ByteString/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}+{-# LANGUAGE CPP #-}  -- | -- Module      : Network.Socket.ByteString.Internal@@ -16,25 +16,19 @@     , c_writev     , c_sendmsg #endif-    , waitWhen0     ) where +import GHC.IO.Exception (IOErrorType(..)) import System.IO.Error (ioeSetErrorString, mkIOError)  #if !defined(mingw32_HOST_OS)-import Foreign.C.Types (CInt(..)) import System.Posix.Types (CSsize(..))-import Foreign.Ptr (Ptr) +import Network.Socket.Imports import Network.Socket.ByteString.IOVec (IOVec) import Network.Socket.ByteString.MsgHdr (MsgHdr) #endif -import Control.Concurrent (threadWaitWrite, rtsSupportsBoundThreads)-import Control.Monad (when)-import GHC.IO.Exception (IOErrorType(..))-import Network.Socket.Types- mkInvalidRecvArgError :: String -> IOError mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError                                     InvalidArgument@@ -47,9 +41,3 @@ foreign import ccall unsafe "sendmsg"   c_sendmsg :: CInt -> Ptr MsgHdr -> CInt -> IO CSsize #endif--waitWhen0 :: Int -> Socket -> IO ()-waitWhen0 0 s = when rtsSupportsBoundThreads $ do-  let fd = fromIntegral $ fdSocket s-  threadWaitWrite fd-waitWhen0 _ _ = return ()
Network/Socket/ByteString/Lazy.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}- -- | -- Module      : Network.Socket.ByteString.Lazy -- Copyright   : (c) Bryan O'Sullivan 2009@@ -17,42 +16,37 @@ -- -- This module is made to be imported with 'Network.Socket' like so: ----- > import Network.Socket hiding (send, sendTo, recv, recvFrom)+-- > import Network.Socket -- > import Network.Socket.ByteString.Lazy -- > import Prelude hiding (getContents) ---module Network.Socket.ByteString.Lazy-    (+module Network.Socket.ByteString.Lazy (     -- * Send data to a socket-      send-    , sendAll-    ,-+    send+  , sendAll     -- * Receive data from a socket-      getContents-    , recv-    ) where--import Control.Monad (liftM)-import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)-import Data.Int (Int64)-import Network.Socket (Socket(..), ShutdownCmd(..), shutdown)-import Prelude hiding (getContents)-import System.IO.Unsafe (unsafeInterleaveIO)-import System.IO.Error (catchIOError)+  , getContents+  , recv+  ) where -import qualified Data.ByteString as S-import qualified Network.Socket.ByteString as N+import           Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)+import           Network.Socket                (ShutdownCmd (..), shutdown)+import           Prelude                       hiding (getContents)+import           System.IO.Unsafe              (unsafeInterleaveIO)  #if defined(mingw32_HOST_OS)-import Network.Socket.ByteString.Lazy.Windows (send, sendAll)+import Network.Socket.ByteString.Lazy.Windows  (send, sendAll) #else-import Network.Socket.ByteString.Lazy.Posix (send, sendAll)+import Network.Socket.ByteString.Lazy.Posix    (send, sendAll) #endif +import qualified Data.ByteString               as S+import qualified Network.Socket.ByteString     as N+import           Network.Socket.Imports+import           Network.Socket.Types+ -- ----------------------------------------------------------------------------- -- Receiving- -- | Receive data from the socket.  The socket must be in a connected -- state.  Data is received on demand, in chunks; each chunk will be -- sized to reflect the amount of data received by individual 'recv'@@ -62,16 +56,16 @@ -- more data to be received, the receiving side of the socket is shut -- down.  If there is an error and an exception is thrown, the socket -- is not shut down.-getContents :: Socket         -- ^ Connected socket-            -> IO ByteString  -- ^ Data received-getContents sock = loop where-  loop = unsafeInterleaveIO $ do-    s <- N.recv sock defaultChunkSize-    if S.null s-      then do-        shutdown sock ShutdownReceive `catchIOError` const (return ())-        return Empty-      else Chunk s `liftM` loop+getContents+    :: Socket -- ^ Connected socket+    -> IO ByteString -- ^ Data received+getContents s = loop+  where+    loop = unsafeInterleaveIO $ do+        sbs <- N.recv s defaultChunkSize+        if S.null sbs+            then shutdown s ShutdownReceive >> return Empty+            else Chunk sbs <$> loop  -- | Receive data from the socket.  The socket must be in a connected -- state.  This function may return fewer bytes than specified.  If@@ -82,10 +76,11 @@ -- If there is no more data to be received, returns an empty 'ByteString'. -- -- Receiving data from closed socket may lead to undefined behaviour.-recv :: Socket         -- ^ Connected socket-     -> Int64          -- ^ Maximum number of bytes to receive-     -> IO ByteString  -- ^ Data received-recv sock nbytes = chunk `liftM` N.recv sock (fromIntegral nbytes) where-  chunk k-    | S.null k  = Empty-    | otherwise = Chunk k Empty+recv+    :: Socket -- ^ Connected socket+    -> Int64 -- ^ Maximum number of bytes to receive+    -> IO ByteString -- ^ Data received+recv s nbytes = chunk <$> N.recv s (fromIntegral nbytes)+  where+    chunk k | S.null k  = Empty+            | otherwise = Chunk k Empty
Network/Socket/ByteString/Lazy/Posix.hs view
@@ -1,59 +1,58 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -module Network.Socket.ByteString.Lazy.Posix-    (+module Network.Socket.ByteString.Lazy.Posix (     -- * Send data to a socket-      send-    , sendAll-    ) where+    send+  , sendAll+  ) where -import Control.Monad (liftM, when)-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Lazy.Internal (ByteString(..))-import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.Int (Int64)-import Foreign.Marshal.Array (allocaArray)-import Foreign.Ptr (plusPtr)-import Foreign.Storable (Storable(..))+import qualified Data.ByteString.Lazy               as L+import           Data.ByteString.Unsafe             (unsafeUseAsCStringLen)+import           Foreign.Marshal.Array              (allocaArray) -import Network.Socket (Socket(..))-import Network.Socket.ByteString.IOVec (IOVec(IOVec))-import Network.Socket.ByteString.Internal (c_writev, waitWhen0)-import Network.Socket.Internal+import           Network.Socket.ByteString.Internal (c_writev)+import           Network.Socket.ByteString.IO       (waitWhen0)+import           Network.Socket.ByteString.IOVec    (IOVec (IOVec))+import           Network.Socket.Imports+import           Network.Socket.Internal+import           Network.Socket.Types  -- ----------------------------------------------------------------------------- -- Sending--send :: Socket      -- ^ Connected socket-     -> ByteString  -- ^ Data to send-     -> IO Int64    -- ^ Number of bytes sent-send sock@(MkSocket fd _ _ _ _) s = do-  let cs  = take maxNumChunks (L.toChunks s)-      len = length cs-  liftM fromIntegral . allocaArray len $ \ptr ->-    withPokes cs ptr $ \niovs ->-      throwSocketErrorWaitWrite sock "writev" $-        c_writev (fromIntegral fd) ptr niovs+send+    :: Socket -- ^ Connected socket+    -> L.ByteString -- ^ Data to send+    -> IO Int64 -- ^ Number of bytes sent+send s lbs = do+    let cs  = take maxNumChunks (L.toChunks lbs)+        len = length cs+    fd <- fdSocket s+    siz <- allocaArray len $ \ptr ->+             withPokes cs ptr $ \niovs ->+               throwSocketErrorWaitWrite s "writev" $ c_writev fd ptr niovs+    return $ fromIntegral siz   where     withPokes ss p f = loop ss p 0 0-      where loop (c:cs) q k !niovs-                | k < maxNumBytes =-                    unsafeUseAsCStringLen c $ \(ptr,len) -> do-                      poke q $ IOVec ptr (fromIntegral len)-                      loop cs (q `plusPtr` sizeOf (undefined :: IOVec))-                              (k + fromIntegral len) (niovs + 1)-                | otherwise = f niovs-            loop _ _ _ niovs = f niovs-    maxNumBytes  = 4194304 :: Int  -- maximum number of bytes to transmit in one system call-    maxNumChunks = 1024    :: Int  -- maximum number of chunks to transmit in one system call+      where+        loop (c:cs) q k !niovs+            | k < maxNumBytes = unsafeUseAsCStringLen c $ \(ptr, len) -> do+                poke q $ IOVec ptr (fromIntegral len)+                loop cs+                     (q `plusPtr` sizeOf (undefined :: IOVec))+                     (k + fromIntegral len)+                     (niovs + 1)+            | otherwise = f niovs+        loop _ _ _ niovs = f niovs+    maxNumBytes  = 4194304 :: Int -- maximum number of bytes to transmit in one system call+    maxNumChunks = 1024 :: Int -- maximum number of chunks to transmit in one system call -sendAll :: Socket      -- ^ Connected socket-        -> ByteString  -- ^ Data to send-        -> IO ()-sendAll _    "" = return ()-sendAll sock bs = do-  sent <- send sock bs-  waitWhen0 (fromIntegral sent) sock-  when (sent >= 0) $ sendAll sock $ L.drop sent bs+sendAll+    :: Socket -- ^ Connected socket+    -> L.ByteString -- ^ Data to send+    -> IO ()+sendAll _ "" = return ()+sendAll s bs = do+    sent <- send s bs+    waitWhen0 (fromIntegral sent) s+    when (sent >= 0) $ sendAll s $ L.drop sent bs
Network/Socket/ByteString/Lazy/Windows.hs view
@@ -1,40 +1,35 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -module Network.Socket.ByteString.Lazy.Windows-    (+module Network.Socket.ByteString.Lazy.Windows (     -- * Send data to a socket-      send-    , sendAll-    ) where--import Control.Applicative ((<$>))-import Control.Monad (when)-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import Data.Int (Int64)+    send+  , sendAll+  ) where -import Network.Socket (Socket(..))+import qualified Data.ByteString           as S+import qualified Data.ByteString.Lazy      as L import qualified Network.Socket.ByteString as Socket-import Network.Socket.ByteString.Internal (waitWhen0)+import           Network.Socket.Imports+import           Network.Socket.ByteString.IO       (waitWhen0)+import           Network.Socket.Types  -- ----------------------------------------------------------------------------- -- Sending--send :: Socket        -- ^ Connected socket-     -> L.ByteString  -- ^ Data to send-     -> IO Int64      -- ^ Number of bytes sent-send sock s = do-  fromIntegral <$> case L.toChunks s of-      -- TODO: Consider doing nothing if the string is empty.-      []    -> Socket.send sock S.empty-      (x:_) -> Socket.send sock x+send+    :: Socket -- ^ Connected socket+    -> L.ByteString -- ^ Data to send+    -> IO Int64 -- ^ Number of bytes sent+send s lbs = case L.toChunks lbs of+    -- TODO: Consider doing nothing if the string is empty.+    []    -> fromIntegral <$> Socket.send s S.empty+    (x:_) -> fromIntegral <$> Socket.send s x -sendAll :: Socket        -- ^ Connected socket-        -> L.ByteString  -- ^ Data to send-        -> IO ()-sendAll _    "" = return ()-sendAll sock bs = do-  sent <- send sock bs-  waitWhen0 (fromIntegral sent) sock-  when (sent >= 0) $ sendAll sock $ L.drop sent bs+sendAll+    :: Socket -- ^ Connected socket+    -> L.ByteString -- ^ Data to send+    -> IO ()+sendAll _ "" = return ()+sendAll s bs = do+    sent <- send s bs+    waitWhen0 (fromIntegral sent) s+    when (sent >= 0) $ sendAll s $ L.drop sent bs
Network/Socket/ByteString/MsgHdr.hsc view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -funbox-strict-fields #-}  -- | Support module for the POSIX 'sendmsg' system call.@@ -9,11 +8,9 @@ #include <sys/types.h> #include <sys/socket.h> -import Foreign.C.Types (CInt, CSize, CUInt)-import Foreign.Ptr (Ptr)-import Foreign.Storable (Storable(..))-import Network.Socket (SockAddr)+import Network.Socket.Imports import Network.Socket.Internal (zeroMemory)+import Network.Socket.Types (SockAddr)  import Network.Socket.ByteString.IOVec (IOVec)
+ Network/Socket/Cbits.hsc view
@@ -0,0 +1,31 @@+module Network.Socket.Cbits where++#include "HsNet.h"++import Network.Socket.Imports++-- | This is the value of SOMAXCONN, typically 128.+-- 128 is good enough for normal network servers but+-- is too small for high performance servers.+maxListenQueue :: Int+maxListenQueue = #const SOMAXCONN++#if defined(mingw32_HOST_OS)+wsaNotInitialized :: CInt+wsaNotInitialized = #const WSANOTINITIALISED+#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_ADVANCED_SOCKET_FLAGS)+sockNonBlock :: CInt+sockNonBlock = #const SOCK_NONBLOCK+sockCloexec :: CInt+sockCloexec = #const SOCK_CLOEXEC+# endif+#endif
+ Network/Socket/Fcntl.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE CPP #-}++module Network.Socket.Fcntl where++import qualified System.Posix.Internals++#if !defined(mingw32_HOST_OS)+import Network.Socket.Cbits+#endif+import Network.Socket.Imports++-- | Set the nonblocking flag on Unix.+--   On Windows, nothing is done.+setNonBlockIfNeeded :: CInt -> IO ()+setNonBlockIfNeeded fd =+    System.Posix.Internals.setNonBlockingFD fd True++-- | Set the nonblocking 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 close_on_exec 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
+ Network/Socket/Handle.hs view
@@ -0,0 +1,24 @@+module Network.Socket.Handle where++import qualified GHC.IO.Device (IODeviceType(Stream))+import GHC.IO.Handle.FD (fdToHandle')+import System.IO (IOMode(..), Handle, BufferMode(..), hSetBuffering)++import Network.Socket.Types++-- | Turns a Socket into an 'Handle'. By default, the new handle is+-- unbuffered. Use 'System.IO.hSetBuffering' to change the buffering.+--+-- Note that since a 'Handle' is automatically closed by a finalizer+-- when it is no longer referenced, you should avoid doing any more+-- operations on the 'Socket' after calling 'socketToHandle'.  To+-- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose'+-- on the 'Handle'.++socketToHandle :: Socket -> IOMode -> IO Handle+socketToHandle s mode = invalidateSocket s err $ \oldfd -> do+    h <- fdToHandle' oldfd (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-}+    hSetBuffering h NoBuffering+    return h+  where+    err _ = ioError $ userError $ "socketToHandle: socket is no longer valid"
+ Network/Socket/If.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE CPP #-}++#include "HsNetDef.h"++module Network.Socket.If (+    ifNameToIndex+  , ifIndexToName+  ) where++import Foreign.Marshal.Alloc (allocaBytes)++import Network.Socket.Imports++-- | 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
+ Network/Socket/Imports.hs view
@@ -0,0 +1,33 @@+module Network.Socket.Imports (+    module Control.Applicative+  , module Control.Monad+  , module Data.Bits+  , module Data.Int+  , module Data.List+  , module Data.Maybe+  , module Data.Monoid+  , module Data.Ord+  , module Data.Typeable+  , module Data.Word+  , module Foreign.C.String+  , module Foreign.C.Types+  , module Foreign.Ptr+  , module Foreign.Storable+  , module Numeric+  ) where++import Control.Applicative+import Control.Monad+import Data.Bits+import Data.Int+import Data.List+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.Typeable+import Data.Word+import Foreign.C.String+import Foreign.C.Types+import Foreign.Ptr+import Foreign.Storable+import Numeric
+ Network/Socket/Info.hsc view
@@ -0,0 +1,452 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++#include "HsNet.h"+##include "HsNetDef.h"++module Network.Socket.Info where++import Foreign.Marshal.Alloc (alloca, allocaBytes)+import Foreign.Marshal.Utils (maybeWith, with)+import GHC.IO (unsafePerformIO)+import GHC.IO.Exception (IOErrorType(NoSuchThing))+import System.IO.Error (ioeSetErrorString, mkIOError)++import Network.Socket.Imports+import Network.Socket.Internal+import Network.Socket.Types++-----------------------------------------------------------------------------++-- | Either a host name e.g., @\"haskell.org\"@ or a numeric host+-- address string consisting of a dotted decimal IPv4 address or an+-- IPv6 address e.g., @\"192.168.0.1\"@.+type HostName       = String+-- | Either a service name e.g., @\"http\"@ or a numeric port number.+type ServiceName    = String++-----------------------------------------------------------------------------+-- Address and service lookups++-- | Flags that control the querying behaviour of 'getAddrInfo'.+--   For more information, see <https://tools.ietf.org/html/rfc3493#page-25>+data AddrInfoFlag =+    -- | The list of returned 'AddrInfo' values will+    --   only contain IPv4 addresses if the local system has at least+    --   one IPv4 interface configured, and likewise for IPv6.+    --   (Only some platforms support this.)+      AI_ADDRCONFIG+    -- | If 'AI_ALL' is specified, return all matching IPv6 and+    --   IPv4 addresses.  Otherwise, this flag has no effect.+    --   (Only some platforms support this.)+    | AI_ALL+    -- | The 'addrCanonName' field of the first returned+    --   'AddrInfo' will contain the "canonical name" of the host.+    | AI_CANONNAME+    -- | The 'HostName' argument /must/ be a numeric+    --   address in string form, and network name lookups will not be+    --   attempted.+    | AI_NUMERICHOST+    -- | The 'ServiceName' argument /must/ be a port+    --   number in string form, and service name lookups will not be+    --   attempted. (Only some platforms support this.)+    | AI_NUMERICSERV+    -- | If no 'HostName' value is provided, the network+    --   address in each 'SockAddr'+    --   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+    --   addresses are found, IPv6-mapped IPv4 addresses will be+    --   returned. (Only some platforms support this.)+    | AI_V4MAPPED+    deriving (Eq, Read, Show, Typeable)++aiFlagMapping :: [(AddrInfoFlag, CInt)]++aiFlagMapping =+    [+#if HAVE_DECL_AI_ADDRCONFIG+     (AI_ADDRCONFIG, #const AI_ADDRCONFIG),+#else+     (AI_ADDRCONFIG, 0),+#endif+#if HAVE_DECL_AI_ALL+     (AI_ALL, #const AI_ALL),+#else+     (AI_ALL, 0),+#endif+     (AI_CANONNAME, #const AI_CANONNAME),+     (AI_NUMERICHOST, #const AI_NUMERICHOST),+#if HAVE_DECL_AI_NUMERICSERV+     (AI_NUMERICSERV, #const AI_NUMERICSERV),+#else+     (AI_NUMERICSERV, 0),+#endif+     (AI_PASSIVE, #const AI_PASSIVE),+#if HAVE_DECL_AI_V4MAPPED+     (AI_V4MAPPED, #const AI_V4MAPPED)+#else+     (AI_V4MAPPED, 0)+#endif+    ]++-- | Indicate whether the given 'AddrInfoFlag' will have any effect on+-- this system.+addrInfoFlagImplemented :: AddrInfoFlag -> Bool+addrInfoFlagImplemented f = packBits aiFlagMapping [f] /= 0++data AddrInfo = AddrInfo {+    addrFlags :: [AddrInfoFlag]+  , addrFamily :: Family+  , addrSocketType :: SocketType+  , addrProtocol :: ProtocolNumber+  , addrAddress :: SockAddr+  , addrCanonName :: Maybe String+  } deriving (Eq, Show, Typeable)++instance Storable AddrInfo where+    sizeOf    _ = #const sizeof(struct addrinfo)+    alignment _ = alignment (undefined :: CInt)++    peek p = do+        ai_flags <- (#peek struct addrinfo, ai_flags) p+        ai_family <- (#peek struct addrinfo, ai_family) p+        ai_socktype <- (#peek struct addrinfo, ai_socktype) p+        ai_protocol <- (#peek struct addrinfo, ai_protocol) p+        ai_addr <- (#peek struct addrinfo, ai_addr) p >>= peekSockAddr+        ai_canonname_ptr <- (#peek struct addrinfo, ai_canonname) p++        ai_canonname <- if ai_canonname_ptr == nullPtr+                        then return Nothing+                        else Just <$> peekCString ai_canonname_ptr++        socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype+        return $ AddrInfo {+            addrFlags = unpackBits aiFlagMapping ai_flags+          , addrFamily = unpackFamily ai_family+          , addrSocketType = socktype+          , addrProtocol = ai_protocol+          , addrAddress = ai_addr+          , addrCanonName = ai_canonname+          }++    poke p (AddrInfo flags family sockType protocol _ _) = do+        c_stype <- packSocketTypeOrThrow "AddrInfo.poke" sockType++        (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags)+        (#poke struct addrinfo, ai_family) p (packFamily family)+        (#poke struct addrinfo, ai_socktype) p c_stype+        (#poke struct addrinfo, ai_protocol) p protocol++        -- stuff below is probably not needed, but let's zero it for safety++        (#poke struct addrinfo, ai_addrlen) p (0::CSize)+        (#poke struct addrinfo, ai_addr) p nullPtr+        (#poke struct addrinfo, ai_canonname) p nullPtr+        (#poke struct addrinfo, ai_next) p nullPtr++-- | Flags that control the querying behaviour of 'getNameInfo'.+--   For more information, see <https://tools.ietf.org/html/rfc3493#page-30>+data NameInfoFlag =+    -- | Resolve a datagram-based service name.  This is+    --   required only for the few protocols that have different port+    --   numbers for their datagram-based versions than for their+    --   stream-based versions.+      NI_DGRAM+    -- | If the hostname cannot be looked up, an IO error is thrown.+    | NI_NAMEREQD+    -- | If a host is local, return only the hostname part of the FQDN.+    | NI_NOFQDN+    -- | The name of the host is not looked up.+    --   Instead, a numeric representation of the host's+    --   address is returned.  For an IPv4 address, this will be a+    --   dotted-quad string.  For IPv6, it will be colon-separated+    --   hexadecimal.+    | NI_NUMERICHOST+    -- | The name of the service is not+    --   looked up.  Instead, a numeric representation of the+    --   service is returned.+    | NI_NUMERICSERV+    deriving (Eq, Read, Show, Typeable)++niFlagMapping :: [(NameInfoFlag, CInt)]++niFlagMapping = [(NI_DGRAM, #const NI_DGRAM),+                 (NI_NAMEREQD, #const NI_NAMEREQD),+                 (NI_NOFQDN, #const NI_NOFQDN),+                 (NI_NUMERICHOST, #const NI_NUMERICHOST),+                 (NI_NUMERICSERV, #const NI_NUMERICSERV)]++-- | Default hints for address lookup with 'getAddrInfo'.  The values+-- of the 'addrAddress' and 'addrCanonName' fields are 'undefined',+-- and are never inspected by 'getAddrInfo'.+--+-- >>> addrFlags defaultHints+-- []+-- >>> addrFamily defaultHints+-- AF_UNSPEC+-- >>> addrSocketType defaultHints+-- NoSocketType+-- >>> addrProtocol defaultHints+-- 0++defaultHints :: AddrInfo+defaultHints = AddrInfo {+    addrFlags      = []+  , addrFamily     = AF_UNSPEC+  , addrSocketType = NoSocketType+  , addrProtocol   = defaultProtocol+  , addrAddress    = undefined+  , addrCanonName  = undefined+  }++-- | Shows the fields of 'defaultHints', without inspecting the by-default undefined fields 'addrAddress' and 'addrCanonName'.+showDefaultHints :: AddrInfo -> String+showDefaultHints AddrInfo{..} = concat [+    "AddrInfo {"+  , "addrFlags = "+  , show addrFlags+  , ", addrFamily = "+  , show addrFamily+  , ", addrSocketType = "+  , show addrSocketType+  , ", addrProtocol = "+  , show addrProtocol+  , ", addrAddress = "+  , "<assumed to be undefined>"+  , ", addrCanonName = "+  , "<assumed to be undefined>"+  , "}"+  ]++-----------------------------------------------------------------------------+-- | Resolve a host or service name to one or more addresses.+-- The 'AddrInfo' values that this function returns contain 'SockAddr'+-- values that you can pass directly to 'connect' or+-- 'bind'.+--+-- This function is protocol independent.  It can return both IPv4 and+-- IPv6 address information.+--+-- The 'AddrInfo' argument specifies the preferred query behaviour,+-- socket options, or protocol.  You can override these conveniently+-- using Haskell's record update syntax on 'defaultHints', for example+-- as follows:+--+-- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Stream }+--+-- You must provide a 'Just' value for at least one of the 'HostName'+-- or 'ServiceName' arguments.  'HostName' can be either a numeric+-- network address (dotted quad for IPv4, colon-separated hex for+-- IPv6) or a hostname.  In the latter case, its addresses will be+-- looked up unless 'AI_NUMERICHOST' is specified as a hint.  If you+-- do not provide a 'HostName' value /and/ do not set 'AI_PASSIVE' as+-- a hint, network addresses in the result will contain the address of+-- the loopback interface.+--+-- If the query fails, this function throws an IO exception instead of+-- returning an empty list.  Otherwise, it returns a non-empty list+-- of 'AddrInfo' values.+--+-- There are several reasons why a query might result in several+-- values.  For example, the queried-for host could be multihomed, or+-- the service might be available via several protocols.+--+-- Note: the order of arguments is slightly different to that defined+-- for @getaddrinfo@ in RFC 2553.  The 'AddrInfo' parameter comes first+-- to make partial application easier.+--+-- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "http")+-- >>> addrAddress addr+-- 127.0.0.1:80++getAddrInfo+    :: Maybe AddrInfo -- ^ preferred socket type or protocol+    -> Maybe HostName -- ^ host name to look up+    -> Maybe ServiceName -- ^ service name to look up+    -> IO [AddrInfo] -- ^ resolved addresses, with "best" first+getAddrInfo hints node service = alloc getaddrinfo+  where+    alloc body = withSocketsDo $ maybeWith withCString node $ \c_node ->+        maybeWith withCString service                       $ \c_service ->+            maybeWith with filteredHints                    $ \c_hints ->+                  alloca                                    $ \ptr_ptr_addrs ->+                      body c_node c_service c_hints ptr_ptr_addrs+    getaddrinfo c_node c_service c_hints ptr_ptr_addrs = do+        ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs+        if ret == 0 then do+            ptr_addrs <- peek ptr_ptr_addrs+            ais       <- followAddrInfo ptr_addrs+            c_freeaddrinfo ptr_addrs+            return ais+          else do+            err <- gai_strerror ret+            ioError $ ioeSetErrorString+                        (mkIOError NoSuchThing message Nothing Nothing)+                        err+    message = concat [+        "Network.Socket.getAddrInfo (called with preferred socket type/protocol: "+      , maybe (show hints) showDefaultHints hints+      , ", host name: "+      , show node+      , ", service name: "+      , show service+      , ")"+      ]+#if defined(darwin_HOST_OS)+    -- Leaving out the service and using AI_NUMERICSERV causes a+    -- segfault on OS X 10.8.2. This code removes AI_NUMERICSERV+    -- (which has no effect) in that case.+    toHints h = h { addrFlags = delete AI_NUMERICSERV (addrFlags h) }+    filteredHints = case service of+        Nothing -> toHints <$> hints+        _       -> hints+#else+    filteredHints = hints+#endif++followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]+followAddrInfo ptr_ai+    | ptr_ai == nullPtr = return []+    | otherwise = do+        a  <- peek ptr_ai+        as <- (# peek struct addrinfo, ai_next) ptr_ai >>= followAddrInfo+        return (a : as)++foreign import ccall safe "hsnet_getaddrinfo"+    c_getaddrinfo :: CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo)+                  -> IO CInt++foreign import ccall safe "hsnet_freeaddrinfo"+    c_freeaddrinfo :: Ptr AddrInfo -> IO ()++gai_strerror :: CInt -> IO String++#ifdef HAVE_GAI_STRERROR+gai_strerror n = c_gai_strerror n >>= peekCString++foreign import ccall safe "gai_strerror"+    c_gai_strerror :: CInt -> IO CString+#else+gai_strerror n = ioError $ userError $ "Network.Socket.gai_strerror not supported: " ++ show n+#endif++-----------------------------------------------------------------------------++withCStringIf :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a+withCStringIf False _ f = f 0 nullPtr+withCStringIf True  n f = allocaBytes n (f (fromIntegral n))++-- | Resolve an address to a host or service name.+-- This function is protocol independent.+-- The list of 'NameInfoFlag' values controls query behaviour.+--+-- If a host or service's name cannot be looked up, then the numeric+-- form of the address or service will be returned.+--+-- If the query fails, this function throws an IO exception.+--+-- >>> addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "http")+-- >>> getNameInfo [NI_NUMERICHOST, NI_NUMERICSERV] True True $ addrAddress addr+-- (Just "127.0.0.1",Just "80")+{-+-- >>> getNameInfo [] True True $ addrAddress addr+-- (Just "localhost",Just "http")+-}+getNameInfo+    :: [NameInfoFlag] -- ^ flags to control lookup behaviour+    -> Bool -- ^ whether to look up a hostname+    -> Bool -- ^ whether to look up a service name+    -> SockAddr -- ^ the address to look up+    -> IO (Maybe HostName, Maybe ServiceName)+getNameInfo flags doHost doService addr = alloc getnameinfo+  where+    alloc body = withSocketsDo $+        withCStringIf doHost (# const NI_MAXHOST)        $ \c_hostlen c_host ->+            withCStringIf doService (# const NI_MAXSERV) $ \c_servlen c_serv ->+                withSockAddr addr                        $ \ptr_addr sz ->+                  body c_hostlen c_host c_servlen c_serv ptr_addr sz+    getnameinfo c_hostlen c_host c_servlen c_serv ptr_addr sz = do+        ret <- c_getnameinfo ptr_addr+                             (fromIntegral sz)+                             c_host+                             c_hostlen+                             c_serv+                             c_servlen+                             (packBits niFlagMapping flags)+        if ret == 0 then do+            let peekIf doIf c_val =+                    if doIf then Just <$> peekCString c_val else return Nothing+            host <- peekIf doHost c_host+            serv <- peekIf doService c_serv+            return (host, serv)+          else do+            err <- gai_strerror ret+            ioError $ ioeSetErrorString+                        (mkIOError NoSuchThing message Nothing Nothing)+                        err+    message = concat [+        "Network.Socket.getNameInfo (called with flags: "+      , show flags+      , ", hostname lookup: "+      , show doHost+      , ", service name lookup: "+      , show doService+      , ", socket address: "+      , show addr+      , ")"+      ]++foreign import ccall safe "hsnet_getnameinfo"+    c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString+                  -> CSize -> CInt -> IO CInt++-- | Pack a list of values into a bitmask.  The possible mappings from+-- value to bit-to-set are given as the first argument.  We assume+-- that each value can cause exactly one bit to be set; unpackBits will+-- break if this property is not true.++-----------------------------------------------------------------------------++packBits :: (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b+packBits mapping xs = foldl' pack 0 mapping+  where+    pack acc (k, v) | k `elem` xs = acc .|. v+                    | otherwise   = acc++-- | Unpack a bitmask into a list of values.+unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a]+-- Be permissive and ignore unknown bit values. At least on OS X,+-- getaddrinfo returns an ai_flags field with bits set that have no+-- entry in <netdb.h>.+unpackBits [] _    = []+unpackBits ((k,v):xs) r+    | r .&. v /= 0 = k : unpackBits xs (r .&. complement v)+    | otherwise    = unpackBits xs r++-----------------------------------------------------------------------------+-- SockAddr++instance Show SockAddr where+#if defined(DOMAIN_SOCKET_SUPPORT)+  showsPrec _ (SockAddrUnix str) = showString str+#else+  showsPrec _ SockAddrUnix{} = error "showsPrec: not supported"+#endif+  showsPrec _ addr@(SockAddrInet port _)+   = showString (unsafePerformIO $+                 fst <$> getNameInfo [NI_NUMERICHOST] True False addr >>=+                 maybe (fail "showsPrec: impossible internal error") return)+   . showString ":"+   . shows port+  showsPrec _ addr@(SockAddrInet6 port _ _ _)+   = showChar '['+   . showString (unsafePerformIO $+                 fst <$> getNameInfo [NI_NUMERICHOST] True False addr >>=+                 maybe (fail "showsPrec: impossible internal error") return)+   . showString "]:"+   . shows port
+ Network/Socket/Internal.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++#include "HsNetDef.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Network.Socket.Internal+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/network/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- A module containing semi-public 'Network.Socket' internals.+-- Modules which extend the 'Network.Socket' module will need to use+-- this module while ideally most users will be able to make do with+-- the public interface.+--+-----------------------------------------------------------------------------++module Network.Socket.Internal+    (+    -- * Socket error functions+      throwSocketError+    , throwSocketErrorCode+#if defined(mingw32_HOST_OS)+    , c_getLastError+#endif++    -- * Guards for socket operations that may fail+    , throwSocketErrorIfMinus1_+    , throwSocketErrorIfMinus1Retry+    , throwSocketErrorIfMinus1Retry_+    , throwSocketErrorIfMinus1RetryMayBlock++    -- ** Guards that wait and retry if the operation would block+    -- | These guards are based on 'throwSocketErrorIfMinus1RetryMayBlock'.+    -- They wait for socket readiness if the action fails with @EWOULDBLOCK@+    -- or similar.+    , throwSocketErrorWaitRead+    , throwSocketErrorWaitWrite++    -- * Initialization+    , withSocketsDo++    -- * Low-level helpers+    , zeroMemory+    ) where++import GHC.Conc (threadWaitRead, threadWaitWrite)++#if defined(mingw32_HOST_OS)+import Control.Exception (evaluate)+import System.IO.Unsafe (unsafePerformIO)+# if __GLASGOW_HASKELL__ >= 707+import GHC.IO.Exception (IOErrorType(..))+# else+import GHC.IOBase (IOErrorType(..))+# endif+import System.IO.Error (ioeSetErrorString, mkIOError)+#else+import Foreign.C.Error (throwErrno, throwErrnoIfMinus1Retry,+                        throwErrnoIfMinus1RetryMayBlock, throwErrnoIfMinus1_,+                        Errno(..), errnoToIOError)+#endif++#if defined(mingw32_HOST_OS)+import Network.Socket.Cbits+#endif+import Network.Socket.Imports+import Network.Socket.Types++-- ---------------------------------------------------------------------+-- Guards for socket operations that may fail++-- | Throw an 'IOError' corresponding to the current socket error.+throwSocketError :: String  -- ^ textual description of the error location+                 -> IO a++-- | Like 'throwSocketError', but the error code is supplied as an argument.+--+-- On Windows, do not use errno.  Use a system error code instead.+throwSocketErrorCode :: String -> CInt -> IO a++-- | Throw an 'IOError' corresponding to the current socket error if+-- the IO action returns a result of @-1@.  Discards the result of the+-- IO action after error handling.+throwSocketErrorIfMinus1_+    :: (Eq a, Num a)+    => String  -- ^ textual description of the location+    -> IO a    -- ^ the 'IO' operation to be executed+    -> IO ()++{-# SPECIALIZE throwSocketErrorIfMinus1_ :: String -> IO CInt -> IO () #-}++-- | Throw an 'IOError' corresponding to the current socket error if+-- the IO action returns a result of @-1@, but retries in case of an+-- interrupted operation.+throwSocketErrorIfMinus1Retry+    :: (Eq a, Num a)+    => String  -- ^ textual description of the location+    -> IO a    -- ^ the 'IO' operation to be executed+    -> IO a++{-# SPECIALIZE throwSocketErrorIfMinus1Retry :: String -> IO CInt -> IO CInt #-}++-- | Throw an 'IOError' corresponding to the current socket error if+-- the IO action returns a result of @-1@, but retries in case of an+-- interrupted operation. Discards the result of the IO action after+-- error handling.+throwSocketErrorIfMinus1Retry_+    :: (Eq a, Num a)+    => String  -- ^ textual description of the location+    -> IO a    -- ^ the 'IO' operation to be executed+    -> IO ()+throwSocketErrorIfMinus1Retry_ loc m =+    void $ throwSocketErrorIfMinus1Retry loc m+{-# SPECIALIZE throwSocketErrorIfMinus1Retry_ :: String -> IO CInt -> IO () #-}++-- | Throw an 'IOError' corresponding to the current socket error if+-- the IO action returns a result of @-1@, but retries in case of an+-- interrupted operation.  Checks for operations that would block and+-- executes an alternative action before retrying in that case.+throwSocketErrorIfMinus1RetryMayBlock+    :: (Eq a, Num a)+    => String  -- ^ textual description of the location+    -> IO b    -- ^ action to execute before retrying if an+               --   immediate retry would block+    -> IO a    -- ^ the 'IO' operation to be executed+    -> IO a++{-# SPECIALIZE throwSocketErrorIfMinus1RetryMayBlock+        :: String -> IO b -> IO CInt -> IO CInt #-}++#if defined(mingw32_HOST_OS)++throwSocketErrorIfMinus1RetryMayBlock name _ act+  = throwSocketErrorIfMinus1Retry name act++throwSocketErrorIfMinus1_ name act = do+  _ <- throwSocketErrorIfMinus1Retry name act+  return ()++throwSocketErrorIfMinus1Retry name act = do+  r <- act+  if (r == -1)+   then do+    rc <- c_getLastError+    if rc == wsaNotInitialized then do+        withSocketsDo (return ())+        r' <- act+        if (r' == -1)+           then throwSocketError name+           else return r'+      else+        throwSocketError name+   else return r++throwSocketErrorCode name rc = do+    pstr <- c_getWSError rc+    str  <- peekCString pstr+    ioError (ioeSetErrorString (mkIOError OtherError name Nothing Nothing) str)++throwSocketError name =+    c_getLastError >>= throwSocketErrorCode name++foreign import CALLCONV unsafe "WSAGetLastError"+  c_getLastError :: IO CInt++foreign import ccall unsafe "getWSErrorDescr"+  c_getWSError :: CInt -> IO (Ptr CChar)++#else++throwSocketErrorIfMinus1RetryMayBlock name on_block act =+    throwErrnoIfMinus1RetryMayBlock name act on_block++throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry++throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_++throwSocketError = throwErrno++throwSocketErrorCode loc errno =+    ioError (errnoToIOError loc (Errno errno) Nothing Nothing)++#endif++-- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with+-- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready,+-- and try again.+throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a+throwSocketErrorWaitRead s name io = do+    fd <- fromIntegral <$> fdSocket s+    throwSocketErrorIfMinus1RetryMayBlock name (threadWaitRead fd) io++-- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with+-- @EWOULDBLOCK@ or similar, wait for the socket to be write-ready,+-- and try again.+throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a+throwSocketErrorWaitWrite s name io = do+    fd <- fromIntegral <$> fdSocket s+    throwSocketErrorIfMinus1RetryMayBlock name (threadWaitWrite fd) io++-- ---------------------------------------------------------------------------+-- WinSock support++{-| With older versions of the @network@ library (version 2.6.0.2 or earlier)+on Windows operating systems,+the networking subsystem must be initialised using 'withSocketsDo' before+any networking operations can be used. eg.++> main = withSocketsDo $ do {...}++It is fine to nest calls to 'withSocketsDo', and to perform networking operations+after 'withSocketsDo' has returned.++'withSocketsDo' is not necessary for the current network library.+However, for compatibility with older versions on Windows, it is good practice+to always call 'withSocketsDo' (it's very cheap).+-}+{-# INLINE withSocketsDo #-}+withSocketsDo :: IO a -> IO a+#if defined(mingw32_HOST_OS)++withSocketsDo act = evaluate withSocketsInit >> act++{-# NOINLINE withSocketsInit #-}+withSocketsInit :: ()+-- Use a CAF to make forcing it do initialisation once, but subsequent forces will be cheap+withSocketsInit = unsafePerformIO $ do+    x <- initWinSock+    when (x /= 0) $ ioError $+      userError "Network.Socket.Internal.withSocketsDo: Failed to initialise WinSock"++foreign import ccall unsafe "initWinSock" initWinSock :: IO Int++#else++withSocketsDo x = x++#endif
− Network/Socket/Internal.hsc 
@@ -1,277 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module      :  Network.Socket.Internal--- Copyright   :  (c) The University of Glasgow 2001--- License     :  BSD-style (see the file libraries/network/LICENSE)------ Maintainer  :  libraries@haskell.org--- Stability   :  provisional--- Portability :  portable------ A module containing semi-public 'Network.Socket' internals.--- Modules which extend the 'Network.Socket' module will need to use--- this module while ideally most users will be able to make do with--- the public interface.-----------------------------------------------------------------------------------#include "HsNet.h"-##include "HsNetDef.h"--module Network.Socket.Internal-    (-    -- * Socket addresses-      HostAddress-#if defined(IPV6_SOCKET_SUPPORT)-    , HostAddress6-    , FlowInfo-    , ScopeID-#endif-    , PortNumber(..)-    , SockAddr(..)--    , peekSockAddr-    , pokeSockAddr-    , sizeOfSockAddr-    , sizeOfSockAddrByFamily-    , withSockAddr-    , withNewSockAddr--    -- * Protocol families-    , Family(..)--    -- * Socket error functions-#if defined(HAVE_WINSOCK2_H)-    , c_getLastError-#endif-    , throwSocketError-    , throwSocketErrorCode--    -- * Guards for socket operations that may fail-    , throwSocketErrorIfMinus1_-    , throwSocketErrorIfMinus1Retry-    , throwSocketErrorIfMinus1Retry_-    , throwSocketErrorIfMinus1RetryMayBlock--    -- ** Guards that wait and retry if the operation would block-    -- | These guards are based on 'throwSocketErrorIfMinus1RetryMayBlock'.-    -- They wait for socket readiness if the action fails with @EWOULDBLOCK@-    -- or similar.-    , throwSocketErrorWaitRead-    , throwSocketErrorWaitWrite--    -- * Initialization-    , withSocketsDo--    -- * Low-level helpers-    , zeroMemory-    ) where--import Foreign.C.Error (throwErrno, throwErrnoIfMinus1Retry,-                        throwErrnoIfMinus1RetryMayBlock, throwErrnoIfMinus1_,-                        Errno(..), errnoToIOError)-#if defined(HAVE_WINSOCK2_H)-import Foreign.C.String (peekCString)-import Foreign.Ptr (Ptr)-#endif-import Foreign.C.Types (CInt(..))-import GHC.Conc (threadWaitRead, threadWaitWrite)--#if defined(HAVE_WINSOCK2_H)-import Control.Exception ( evaluate )-import System.IO.Unsafe ( unsafePerformIO )-import Control.Monad ( when )-#  if __GLASGOW_HASKELL__ >= 707-import GHC.IO.Exception ( IOErrorType(..) )-#  else-import GHC.IOBase ( IOErrorType(..) )-#  endif-import Foreign.C.Types ( CChar )-import System.IO.Error ( ioeSetErrorString, mkIOError )-#endif--import Network.Socket.Types---- ------------------------------------------------------------------------ Guards for socket operations that may fail---- | Throw an 'IOError' corresponding to the current socket error.-throwSocketError :: String  -- ^ textual description of the error location-                 -> IO a---- | Like 'throwSocketError', but the error code is supplied as an argument.------ On Windows, do not use errno.  Use a system error code instead.-throwSocketErrorCode :: String -> CInt -> IO a---- | Throw an 'IOError' corresponding to the current socket error if--- the IO action returns a result of @-1@.  Discards the result of the--- IO action after error handling.-throwSocketErrorIfMinus1_-    :: (Eq a, Num a)-    => String  -- ^ textual description of the location-    -> IO a    -- ^ the 'IO' operation to be executed-    -> IO ()--{-# SPECIALIZE throwSocketErrorIfMinus1_ :: String -> IO CInt -> IO () #-}---- | Throw an 'IOError' corresponding to the current socket error if--- the IO action returns a result of @-1@, but retries in case of an--- interrupted operation.-throwSocketErrorIfMinus1Retry-    :: (Eq a, Num a)-    => String  -- ^ textual description of the location-    -> IO a    -- ^ the 'IO' operation to be executed-    -> IO a--{-# SPECIALIZE throwSocketErrorIfMinus1Retry :: String -> IO CInt -> IO CInt #-}---- | Throw an 'IOError' corresponding to the current socket error if--- the IO action returns a result of @-1@, but retries in case of an--- interrupted operation. Discards the result of the IO action after--- error handling.-throwSocketErrorIfMinus1Retry_-    :: (Eq a, Num a)-    => String  -- ^ textual description of the location-    -> IO a    -- ^ the 'IO' operation to be executed-    -> IO ()-throwSocketErrorIfMinus1Retry_ loc m =-    throwSocketErrorIfMinus1Retry loc m >> return ()-{-# SPECIALIZE throwSocketErrorIfMinus1Retry_ :: String -> IO CInt -> IO () #-}---- | Throw an 'IOError' corresponding to the current socket error if--- the IO action returns a result of @-1@, but retries in case of an--- interrupted operation.  Checks for operations that would block and--- executes an alternative action before retrying in that case.-throwSocketErrorIfMinus1RetryMayBlock-    :: (Eq a, Num a)-    => String  -- ^ textual description of the location-    -> IO b    -- ^ action to execute before retrying if an-               --   immediate retry would block-    -> IO a    -- ^ the 'IO' operation to be executed-    -> IO a--{-# SPECIALIZE throwSocketErrorIfMinus1RetryMayBlock-        :: String -> IO b -> IO CInt -> IO CInt #-}--#if (!defined(HAVE_WINSOCK2_H))--throwSocketErrorIfMinus1RetryMayBlock name on_block act =-    throwErrnoIfMinus1RetryMayBlock name act on_block--throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry--throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_--throwSocketError = throwErrno--throwSocketErrorCode loc errno =-    ioError (errnoToIOError loc (Errno errno) Nothing Nothing)--#else--throwSocketErrorIfMinus1RetryMayBlock name _ act-  = throwSocketErrorIfMinus1Retry name act--throwSocketErrorIfMinus1_ name act = do-  throwSocketErrorIfMinus1Retry name act-  return ()--# if defined(HAVE_WINSOCK2_H)-throwSocketErrorIfMinus1Retry name act = do-  r <- act-  if (r == -1)-   then do-    rc   <- c_getLastError-    case rc of-      #{const WSANOTINITIALISED} -> do-        withSocketsDo (return ())-        r <- act-        if (r == -1)-           then throwSocketError name-           else return r-      _ -> throwSocketError name-   else return r--throwSocketErrorCode name rc = do-    pstr <- c_getWSError rc-    str  <- peekCString pstr-    ioError (ioeSetErrorString (mkIOError OtherError name Nothing Nothing) str)--throwSocketError name =-    c_getLastError >>= throwSocketErrorCode name--foreign import CALLCONV unsafe "WSAGetLastError"-  c_getLastError :: IO CInt--foreign import ccall unsafe "getWSErrorDescr"-  c_getWSError :: CInt -> IO (Ptr CChar)---# else-throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry-throwSocketError = throwErrno-throwSocketErrorCode loc errno =-    ioError (errnoToIOError loc (Errno errno) Nothing Nothing)-# endif-#endif---- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with--- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready,--- and try again.-throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a-throwSocketErrorWaitRead sock name io =-    throwSocketErrorIfMinus1RetryMayBlock name-        (threadWaitRead $ fromIntegral $ fdSocket sock)-        io---- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with--- @EWOULDBLOCK@ or similar, wait for the socket to be write-ready,--- and try again.-throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a-throwSocketErrorWaitWrite sock name io =-    throwSocketErrorIfMinus1RetryMayBlock name-        (threadWaitWrite $ fromIntegral $ fdSocket sock)-        io---- ------------------------------------------------------------------------------ WinSock support--{-| With older versions of the @network@ library (version 2.6.0.2 or earlier)-on Windows operating systems,-the networking subsystem must be initialised using 'withSocketsDo' before-any networking operations can be used. eg.--> main = withSocketsDo $ do {...}--It is fine to nest calls to 'withSocketsDo', and to perform networking operations-after 'withSocketsDo' has returned.--In newer versions of the @network@ library (version v2.6.1.0 or later)-it is only necessary to call-'withSocketsDo' if you are calling the 'MkSocket' constructor directly.-However, for compatibility with older versions on Windows, it is good practice-to always call 'withSocketsDo' (it's very cheap).--}-{-# INLINE withSocketsDo #-}-withSocketsDo :: IO a -> IO a-#if !defined(WITH_WINSOCK)-withSocketsDo x = x-#else-withSocketsDo act = evaluate withSocketsInit >> act---{-# NOINLINE withSocketsInit #-}-withSocketsInit :: ()--- Use a CAF to make forcing it do initialisation once, but subsequent forces will be cheap-withSocketsInit = unsafePerformIO $ do-    x <- initWinSock-    when (x /= 0) $ ioError $-      userError "Network.Socket.Internal.withSocketsDo: Failed to initialise WinSock"--foreign import ccall unsafe "initWinSock" initWinSock :: IO Int--#endif
+ Network/Socket/Name.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE CPP #-}++#include "HsNetDef.h"++module Network.Socket.Name (+    getPeerName+  , getSocketName+  , socketPort+  , socketPortSafe+  ) where++import Foreign.Marshal.Utils (with)++import Network.Socket.Imports+import Network.Socket.Internal+import Network.Socket.Types++-- | Getting peer's socket address.+getPeerName :: SocketAddress sa => Socket -> IO sa+getPeerName s =+ withNewSocketAddress $ \ptr sz ->+   with (fromIntegral sz) $ \int_star -> do+     fd <- fdSocket s+     throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerName" $+       c_getpeername fd ptr int_star+     _sz <- peek int_star+     peekSocketAddress ptr++-- | Getting my socket address.+getSocketName :: SocketAddress sa => Socket -> IO sa+getSocketName s =+ withNewSocketAddress $ \ptr sz ->+   with (fromIntegral sz) $ \int_star -> do+     fd <- fdSocket s+     throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketName" $+       c_getsockname fd ptr int_star+     peekSocketAddress ptr++foreign import CALLCONV unsafe "getpeername"+  c_getpeername :: CInt -> Ptr sa -> Ptr CInt -> IO CInt+foreign import CALLCONV unsafe "getsockname"+  c_getsockname :: CInt -> Ptr sa -> Ptr CInt -> IO CInt++-- ---------------------------------------------------------------------------+-- socketPort+--+-- The port number the given socket is currently connected to can be+-- determined by calling $port$, is generally only useful when bind+-- was given $aNY\_PORT$.++-- | Getting the port of socket.+--   `IOError` is thrown if a port is not available.+socketPort :: Socket            -- Connected & Bound Socket+           -> IO PortNumber     -- Port Number of Socket+socketPort s = do+    sa <- getSocketName s+    case sa of+      SockAddrInet port _      -> return port+      SockAddrInet6 port _ _ _ -> return port+      _                        -> ioError $ userError "Network.Socket.socketPort: AF_UNIX not supported."++-- ---------------------------------------------------------------------------+-- socketPortSafe+-- | Getting the port of socket.+socketPortSafe :: Socket                -- Connected & Bound Socket+               -> IO (Maybe PortNumber) -- Port Number of Socket+socketPortSafe s = do+    sa <- getSocketName s+    return $ case sa of+      SockAddrInet port _      -> Just port+      SockAddrInet6 port _ _ _ -> Just port+      _                        -> Nothing
+ Network/Socket/Options.hsc view
@@ -0,0 +1,242 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}++#include "HsNet.h"+##include "HsNetDef.h"++module Network.Socket.Options (+    SocketOption(..)+  , isSupportedSocketOption+  , getSocketOption+  , setSocketOption+  , c_getsockopt+  , c_setsockopt+  ) where++import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Utils (with)++import Network.Socket.Imports+import Network.Socket.Internal+import Network.Socket.Types++-----------------------------------------------------------------------------+-- Socket Properties++-- | Socket options for use with 'setSocketOption' and 'getSocketOption'.+--+-- The existence of a constructor does not imply that the relevant option+-- is supported on your system: see 'isSupportedSocketOption'+data SocketOption+    = Debug         -- ^ SO_DEBUG+    | ReuseAddr     -- ^ SO_REUSEADDR+    | Type          -- ^ SO_TYPE+    | SoError       -- ^ SO_ERROR+    | DontRoute     -- ^ SO_DONTROUTE+    | Broadcast     -- ^ SO_BROADCAST+    | SendBuffer    -- ^ SO_SNDBUF+    | RecvBuffer    -- ^ SO_RCVBUF+    | KeepAlive     -- ^ SO_KEEPALIVE+    | OOBInline     -- ^ SO_OOBINLINE+    | TimeToLive    -- ^ IP_TTL+    | MaxSegment    -- ^ TCP_MAXSEG+    | NoDelay       -- ^ TCP_NODELAY+    | Cork          -- ^ TCP_CORK+    | Linger        -- ^ SO_LINGER: timeout in seconds, 0 means disabling/disabled.+    | ReusePort     -- ^ SO_REUSEPORT+    | RecvLowWater  -- ^ SO_RCVLOWAT+    | SendLowWater  -- ^ SO_SNDLOWAT+    | RecvTimeOut   -- ^ SO_RCVTIMEO: this does not work at this moment.+    | SendTimeOut   -- ^ SO_SNDTIMEO: this does not work at this moment.+    | UseLoopBack   -- ^ SO_USELOOPBACK+    | UserTimeout   -- ^ TCP_USER_TIMEOUT+    | IPv6Only      -- ^ IPV6_V6ONLY: don't use this on OpenBSD.+    | CustomSockOpt (CInt, CInt)+    deriving (Show, Typeable)++-- | Does the 'SocketOption' exist on this system?+isSupportedSocketOption :: SocketOption -> Bool+isSupportedSocketOption = isJust . packSocketOption++-- | For a socket option, return Just (level, value) where level is the+-- corresponding C option level constant (e.g. SOL_SOCKET) and value is+-- the option constant itself (e.g. SO_DEBUG)+-- If either constant does not exist, return Nothing.+packSocketOption :: SocketOption -> Maybe (CInt, CInt)+packSocketOption so =+  -- The Just here is a hack to disable GHC's overlapping pattern detection:+  -- the problem is if all constants are present, the fallback pattern is+  -- redundant, but if they aren't then it isn't. Hence we introduce an+  -- extra pattern (Nothing) that can't possibly happen, so that the+  -- fallback is always (in principle) necessary.+  -- I feel a little bad for including this, but such are the sacrifices we+  -- make while working with CPP - excluding the fallback pattern correctly+  -- would be a serious nuisance.+  -- (NB: comments elsewhere in this file refer to this one)+  case Just so of+#ifdef SOL_SOCKET+#ifdef SO_DEBUG+    Just Debug         -> Just ((#const SOL_SOCKET), (#const SO_DEBUG))+#endif+#ifdef SO_REUSEADDR+    Just ReuseAddr     -> Just ((#const SOL_SOCKET), (#const SO_REUSEADDR))+#endif+#ifdef SO_TYPE+    Just Type          -> Just ((#const SOL_SOCKET), (#const SO_TYPE))+#endif+#ifdef SO_ERROR+    Just SoError       -> Just ((#const SOL_SOCKET), (#const SO_ERROR))+#endif+#ifdef SO_DONTROUTE+    Just DontRoute     -> Just ((#const SOL_SOCKET), (#const SO_DONTROUTE))+#endif+#ifdef SO_BROADCAST+    Just Broadcast     -> Just ((#const SOL_SOCKET), (#const SO_BROADCAST))+#endif+#ifdef SO_SNDBUF+    Just SendBuffer    -> Just ((#const SOL_SOCKET), (#const SO_SNDBUF))+#endif+#ifdef SO_RCVBUF+    Just RecvBuffer    -> Just ((#const SOL_SOCKET), (#const SO_RCVBUF))+#endif+#ifdef SO_KEEPALIVE+    Just KeepAlive     -> Just ((#const SOL_SOCKET), (#const SO_KEEPALIVE))+#endif+#ifdef SO_OOBINLINE+    Just OOBInline     -> Just ((#const SOL_SOCKET), (#const SO_OOBINLINE))+#endif+#ifdef SO_LINGER+    Just Linger        -> Just ((#const SOL_SOCKET), (#const SO_LINGER))+#endif+#ifdef SO_REUSEPORT+    Just ReusePort     -> Just ((#const SOL_SOCKET), (#const SO_REUSEPORT))+#endif+#ifdef SO_RCVLOWAT+    Just RecvLowWater  -> Just ((#const SOL_SOCKET), (#const SO_RCVLOWAT))+#endif+#ifdef SO_SNDLOWAT+    Just SendLowWater  -> Just ((#const SOL_SOCKET), (#const SO_SNDLOWAT))+#endif+#ifdef SO_RCVTIMEO+    Just RecvTimeOut   -> Just ((#const SOL_SOCKET), (#const SO_RCVTIMEO))+#endif+#ifdef SO_SNDTIMEO+    Just SendTimeOut   -> Just ((#const SOL_SOCKET), (#const SO_SNDTIMEO))+#endif+#ifdef SO_USELOOPBACK+    Just UseLoopBack   -> Just ((#const SOL_SOCKET), (#const SO_USELOOPBACK))+#endif+#endif // SOL_SOCKET+#if HAVE_DECL_IPPROTO_IP+#ifdef IP_TTL+    Just TimeToLive    -> Just ((#const IPPROTO_IP), (#const IP_TTL))+#endif+#endif // HAVE_DECL_IPPROTO_IP+#if HAVE_DECL_IPPROTO_TCP+#ifdef TCP_MAXSEG+    Just MaxSegment    -> Just ((#const IPPROTO_TCP), (#const TCP_MAXSEG))+#endif+#ifdef TCP_NODELAY+    Just NoDelay       -> Just ((#const IPPROTO_TCP), (#const TCP_NODELAY))+#endif+#ifdef TCP_USER_TIMEOUT+    Just UserTimeout   -> Just ((#const IPPROTO_TCP), (#const TCP_USER_TIMEOUT))+#endif+#ifdef TCP_CORK+    Just Cork          -> Just ((#const IPPROTO_TCP), (#const TCP_CORK))+#endif+#endif // HAVE_DECL_IPPROTO_TCP+#if HAVE_DECL_IPPROTO_IPV6+#if HAVE_DECL_IPV6_V6ONLY+    Just IPv6Only      -> Just ((#const IPPROTO_IPV6), (#const IPV6_V6ONLY))+#endif+#endif // HAVE_DECL_IPPROTO_IPV6+    Just (CustomSockOpt opt) -> Just opt+    _             -> Nothing++-- | Return the option level and option value if they exist,+-- otherwise throw an error that begins "Network.Socket." ++ the String+-- parameter+packSocketOption' :: String -> SocketOption -> IO (CInt, CInt)+packSocketOption' caller so = maybe err return (packSocketOption so)+ where+  err = ioError . userError . concat $ ["Network.Socket.", caller,+    ": socket option ", show so, " unsupported on this system"]++#ifdef SO_LINGER+data StructLinger = StructLinger CInt CInt++instance Storable StructLinger where+    sizeOf _ = (#const sizeof(struct linger))+    alignment _ = alignment (undefined :: CInt)++    peek p = do+        onoff  <- (#peek struct linger, l_onoff) p+        linger <- (#peek struct linger, l_linger) p+        return $ StructLinger onoff linger++    poke p (StructLinger onoff linger) = do+        (#poke struct linger, l_onoff)  p onoff+        (#poke struct linger, l_linger) p linger+#endif++-- | Set a socket option that expects an Int value.+-- There is currently no API to set e.g. the timeval socket options+setSocketOption :: Socket+                -> SocketOption -- Option Name+                -> Int          -- Option Value+                -> IO ()+#ifdef SO_LINGER+setSocketOption s Linger v = do+   (level, opt) <- packSocketOption' "setSocketOption" Linger+   let arg = if v == 0 then StructLinger 0 0 else StructLinger 1 (fromIntegral v)+   with arg $ \ptr_arg -> void $ do+     let ptr = ptr_arg :: Ptr StructLinger+         sz = fromIntegral $ sizeOf (undefined :: StructLinger)+     fd <- fdSocket s+     throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $+       c_setsockopt fd level opt ptr sz+#endif+setSocketOption s so v = do+   (level, opt) <- packSocketOption' "setSocketOption" so+   with (fromIntegral v) $ \ptr_v -> void $ do+     let ptr = ptr_v :: Ptr CInt+         sz  = fromIntegral $ sizeOf (undefined :: CInt)+     fd <- fdSocket s+     throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $+       c_setsockopt fd level opt ptr sz++-- | Get a socket option that gives an Int value.+-- There is currently no API to get e.g. the timeval socket options+getSocketOption :: Socket+                -> SocketOption  -- Option Name+                -> IO Int        -- Option Value+#ifdef SO_LINGER+getSocketOption s Linger = do+   (level, opt) <- packSocketOption' "getSocketOption" Linger+   alloca $ \ptr_v -> do+     let ptr = ptr_v :: Ptr StructLinger+         sz = fromIntegral $ sizeOf (undefined :: StructLinger)+     fd <- fdSocket s+     with sz $ \ptr_sz -> do+       throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketOption" $+         c_getsockopt fd level opt ptr ptr_sz+       StructLinger onoff linger <- peek ptr+       return $ fromIntegral $ if onoff == 0 then 0 else linger+#endif+getSocketOption s so = do+   (level, opt) <- packSocketOption' "getSocketOption" so+   alloca $ \ptr_v -> do+     let ptr = ptr_v :: Ptr CInt+         sz = fromIntegral $ sizeOf (undefined :: CInt)+     fd <- fdSocket s+     with sz $ \ptr_sz -> do+       throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketOption" $+         c_getsockopt fd level opt ptr ptr_sz+       fromIntegral <$> peek ptr++foreign import CALLCONV unsafe "getsockopt"+  c_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt+foreign import CALLCONV unsafe "setsockopt"+  c_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt
+ Network/Socket/Shutdown.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}++#include "HsNetDef.h"++module Network.Socket.Shutdown (+    ShutdownCmd(..)+  , shutdown+  ) where++import Network.Socket.Imports+import Network.Socket.Internal+import Network.Socket.Types++data ShutdownCmd = ShutdownReceive+                 | ShutdownSend+                 | ShutdownBoth+                 deriving Typeable++sdownCmdToInt :: ShutdownCmd -> CInt+sdownCmdToInt ShutdownReceive = 0+sdownCmdToInt ShutdownSend    = 1+sdownCmdToInt ShutdownBoth    = 2++-- | Shut down one or both halves of the connection, depending on the+-- second argument to the function.  If the second argument is+-- 'ShutdownReceive', further receives are disallowed.  If it is+-- 'ShutdownSend', further sends are disallowed.  If it is+-- 'ShutdownBoth', further sends and receives are disallowed.+shutdown :: Socket -> ShutdownCmd -> IO ()+shutdown s stype = void $ do+  fd <- fdSocket s+  throwSocketErrorIfMinus1Retry_ "Network.Socket.shutdown" $+    c_shutdown fd $ sdownCmdToInt stype++foreign import CALLCONV unsafe "shutdown"+  c_shutdown :: CInt -> CInt -> IO CInt
+ Network/Socket/SockAddr.hs view
@@ -0,0 +1,66 @@+module Network.Socket.SockAddr (+      getPeerName+    , getSocketName+    , connect+    , bind+    , accept+    , sendBufTo+    , recvBufFrom+    ) where++import qualified Network.Socket.Buffer as G+import qualified Network.Socket.Name as G+import qualified Network.Socket.Syscall as G+import Network.Socket.Imports+import Network.Socket.Types++-- | Getting peer's 'SockAddr'.+getPeerName :: Socket -> IO SockAddr+getPeerName = G.getPeerName++-- | Getting my 'SockAddr'.+getSocketName :: Socket -> IO SockAddr+getSocketName = G.getSocketName++-- | Connect to a remote socket at address.+connect :: Socket -> SockAddr -> IO ()+connect = G.connect++-- | 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+-- 'defaultPort' is passed then the system assigns the next available+-- use port.+bind :: Socket -> SockAddr -> IO ()+bind = G.bind++-- | Accept a connection.  The socket must be bound to an address and+-- listening for connections.  The return value is a pair @(conn,+-- address)@ where @conn@ is a new socket object usable to send and+-- receive data on the connection, and @address@ is the address bound+-- to the socket on the other end of the connection.+-- On Unix, FD_CLOEXEC is set to the new 'Socket'.+accept :: Socket -> IO (Socket, SockAddr)+accept = G.accept++-- | Send data to the socket.  The recipient can be specified+-- explicitly, so the socket need not be in a connected state.+-- Returns the number of bytes sent.  Applications are responsible for+-- ensuring that all data has been sent.+sendBufTo :: Socket -> Ptr a -> Int -> SockAddr -> IO Int+sendBufTo = G.sendBufTo++-- | Receive data from the socket, writing it into buffer instead of+-- creating a new string.  The socket need not be in a connected+-- state. Returns @(nbytes, address)@ where @nbytes@ is the number of+-- bytes received and @address@ is a 'SockAddr' representing the+-- address of the sending socket.+--+-- If the first return value is zero, it means EOF.+--+-- For 'Stream' sockets, the second return value would be invalid.+--+-- NOTE: blocking on Windows unless you compile with -threaded (see+-- GHC ticket #1129)+recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr)+recvBufFrom = G.recvBufFrom
+ Network/Socket/Syscall.hs view
@@ -0,0 +1,257 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++#include "HsNetDef.h"++module Network.Socket.Syscall where++import Foreign.Marshal.Utils (with)+import qualified Control.Exception as E++#if defined(mingw32_HOST_OS)+import Foreign (FunPtr)+import GHC.Conc (asyncDoProc)+#else+import Foreign.C.Error (getErrno, eINTR, eINPROGRESS)+import GHC.Conc (threadWaitWrite)+#endif++#ifdef HAVE_ADVANCED_SOCKET_FLAGS+import Network.Socket.Cbits+#else+import Network.Socket.Fcntl+#endif++import Network.Socket.Imports+import Network.Socket.Internal+import Network.Socket.Options+import Network.Socket.Types++-- ----------------------------------------------------------------------------+-- On Windows, our sockets are not put in non-blocking mode (non-blocking+-- is not supported for regular file descriptors on Windows, and it would+-- be a pain to support it only for sockets).  So there are two cases:+--+--  - the threaded RTS uses safe calls for socket operations to get+--    non-blocking I/O, just like the rest of the I/O library+--+--  - with the non-threaded RTS, only some operations on sockets will be+--    non-blocking.  Reads and writes go through the normal async I/O+--    system.  accept() uses asyncDoProc so is non-blocking.  A handful+--    of others (recvFrom, sendFd, recvFd) will block all threads - if this+--    is a problem, -threaded is the workaround.+--++-----------------------------------------------------------------------------+-- Connection Functions++-- In the following connection and binding primitives.  The names of+-- the equivalent C functions have been preserved where possible. It+-- should be noted that some of these names used in the C library,+-- \tr{bind} in particular, have a different meaning to many Haskell+-- programmers and have thus been renamed by appending the prefix+-- Socket.++-- | Create a new socket using the given address family, socket type+-- and protocol number.  The address family is usually 'AF_INET',+-- 'AF_INET6', or 'AF_UNIX'.  The socket type is usually 'Stream' or+-- 'Datagram'.  The protocol number is usually 'defaultProtocol'.+-- If 'AF_INET6' is used and the socket type is 'Stream' or 'Datagram',+-- the 'IPv6Only' socket option is set to 0 so that both IPv4 and IPv6+-- can be handled with one socket.+--+-- >>> import Network.Socket+-- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream }+-- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "5000")+-- >>> sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+-- >>> Network.Socket.bind sock (addrAddress addr)+-- >>> getSocketName sock+-- 127.0.0.1:5000+socket :: Family         -- Family Name (usually AF_INET)+       -> SocketType     -- Socket Type (usually Stream)+       -> ProtocolNumber -- Protocol Number (getProtocolByName to find value)+       -> IO Socket      -- Unconnected Socket+socket family stype protocol = E.bracketOnError create c_close $ \fd -> do+    -- Let's ensure that the socket (file descriptor) is closed even on+    -- asynchronous exceptions.+    setNonBlock fd+    s <- mkSocket fd+    -- This socket is not managed by the IO manager yet.+    -- So, we don't have to call "close" which uses "closeFdWith".+    unsetIPv6Only s+    return s+  where+    create = do+        c_stype <- modifyFlag <$> packSocketTypeOrThrow "socket" stype+        throwSocketErrorIfMinus1Retry "Network.Socket.socket" $+            c_socket (packFamily family) c_stype protocol++#ifdef HAVE_ADVANCED_SOCKET_FLAGS+    modifyFlag c_stype = c_stype .|. sockNonBlock+#else+    modifyFlag c_stype = c_stype+#endif++#ifdef HAVE_ADVANCED_SOCKET_FLAGS+    setNonBlock _ = return ()+#else+    setNonBlock fd = setNonBlockIfNeeded fd+#endif++#if HAVE_DECL_IPV6_V6ONLY+    unsetIPv6Only s = when (family == AF_INET6 && stype `elem` [Stream, Datagram]) $+# if defined(mingw32_HOST_OS)+      -- The IPv6Only option is only supported on Windows Vista and later,+      -- so trying to change it might throw an error.+      E.catch (setSocketOption s IPv6Only 0) $ (\(_ :: E.IOException) -> return ())+# elif defined(__OpenBSD__)+      -- don't change IPv6Only+      return ()+# else+      -- The default value of the IPv6Only option is platform specific,+      -- so we explicitly set it to 0 to provide a common default.+      setSocketOption s IPv6Only 0+# endif+#else+    unsetIPv6Only _ = return ()+#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+-- 'defaultPort' is passed then the system assigns the next available+-- use port.+bind :: SocketAddress sa => Socket -> sa -> IO ()+bind s sa = withSocketAddress sa $ \p_sa siz -> void $ do+  fd <- fdSocket s+  let sz = fromIntegral siz+  throwSocketErrorIfMinus1Retry "Network.Socket.bind" $ c_bind fd p_sa sz++-----------------------------------------------------------------------------+-- Connecting a socket++-- | Connect to a remote socket at address.+connect :: SocketAddress sa => Socket -> sa -> IO ()+connect s sa = withSocketsDo $ withSocketAddress sa $ \p_sa sz ->+    connectLoop s p_sa (fromIntegral sz)++connectLoop :: SocketAddress sa => Socket -> Ptr sa -> CInt -> IO ()+connectLoop s p_sa sz = loop+  where+    errLoc = "Network.Socket.connect: " ++ show s+    loop = do+       fd <- fdSocket s+       r <- c_connect fd p_sa sz+       when (r == -1) $ do+#if defined(mingw32_HOST_OS)+           throwSocketError errLoc+#else+           err <- getErrno+           case () of+             _ | err == eINTR       -> loop+             _ | err == eINPROGRESS -> connectBlocked+--           _ | err == eAGAIN      -> connectBlocked+             _otherwise             -> throwSocketError errLoc++    connectBlocked = do+       fd <- fromIntegral <$> fdSocket s+       threadWaitWrite fd+       err <- getSocketOption s SoError+       when (err == -1) $ throwSocketErrorCode errLoc (fromIntegral err)+#endif++-----------------------------------------------------------------------------+-- Listen++-- | Listen for connections made to the socket.  The second argument+-- specifies the maximum number of queued connections and should be at+-- least 1; the maximum value is system-dependent (usually 5).+listen :: Socket -> Int -> IO ()+listen s backlog = do+    fd <- fdSocket s+    throwSocketErrorIfMinus1Retry_ "Network.Socket.listen" $+        c_listen fd $ fromIntegral backlog++-----------------------------------------------------------------------------+-- Accept+--+-- A call to `accept' only returns when data is available on the given+-- socket, unless the socket has been set to non-blocking.  It will+-- return a new socket which should be used to read the incoming data and+-- should then be closed. Using the socket returned by `accept' allows+-- incoming requests to be queued on the original socket.++-- | Accept a connection.  The socket must be bound to an address and+-- listening for connections.  The return value is a pair @(conn,+-- address)@ where @conn@ is a new socket object usable to send and+-- receive data on the connection, and @address@ is the address bound+-- to the socket on the other end of the connection.+-- On Unix, FD_CLOEXEC is set to the new 'Socket'.+accept :: SocketAddress sa => Socket -> IO (Socket, sa)+accept listing_sock = withNewSocketAddress $ \new_sa sz -> do+     listing_fd <- fdSocket listing_sock+     new_sock <- callAccept listing_fd new_sa sz >>= mkSocket+     new_addr <- peekSocketAddress new_sa+     return (new_sock, new_addr)+  where+#if defined(mingw32_HOST_OS)+     callAccept fd sa sz+       | threaded  = with (fromIntegral sz) $ \ ptr_len ->+                       throwSocketErrorIfMinus1Retry "Network.Socket.accept" $+                         c_accept_safe fd sa ptr_len+       | otherwise = do+             paramData <- c_newAcceptParams fd (fromIntegral sz) sa+             rc        <- asyncDoProc c_acceptDoProc paramData+             new_fd    <- c_acceptNewSock paramData+             c_free paramData+             when (rc /= 0) $+               throwSocketErrorCode "Network.Socket.accept" (fromIntegral rc)+             return new_fd+#else+     callAccept fd sa sz = with (fromIntegral sz) $ \ ptr_len -> do+# ifdef HAVE_ADVANCED_SOCKET_FLAGS+       throwSocketErrorWaitRead listing_sock "Network.Socket.accept"+                        (c_accept4 fd sa ptr_len (sockNonBlock .|. sockCloexec))+# else+       new_fd <- throwSocketErrorWaitRead listing_sock "Network.Socket.accept"+                        (c_accept fd sa ptr_len)+       setNonBlockIfNeeded new_fd+       setCloseOnExecIfNeeded new_fd+       return new_fd+# endif /* HAVE_ADVANCED_SOCKET_FLAGS */+#endif++foreign import CALLCONV unsafe "socket"+  c_socket :: CInt -> CInt -> CInt -> IO CInt+foreign import CALLCONV unsafe "bind"+  c_bind :: CInt -> Ptr sa -> CInt{-CSockLen???-} -> IO CInt+foreign import CALLCONV SAFE_ON_WIN "connect"+  c_connect :: CInt -> Ptr sa -> CInt{-CSockLen???-} -> IO CInt+foreign import CALLCONV unsafe "listen"+  c_listen :: CInt -> CInt -> IO CInt++#ifdef HAVE_ADVANCED_SOCKET_FLAGS+foreign import CALLCONV unsafe "accept4"+  c_accept4 :: CInt -> Ptr sa -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt+#else+foreign import CALLCONV unsafe "accept"+  c_accept :: CInt -> Ptr sa -> Ptr CInt{-CSockLen???-} -> IO CInt+#endif++#if defined(mingw32_HOST_OS)+foreign import CALLCONV safe "accept"+  c_accept_safe :: CInt -> Ptr sa -> Ptr CInt{-CSockLen???-} -> IO CInt+foreign import ccall unsafe "rtsSupportsBoundThreads"+  threaded :: Bool+foreign import ccall unsafe "HsNet.h acceptNewSock"+  c_acceptNewSock :: Ptr () -> IO CInt+foreign import ccall unsafe "HsNet.h newAcceptParams"+  c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ())+foreign import ccall unsafe "HsNet.h &acceptDoProc"+  c_acceptDoProc :: FunPtr (Ptr () -> IO Int)+foreign import ccall unsafe "free"+  c_free:: Ptr a -> IO ()+#endif
Network/Socket/Types.hsc view
@@ -1,23 +1,22 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}  #include "HsNet.h" ##include "HsNetDef.h" -module Network.Socket.Types-    (-    -- * Socket-      Socket(..)+module Network.Socket.Types (+    -- * Socket type+      Socket     , fdSocket-    , sockFamily-    , sockType-    , sockProtocol-    , sockStatus-    , SocketStatus(..)--    -- * Socket types+    , mkSocket+    , invalidateSocket+    , close+    , close'+    , c_close+    -- * Types of socket     , SocketType(..)     , isSupportedSocketType     , packSocketType@@ -32,61 +31,64 @@     , packFamily     , unpackFamily -    -- * Socket addresses+    -- * Socket address typeclass+    , SocketAddress(..)+    , withSocketAddress+    , withNewSocketAddress++    -- * Socket address type     , SockAddr(..)     , isSupportedSockAddr     , HostAddress     , hostAddressToTuple     , tupleToHostAddress-#if defined(IPV6_SOCKET_SUPPORT)     , HostAddress6     , hostAddress6ToTuple     , tupleToHostAddress6     , FlowInfo     , ScopeID-#endif     , peekSockAddr     , pokeSockAddr-    , sizeOfSockAddr-    , sizeOfSockAddrByFamily     , withSockAddr-    , withNewSockAddr      -- * Unsorted     , ProtocolNumber-    , PortNumber(..)+    , defaultProtocol+    , PortNumber+    , defaultPort      -- * Low-level helpers     , zeroMemory+    , htonl+    , ntohl     ) where -import Control.Concurrent.MVar-import Control.Monad-import Data.Bits-import Data.Maybe-import Data.Typeable-import Data.Word-import Data.Int-import Foreign.C+import Control.Monad (when)+import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef', mkWeakIORef)+import Foreign.C.Error (throwErrno) import Foreign.Marshal.Alloc+import GHC.Conc (closeFdWith)+import System.Posix.Types (Fd)+import Control.DeepSeq (NFData (..))++#if defined(DOMAIN_SOCKET_SUPPORT) import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable+#endif --- | A socket data type.---  'Socket's are not GCed unless they are closed by 'close'.-data Socket-  = MkSocket-            CInt                 -- File Descriptor-            Family-            SocketType-            ProtocolNumber       -- Protocol Number-            (MVar SocketStatus)  -- Status Flag-  deriving Typeable+import Network.Socket.Imports -{-# DEPRECATED MkSocket "'MkSocket' will not be available in version 3.0.0.0 or later. Use fdSocket instead" #-}+----------------------------------------------------------------------------- --- | Obtaining the file descriptor from a socket.+-- | Basic type for a socket.+data Socket = Socket !(IORef CInt) !CInt {- for Show -}++instance Show Socket where+    show (Socket _ ofd) = "<socket: " ++ show ofd ++ ">"++instance Eq Socket where+    Socket ref1 _ == Socket ref2 _ = ref1 == ref2++-- | Getting a file descriptor from a socket. -- --   If a 'Socket' is shared with multiple threads and --   one uses 'fdSocket', unexpected issues may happen.@@ -102,46 +104,92 @@ --   In this case, it is safer for Thread A to clone 'Fd' by --   'System.Posix.IO.dup'. But this would still suffer from --   a rase condition between 'fdSocket' and 'close'.-fdSocket :: Socket -> CInt-fdSocket (MkSocket fd _ _ _ _) = fd+fdSocket :: Socket -> IO CInt+fdSocket (Socket ref _) = readIORef ref -sockFamily :: Socket -> Family-sockFamily   (MkSocket _ f _ _ _) = f+-- | Creating a socket from a file descriptor.+mkSocket :: CInt -> IO Socket+mkSocket fd = do+    ref <- newIORef fd+    let s = Socket ref fd+    void $ mkWeakIORef ref $ close s+    return s -sockType :: Socket -> SocketType-sockType     (MkSocket _ _ t _ _) = t+invalidSocket :: CInt+#if defined(mingw32_HOST_OS)+invalidSocket = #const INVALID_SOCKET+#else+invalidSocket = -1+#endif -sockProtocol :: Socket -> ProtocolNumber-sockProtocol (MkSocket _ _ _ p _) = p+invalidateSocket ::+      Socket+   -> (CInt -> IO a)+   -> (CInt -> IO a)+   -> IO a+invalidateSocket (Socket ref _) errorAction normalAction = do+    oldfd <- atomicModifyIORef' ref $ \cur -> (invalidSocket, cur)+    if oldfd == invalidSocket then errorAction oldfd else normalAction oldfd -sockStatus :: Socket -> MVar SocketStatus-sockStatus   (MkSocket _ _ _ _ s) = s+----------------------------------------------------------------------------- -instance Eq Socket where-  (MkSocket _ _ _ _ m1) == (MkSocket _ _ _ _ m2) = m1 == m2+-- | Close the socket. This function does not throw exceptions even if+--   the underlying system call returns errors.+--+--   Sending data to or receiving data from closed socket+--   may lead to undefined behaviour.+--+--   If multiple threads use the same socket and one uses 'fdSocket' and+--   the other use 'close', unexpected behavior may happen.+--   For more information, please refer to the documentation of 'fdSocket'.+close :: Socket -> IO ()+close s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do+    -- closeFdWith avoids the deadlock of IO manager.+    closeFdWith closeFd (toFd oldfd)+  where+    toFd :: CInt -> Fd+    toFd = fromIntegral+    -- closeFd ignores the return value of c_close and+    -- does not throw exceptions+    closeFd :: Fd -> IO ()+    closeFd = void . c_close . fromIntegral -instance Show Socket where-  showsPrec _n (MkSocket fd _ _ _ _) =-        showString "<socket: " . shows fd . showString ">"+-- | Close the socket. This function throws exceptions if+--   the underlying system call returns errors.+--+--   Sending data to or receiving data from closed socket+--   may lead to undefined behaviour.+close' :: Socket -> IO ()+close' s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do+    -- closeFdWith avoids the deadlock of IO manager.+    closeFdWith closeFd (toFd oldfd)+  where+    toFd :: CInt -> Fd+    toFd = fromIntegral+    closeFd :: Fd -> IO ()+    closeFd fd = do+        ret <- c_close $ fromIntegral fd+        when (ret == -1) $ throwErrno "Network.Socket.close'" +#if defined(mingw32_HOST_OS)+foreign import CALLCONV unsafe "closesocket"+  c_close :: CInt -> IO CInt+#else+foreign import ccall unsafe "close"+  c_close :: CInt -> IO CInt+#endif++-----------------------------------------------------------------------------++-- | Protocl number. type ProtocolNumber = CInt --- | The status of the socket as /determined by this library/, not--- necessarily reflecting the state of the connection itself.+-- | This is the default protocol for a given service. ----- For example, the 'Closed' status is applied when the 'close'--- function is called.-data SocketStatus-  -- Returned Status    Function called-  = NotConnected        -- ^ Newly created, unconnected socket-  | Bound               -- ^ Bound, via 'bind'-  | Listening           -- ^ Listening, via 'listen'-  | Connected           -- ^ Connected or accepted, via 'connect' or 'accept'-  | ConvertedToHandle   -- ^ Is now a 'Handle' (via 'socketToHandle'), don't touch-  | Closed              -- ^ Closed was closed by 'close'-    deriving (Eq, Show, Typeable)--{-# DEPRECATED SocketStatus "SocketStatus will be removed" #-}+-- >>> defaultProtocol+-- 0+defaultProtocol :: ProtocolNumber+defaultProtocol = 0  ----------------------------------------------------------------------------- -- Socket types@@ -201,8 +249,6 @@ #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@@ -254,74 +300,75 @@ -- A constructor being present here does not mean it is supported by the -- operating system: see 'isSupportedFamily'. data Family-    = AF_UNSPEC           -- unspecified-    | AF_UNIX             -- local to host (pipes, portals-    | AF_INET             -- internetwork: UDP, TCP, etc-    | AF_INET6            -- Internet Protocol version 6-    | AF_IMPLINK          -- arpanet imp addresses-    | AF_PUP              -- pup protocols: e.g. BSP-    | AF_CHAOS            -- mit CHAOS protocols-    | AF_NS               -- XEROX NS protocols-    | AF_NBS              -- nbs protocols-    | AF_ECMA             -- european computer manufacturers-    | AF_DATAKIT          -- datakit protocols-    | AF_CCITT            -- CCITT protocols, X.25 etc-    | AF_SNA              -- IBM SNA-    | AF_DECnet           -- DECnet-    | AF_DLI              -- Direct data link interface-    | AF_LAT              -- LAT-    | AF_HYLINK           -- NSC Hyperchannel-    | AF_APPLETALK        -- Apple Talk-    | AF_ROUTE            -- Internal Routing Protocol (aka AF_NETLINK)-    | AF_NETBIOS          -- NetBios-style addresses-    | AF_NIT              -- Network Interface Tap-    | AF_802              -- IEEE 802.2, also ISO 8802-    | AF_ISO              -- ISO protocols-    | AF_OSI              -- umbrella of all families used by OSI-    | AF_NETMAN           -- DNA Network Management-    | AF_X25              -- CCITT X.25-    | AF_AX25-    | AF_OSINET           -- AFI-    | AF_GOSSIP           -- US Government OSI-    | AF_IPX              -- Novell Internet Protocol-    | Pseudo_AF_XTP       -- eXpress Transfer Protocol (no AF)-    | AF_CTF              -- Common Trace Facility-    | AF_WAN              -- Wide Area Network protocols-    | AF_SDL              -- SGI Data Link for DLPI-    | AF_NETWARE-    | AF_NDD-    | AF_INTF             -- Debugging use only-    | AF_COIP             -- connection-oriented IP, aka ST II-    | AF_CNT              -- Computer Network Technology-    | Pseudo_AF_RTIP      -- Help Identify RTIP packets-    | Pseudo_AF_PIP       -- Help Identify PIP packets-    | AF_SIP              -- Simple Internet Protocol-    | AF_ISDN             -- Integrated Services Digital Network-    | Pseudo_AF_KEY       -- Internal key-management function-    | AF_NATM             -- native ATM access-    | AF_ARP              -- (rev.) addr. res. prot. (RFC 826)-    | Pseudo_AF_HDRCMPLT  -- Used by BPF to not rewrite hdrs in iface output-    | AF_ENCAP-    | AF_LINK             -- Link layer interface-    | AF_RAW              -- Link layer interface-    | AF_RIF              -- raw interface-    | AF_NETROM           -- Amateur radio NetROM-    | AF_BRIDGE           -- multiprotocol bridge-    | AF_ATMPVC           -- ATM PVCs-    | AF_ROSE             -- Amateur Radio X.25 PLP-    | AF_NETBEUI          -- 802.2LLC-    | AF_SECURITY         -- Security callback pseudo AF-    | AF_PACKET           -- Packet family-    | AF_ASH              -- Ash-    | AF_ECONET           -- Acorn Econet-    | AF_ATMSVC           -- ATM SVCs-    | AF_IRDA             -- IRDA sockets-    | AF_PPPOX            -- PPPoX sockets-    | AF_WANPIPE          -- Wanpipe API sockets-    | AF_BLUETOOTH        -- bluetooth sockets-    | AF_CAN              -- Controller Area Network+    = AF_UNSPEC           -- ^ unspecified+    | AF_UNIX             -- ^ UNIX-domain+    | AF_INET             -- ^ Internet Protocol version 4+    | AF_INET6            -- ^ Internet Protocol version 6+    | AF_IMPLINK          -- ^ Arpanet imp addresses+    | AF_PUP              -- ^ pup protocols: e.g. BSP+    | AF_CHAOS            -- ^ mit CHAOS protocols+    | AF_NS               -- ^ XEROX NS protocols+    | AF_NBS              -- ^ nbs protocols+    | AF_ECMA             -- ^ european computer manufacturers+    | AF_DATAKIT          -- ^ datakit protocols+    | AF_CCITT            -- ^ CCITT protocols, X.25 etc+    | AF_SNA              -- ^ IBM SNA+    | AF_DECnet           -- ^ DECnet+    | AF_DLI              -- ^ Direct data link interface+    | AF_LAT              -- ^ LAT+    | AF_HYLINK           -- ^ NSC Hyperchannel+    | AF_APPLETALK        -- ^ Apple Talk+    | AF_ROUTE            -- ^ Internal Routing Protocol (aka AF_NETLINK)+    | AF_NETBIOS          -- ^ NetBios-style addresses+    | AF_NIT              -- ^ Network Interface Tap+    | AF_802              -- ^ IEEE 802.2, also ISO 8802+    | AF_ISO              -- ^ ISO protocols+    | AF_OSI              -- ^ umbrella of all families used by OSI+    | AF_NETMAN           -- ^ DNA Network Management+    | AF_X25              -- ^ CCITT X.25+    | AF_AX25             -- ^ AX25+    | AF_OSINET           -- ^ AFI+    | AF_GOSSIP           -- ^ US Government OSI+    | AF_IPX              -- ^ Novell Internet Protocol+    | Pseudo_AF_XTP       -- ^ eXpress Transfer Protocol (no AF)+    | AF_CTF              -- ^ Common Trace Facility+    | AF_WAN              -- ^ Wide Area Network protocols+    | AF_SDL              -- ^ SGI Data Link for DLPI+    | AF_NETWARE          -- ^ Netware+    | AF_NDD              -- ^ NDD+    | AF_INTF             -- ^ Debugging use only+    | AF_COIP             -- ^ connection-oriented IP, aka ST II+    | AF_CNT              -- ^ Computer Network Technology+    | Pseudo_AF_RTIP      -- ^ Help Identify RTIP packets+    | Pseudo_AF_PIP       -- ^ Help Identify PIP packets+    | AF_SIP              -- ^ Simple Internet Protocol+    | AF_ISDN             -- ^ Integrated Services Digital Network+    | Pseudo_AF_KEY       -- ^ Internal key-management function+    | AF_NATM             -- ^ native ATM access+    | AF_ARP              -- ^ ARP (RFC 826)+    | Pseudo_AF_HDRCMPLT  -- ^ Used by BPF to not rewrite hdrs in iface output+    | AF_ENCAP            -- ^ ENCAP+    | AF_LINK             -- ^ Link layer interface+    | AF_RAW              -- ^ Link layer interface+    | AF_RIF              -- ^ raw interface+    | AF_NETROM           -- ^ Amateur radio NetROM+    | AF_BRIDGE           -- ^ multiprotocol bridge+    | AF_ATMPVC           -- ^ ATM PVCs+    | AF_ROSE             -- ^ Amateur Radio X.25 PLP+    | AF_NETBEUI          -- ^ Netbeui 802.2LLC+    | AF_SECURITY         -- ^ Security callback pseudo AF+    | AF_PACKET           -- ^ Packet family+    | AF_ASH              -- ^ Ash+    | AF_ECONET           -- ^ Acorn Econet+    | AF_ATMSVC           -- ^ ATM SVCs+    | AF_IRDA             -- ^ IRDA sockets+    | AF_PPPOX            -- ^ PPPoX sockets+    | AF_WANPIPE          -- ^ Wanpipe API sockets+    | AF_BLUETOOTH        -- ^ bluetooth sockets+    | AF_CAN              -- ^ Controller Area Network       deriving (Eq, Ord, Read, Show) +-- | Converting 'Family' to 'CInt'. packFamily :: Family -> CInt packFamily f = case packFamily' f of     Just fam -> fam@@ -538,6 +585,7 @@  --------- ---------- +-- | Converting 'CInt' to 'Family'. unpackFamily :: CInt -> Family unpackFamily f = case f of         (#const AF_UNSPEC) -> AF_UNSPEC@@ -745,8 +793,9 @@ ------------------------------------------------------------------------ -- Port Numbers --- | Use the @Num@ instance (i.e. use a literal) to create a--- @PortNumber@ value.+-- | Port number.+--   Use the @Num@ instance (i.e. use a literal) to create a+--   @PortNumber@ value. -- -- >>> 1 :: PortNumber -- 1@@ -772,16 +821,50 @@  foreign import CALLCONV unsafe "ntohs" ntohs :: Word16 -> Word16 foreign import CALLCONV unsafe "htons" htons :: Word16 -> Word16-foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32+-- | Converts the from host byte order to network byte order. foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32+-- | 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" #-}  instance Storable PortNumber where    sizeOf    _ = sizeOf    (undefined :: Word16)    alignment _ = alignment (undefined :: Word16)    poke p (PortNum po) = poke (castPtr p) (htons po)-   peek p = (PortNum . ntohs) `liftM` peek (castPtr p)+   peek p = PortNum . ntohs <$> peek (castPtr p) +-- | Default port number.+--+-- >>> defaultPort+-- 0+defaultPort :: PortNumber+defaultPort = 0+ ------------------------------------------------------------------------++-- | The core typeclass to unify socket addresses.+class SocketAddress sa where+    sizeOfSocketAddress :: sa -> Int+    peekSocketAddress :: Ptr sa -> IO sa+    pokeSocketAddress  :: Ptr a -> sa -> IO ()++-- sizeof(struct sockaddr_storage) which has enough space to contain+-- sockaddr_in, sockaddr_in6 and sockaddr_un.+sockaddrStorageLen :: Int+sockaddrStorageLen = 128++withSocketAddress :: SocketAddress sa => sa -> (Ptr sa -> Int -> IO a) -> IO a+withSocketAddress addr f = do+    let sz = sizeOfSocketAddress addr+    allocaBytes sz $ \p -> pokeSocketAddress p addr >> f (castPtr p) sz++withNewSocketAddress :: SocketAddress sa => (Ptr sa -> Int -> IO a) -> IO a+withNewSocketAddress f = allocaBytes sockaddrStorageLen $ \ptr -> do+    zeroMemory ptr $ fromIntegral sockaddrStorageLen+    f ptr sockaddrStorageLen++------------------------------------------------------------------------ -- Socket addresses  -- The scheme used for addressing sockets is somewhat quirky. The@@ -801,49 +884,51 @@ -- families. Currently only UNIX-domain sockets and the Internet -- families are supported. +-- | Flow information. type FlowInfo = Word32+-- | Scope identifier. type ScopeID = Word32 --- | The existence of a constructor does not necessarily imply that--- that socket address type is supported on your system: see+-- | Socket addresses.+--  The existence of a constructor does not necessarily imply that+--  that socket address type is supported on your system: see -- 'isSupportedSockAddr'.-data SockAddr       -- C Names+data SockAddr   = SockAddrInet-    PortNumber  -- sin_port-    HostAddress -- sin_addr  (ditto)+        !PortNumber      -- sin_port+        !HostAddress     -- sin_addr  (ditto)   | SockAddrInet6-        PortNumber      -- sin6_port-        FlowInfo        -- sin6_flowinfo (ditto)-        HostAddress6    -- sin6_addr (ditto)-        ScopeID         -- sin6_scope_id (ditto)+        !PortNumber      -- sin6_port+        !FlowInfo        -- sin6_flowinfo (ditto)+        !HostAddress6    -- sin6_addr (ditto)+        !ScopeID         -- sin6_scope_id (ditto)+  -- | 'String' must be a list of 0-255 values and its length should be less than 104.   | SockAddrUnix-        String          -- sun_path-  | SockAddrCan-        Int32           -- can_ifindex (can be get by Network.BSD.ifNameToIndex "can0")-        -- TODO: Extend this to include transport protocol information+        String           -- sun_path   deriving (Eq, Ord, Typeable) +instance NFData SockAddr where+  rnf (SockAddrInet _ _) = ()+  rnf (SockAddrInet6 _ _ _ _) = ()+  rnf (SockAddrUnix str) = rnf str+ -- | Is the socket address type supported on this system? isSupportedSockAddr :: SockAddr -> Bool isSupportedSockAddr addr = case addr of-  SockAddrInet {} -> True-#if defined(IPV6_SOCKET_SUPPORT)-  SockAddrInet6 {} -> True-#endif+  SockAddrInet{}  -> True+  SockAddrInet6{} -> True #if defined(DOMAIN_SOCKET_SUPPORT)-  SockAddrUnix{} -> True-#endif-#if defined(CAN_SOCKET_SUPPORT)-  SockAddrCan{} -> True-#endif-#if !(defined(IPV6_SOCKET_SUPPORT) \-      && defined(DOMAIN_SOCKET_SUPPORT) && defined(CAN_SOCKET_SUPPORT))-  _ -> False+  SockAddrUnix{}  -> True+#else+  SockAddrUnix{}  -> False #endif -{-# DEPRECATED SockAddrCan "This will be removed in 3.0" #-}+instance SocketAddress SockAddr where+    sizeOfSocketAddress = sizeOfSockAddr+    peekSocketAddress   = peekSockAddr+    pokeSocketAddress   = pokeSockAddr -#if defined(WITH_WINSOCK)+#if defined(mingw32_HOST_OS) type CSaFamily = (#type unsigned short) #elif defined(darwin_HOST_OS) type CSaFamily = (#type u_char)@@ -856,39 +941,12 @@ -- in that the value of the argument /is/ used. sizeOfSockAddr :: SockAddr -> Int #if defined(DOMAIN_SOCKET_SUPPORT)-sizeOfSockAddr (SockAddrUnix path) =-    case path of-        '\0':_ -> (#const sizeof(sa_family_t)) + length path-        _      -> #const sizeof(struct sockaddr_un)-#endif-sizeOfSockAddr (SockAddrInet _ _) = #const sizeof(struct sockaddr_in)-#if defined(IPV6_SOCKET_SUPPORT)-sizeOfSockAddr (SockAddrInet6 _ _ _ _) = #const sizeof(struct sockaddr_in6)-#endif-#if defined(CAN_SOCKET_SUPPORT)-sizeOfSockAddr (SockAddrCan _) = #const sizeof(struct sockaddr_can)-#endif-#if !(defined(IPV6_SOCKET_SUPPORT) \-      && defined(DOMAIN_SOCKET_SUPPORT) && defined(CAN_SOCKET_SUPPORT))-sizeOfSockAddr _ = error "sizeOfSockAddr: not supported"-#endif---- | Computes the storage requirements (in bytes) required for a--- 'SockAddr' with the given 'Family'.-sizeOfSockAddrByFamily :: Family -> Int-#if defined(DOMAIN_SOCKET_SUPPORT)-sizeOfSockAddrByFamily AF_UNIX  = #const sizeof(struct sockaddr_un)-#endif-#if defined(IPV6_SOCKET_SUPPORT)-sizeOfSockAddrByFamily AF_INET6 = #const sizeof(struct sockaddr_in6)-#endif-sizeOfSockAddrByFamily AF_INET  = #const sizeof(struct sockaddr_in)-#if defined(CAN_SOCKET_SUPPORT)-sizeOfSockAddrByFamily AF_CAN   = #const sizeof(struct sockaddr_can)+sizeOfSockAddr SockAddrUnix{}  = #const sizeof(struct sockaddr_un)+#else+sizeOfSockAddr SockAddrUnix{}  = error "sizeOfSockAddr: not supported" #endif-sizeOfSockAddrByFamily family = error $-    "Network.Socket.Types.sizeOfSockAddrByFamily: address family '" ++-    show family ++ "' not supported."+sizeOfSockAddr SockAddrInet{}  = #const sizeof(struct sockaddr_in)+sizeOfSockAddr SockAddrInet6{} = #const sizeof(struct sockaddr_in6)  -- | Use a 'SockAddr' with a function requiring a pointer to a -- 'SockAddr' and the length of that 'SockAddr'.@@ -897,13 +955,6 @@     let sz = sizeOfSockAddr addr     allocaBytes sz $ \p -> pokeSockAddr p addr >> f (castPtr p) sz --- | Create a new 'SockAddr' for use with a function requiring a--- pointer to a 'SockAddr' and the length of that 'SockAddr'.-withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a-withNewSockAddr family f = do-    let sz = sizeOfSockAddrByFamily family-    allocaBytes sz $ \ptr -> f ptr sz- -- We cannot bind sun_paths longer than than the space in the sockaddr_un -- structure, and attempting to do so could overflow the allocated storage -- space.  This constant holds the maximum allowable path length.@@ -926,48 +977,34 @@ pokeSockAddr p sa@(SockAddrUnix path) = do     when (length path > unixPathMax) $ error "pokeSockAddr: path is too long"     zeroMemory p $ fromIntegral $ sizeOfSockAddr sa-#if defined(HAVE_STRUCT_SOCKADDR_SA_LEN)+# if defined(HAVE_STRUCT_SOCKADDR_SA_LEN)     (#poke struct sockaddr_un, sun_len) p ((#const sizeof(struct sockaddr_un)) :: Word8)-#endif+# endif     (#poke struct sockaddr_un, sun_family) p ((#const AF_UNIX) :: CSaFamily)     let pathC = map castCharToCChar path+    -- the buffer is already filled with nulls.     pokeArray ((#ptr struct sockaddr_un, sun_path) p) pathC+#else+pokeSockAddr _ SockAddrUnix{} = error "pokeSockAddr: not supported" #endif pokeSockAddr p (SockAddrInet port addr) = do-#if defined(darwin_HOST_OS)     zeroMemory p (#const sizeof(struct sockaddr_in))-#endif #if defined(HAVE_STRUCT_SOCKADDR_SA_LEN)     (#poke struct sockaddr_in, sin_len) p ((#const sizeof(struct sockaddr_in)) :: Word8) #endif     (#poke struct sockaddr_in, sin_family) p ((#const AF_INET) :: CSaFamily)     (#poke struct sockaddr_in, sin_port) p port     (#poke struct sockaddr_in, sin_addr) p addr-#if defined(IPV6_SOCKET_SUPPORT) pokeSockAddr p (SockAddrInet6 port flow addr scope) = do-#if defined(darwin_HOST_OS)     zeroMemory p (#const sizeof(struct sockaddr_in6))-#endif-#if defined(HAVE_STRUCT_SOCKADDR_SA_LEN)+# if defined(HAVE_STRUCT_SOCKADDR_SA_LEN)     (#poke struct sockaddr_in6, sin6_len) p ((#const sizeof(struct sockaddr_in6)) :: Word8)-#endif+# endif     (#poke struct sockaddr_in6, sin6_family) p ((#const AF_INET6) :: CSaFamily)     (#poke struct sockaddr_in6, sin6_port) p port     (#poke struct sockaddr_in6, sin6_flowinfo) p flow     (#poke struct sockaddr_in6, sin6_addr) p (In6Addr addr)     (#poke struct sockaddr_in6, sin6_scope_id) p scope-#endif-#if defined(CAN_SOCKET_SUPPORT)-pokeSockAddr p (SockAddrCan ifIndex) = do-#if defined(darwin_HOST_OS)-    zeroMemory p (#const sizeof(struct sockaddr_can))-#endif-    (#poke struct sockaddr_can, can_ifindex) p ifIndex-#endif-#if !(defined(IPV6_SOCKET_SUPPORT) \-      && defined(DOMAIN_SOCKET_SUPPORT) && defined(CAN_SOCKET_SUPPORT))-pokeSockAddr _ _ = error "pokeSockAddr: not supported"-#endif  -- | Read a 'SockAddr' from the given memory location. peekSockAddr :: Ptr SockAddr -> IO SockAddr@@ -976,26 +1013,19 @@   case family :: CSaFamily of #if defined(DOMAIN_SOCKET_SUPPORT)     (#const AF_UNIX) -> do-        str <- peekCString ((#ptr struct sockaddr_un, sun_path) p)+        str <- peekCAString ((#ptr struct sockaddr_un, sun_path) p)         return (SockAddrUnix str) #endif     (#const AF_INET) -> do         addr <- (#peek struct sockaddr_in, sin_addr) p         port <- (#peek struct sockaddr_in, sin_port) p         return (SockAddrInet port addr)-#if defined(IPV6_SOCKET_SUPPORT)     (#const AF_INET6) -> do         port <- (#peek struct sockaddr_in6, sin6_port) p         flow <- (#peek struct sockaddr_in6, sin6_flowinfo) p         In6Addr addr <- (#peek struct sockaddr_in6, sin6_addr) p         scope <- (#peek struct sockaddr_in6, sin6_scope_id) p         return (SockAddrInet6 port flow addr scope)-#endif-#if defined(CAN_SOCKET_SUPPORT)-    (#const AF_CAN) -> do-        ifidx <- (#peek struct sockaddr_can, can_ifindex) p-        return (SockAddrCan ifidx)-#endif     _ -> ioError $ userError $       "Network.Socket.Types.peekSockAddr: address family '" ++       show family ++ "' not supported."@@ -1014,6 +1044,8 @@ -- | Converts 'HostAddress' to representation-independent IPv4 quadruple. -- For example for @127.0.0.1@ the function will return @(0x7f, 0, 0, 1)@ -- regardless of host endianness.+--+{- -- prop> tow == hostAddressToTuple (tupleToHostAddress tow) -} hostAddressToTuple :: HostAddress -> (Word8, Word8, Word8, Word8) hostAddressToTuple ha' =     let ha = htonl ha'@@ -1032,7 +1064,9 @@ -- 'tupleToHostAddress6'. type HostAddress6 = (Word32, Word32, Word32, Word32) -#if defined(IPV6_SOCKET_SUPPORT)+-- | Converts 'HostAddress6' to representation-independent IPv6 octuple.+--+{- -- prop> (w1,w2,w3,w4,w5,w6,w7,w8) == hostAddress6ToTuple (tupleToHostAddress6 (w1,w2,w3,w4,w5,w6,w7,w8)) -} hostAddress6ToTuple :: HostAddress6 -> (Word16, Word16, Word16, Word16,                                         Word16, Word16, Word16, Word16) hostAddress6ToTuple (w3, w2, w1, w0) =@@ -1041,6 +1075,7 @@         low w = fromIntegral w     in (high w3, low w3, high w2, low w2, high w1, low w1, high w0, low w0) +-- | Converts IPv6 octuple to 'HostAddress6'. tupleToHostAddress6 :: (Word16, Word16, Word16, Word16,                         Word16, Word16, Word16, Word16) -> HostAddress6 tupleToHostAddress6 (w7, w6, w5, w4, w3, w2, w1, w0) =@@ -1099,7 +1134,6 @@         poke32 p 1 b         poke32 p 2 c         poke32 p 3 d-#endif  ------------------------------------------------------------------------ -- Helper functions
+ Network/Socket/Unix.hsc view
@@ -0,0 +1,177 @@+{-# LANGUAGE CPP #-}++#include "HsNet.h"+##include "HsNetDef.h"++module Network.Socket.Unix (+    isUnixDomainSocketAvailable+  , socketPair+  , sendFd+  , recvFd+  , getPeerCredential+  , getPeerCred+  , getPeerEid+  ) where++import Network.Socket.Imports+import Network.Socket.Types++#ifdef HAVE_STRUCT_UCRED_SO_PEERCRED+import Foreign.Marshal.Utils (with)+#endif+#ifdef HAVE_GETPEEREID+import qualified Control.Exception as E+import Foreign.Marshal.Alloc (alloca)+#endif+#ifdef DOMAIN_SOCKET_SUPPORT+import Control.Monad (void)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Marshal.Array (peekArray)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))++import Network.Socket.Fcntl+import Network.Socket.Internal+#endif+#ifdef HAVE_STRUCT_UCRED_SO_PEERCRED+import Network.Socket.Options (c_getsockopt)+#endif++-- | 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_SO_PEERCRED+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++-- | Returns the processID, userID and groupID of the peer of+--   a UNIX-domain socket.+--+-- Only available on platforms that support SO_PEERCRED.+getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt)+#ifdef HAVE_STRUCT_UCRED_SO_PEERCRED+getPeerCred s = do+  let sz = (#const sizeof(struct ucred))+  fd <- fdSocket s+  allocaBytes sz $ \ ptr_cr ->+   with (fromIntegral sz) $ \ ptr_sz -> do+     _ <- ($) throwSocketErrorIfMinus1Retry "Network.Socket.getPeerCred" $+       c_getsockopt fd (#const SOL_SOCKET) (#const SO_PEERCRED) ptr_cr ptr_sz+     pid <- (#peek struct ucred, pid) ptr_cr+     uid <- (#peek struct ucred, uid) ptr_cr+     gid <- (#peek struct ucred, gid) ptr_cr+     return (pid, uid, gid)+#else+getPeerCred _ = return (0, 0, 0)+#endif+{-# Deprecated getPeerCred "Use getPeerCredential instead" #-}++-- | Returns the userID and groupID of the peer of+--   a UNIX-domain socket.+--+--  Only available on platforms that support getpeereid().+getPeerEid :: Socket -> IO (CUInt, CUInt)+#ifdef HAVE_GETPEEREID+getPeerEid s = do+  alloca $ \ ptr_uid ->+    alloca $ \ ptr_gid -> do+      fd <- fdSocket s+      throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerEid" $+        c_getpeereid fd ptr_uid ptr_gid+      uid <- peek ptr_uid+      gid <- peek ptr_gid+      return (uid, gid)++foreign import CALLCONV unsafe "getpeereid"+  c_getpeereid :: CInt -> Ptr CUInt -> Ptr CUInt -> IO CInt+#else+getPeerEid _ = return (0, 0)+#endif++{-# Deprecated getPeerEid "Use getPeerCredential instead" #-}++-- | Whether or not UNIX-domain sockets are available.+--+--   Since 2.7.0.0.+isUnixDomainSocketAvailable :: Bool+#if defined(DOMAIN_SOCKET_SUPPORT)+isUnixDomainSocketAvailable = True+#else+isUnixDomainSocketAvailable = False+#endif++-- | Send a file descriptor over a UNIX-domain socket.+--   Use this function in the case where 'isUnixDomainSocketAvailable' is+--  'True'.+sendFd :: Socket -> CInt -> IO ()+#if defined(DOMAIN_SOCKET_SUPPORT)+sendFd s outfd = void $ do+  fd <- fdSocket s+  throwSocketErrorWaitWrite s "Network.Socket.sendFd" $ c_sendFd fd outfd+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 UNIX-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'.+--   Use this function in the case where 'isUnixDomainSocketAvailable' is+--  'True'.+recvFd :: Socket -> IO CInt+#if defined(DOMAIN_SOCKET_SUPPORT)+recvFd s = do+  fd <- fdSocket s+  throwSocketErrorWaitRead s "Network.Socket.recvFd" $ c_recvFd fd+foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt+#else+recvFd _ = error "Network.Socket.recvFd"+#endif++-- | Build a pair of connected socket objects.+--   For portability, use this function in the case+--   where 'isUnixDomainSocketAvailable' is 'True'+--   and specify 'AF_UNIX' to the first argument.+socketPair :: Family              -- Family Name (usually AF_UNIX)+           -> SocketType          -- Socket Type (usually Stream)+           -> ProtocolNumber      -- Protocol Number+           -> IO (Socket, Socket) -- unnamed and connected.+#if defined(DOMAIN_SOCKET_SUPPORT)+socketPair family stype protocol =+    allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do+      c_stype <- packSocketTypeOrThrow "socketPair" stype+      _rc <- throwSocketErrorIfMinus1Retry "Network.Socket.socketpair" $+                  c_socketpair (packFamily family) c_stype protocol fdArr+      [fd1,fd2] <- peekArray 2 fdArr+      setNonBlockIfNeeded fd1+      setNonBlockIfNeeded fd2+      s1 <- mkSocket fd1+      s2 <- mkSocket fd2+      return (s1, s2)++foreign import ccall unsafe "socketpair"+  c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt+#else+socketPair _ _ _ = error "Network.Socket.socketPair"+#endif
README.md view
@@ -1,19 +1,66 @@ # [`network`](http://hackage.haskell.org/package/network) [![Build Status](https://travis-ci.org/haskell/network.svg?branch=master)](https://travis-ci.org/haskell/network) [![Build status](https://ci.appveyor.com/api/projects/status/5erq63o4m29bhl57/branch/master?svg=true)](https://ci.appveyor.com/project/eborden/network/branch/master) -To build this package using Cabal directly from git, you must run-`autoreconf` before the usual Cabal build steps-(configure/build/install).  `autoreconf` is included in the-[GNU Autoconf](http://www.gnu.org/software/autoconf/) tools.  There is-no need to run the `configure` script: the `setup configure` step will-do this for you.+To build this package directly from git, you must run `autoreconf -i`.+And then use `cabal configure; cabal build` or `stack build`.  ## Support Policy  ### GHC -`network`'s GHC policy supports 3 [stable](https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/intro.html#ghc-version-numbering-policy) versions. The current stable-version and two previous stable versions are supported.+The `network` package support [3 major versions of GHC](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/intro.html#ghc-version-numbering-policy) only.+This means that the current stable version and two previous stable versions are supported. -### Hugs, JHC, UHC+### Windows -`network` does not officially support these compilers.+We use MSYS to build this package on Windows.+To use the `network` package on Cygwin, use `stack`.++## Coding++### .hs files++If you need C macros created by "configure" or `CALLCONV`/`SAFE_ON_WIN`, put++```+#include "HsNetDef.h"+```++"HsNet.h" does now work well since Mac's cpp sucks.++### .hsc files++If you need `#peek`, `#poke` and others, create a `.hsc` file with++```+#include "HsNet.h"+```++`HsNet.h` includes `HsNefDef.h` and necessary C structures.+Unfortunately, `hsc2hs` does not convert C macros.+So, if you use `CALLCONV`/`SAFE_ON_WIN`, the following is also necessary:++```+##include "HsNetDef.h"+```++## Milestones++### 2.6++- [x] Making `SockAddrCan` deprecated++### 2.7++See https://github.com/haskell/network/issues/296++- Making `Network` deprecated+- Making `Network.BSD` deprecated+- Making `MkSocket` deprecated+- Making many APIs deprecated++### 3.0++- Removing `Network`+- Removing `Network.BSD`+- Removing `SockAddrCan`+- Changing the internal structure of `Socket`.
cbits/asyncAccept.c view
@@ -5,14 +5,14 @@ #include "HsNet.h" #include "HsFFI.h" -#if defined(HAVE_WINSOCK2_H)+#if defined(_WIN32)  /* all the way to the end */  /*  * To support non-blocking accept()s with WinSock, we use the asyncDoProc#  * primop, which lets a Haskell thread call an external routine without- * blocking the progress of other threads. + * blocking the progress of other threads.  *  * As can readily be seen, this is a low-level mechanism.  *@@ -26,7 +26,7 @@ } AcceptData;  /*- * Fill in parameter block that's passed along when the RTS invokes the + * Fill in parameter block that's passed along when the RTS invokes the  * accept()-calling proc below (acceptDoProc())  */ void*@@ -40,7 +40,7 @@     data->newSock  = 0;     data->sockAddr = sockaddr;     data->size     = sz;-    +     return data; }
cbits/initWinSock.c view
@@ -1,7 +1,7 @@ #include "HsNet.h" #include "HsFFI.h" -#if defined(HAVE_WINSOCK2_H)+#if defined(_WIN32)  static int winsock_inited = 0; @@ -16,14 +16,14 @@ initWinSock () {   WORD wVersionRequested;-  WSADATA wsaData;  +  WSADATA wsaData;   int err;    if (!winsock_inited) {     wVersionRequested = MAKEWORD( 2, 2 );      err = WSAStartup ( wVersionRequested, &wsaData );-    +     if ( err != 0 ) {        return err;     }
cbits/winSockErr.c view
@@ -1,7 +1,7 @@ #include "HsNet.h" #include "HsFFI.h" -#if defined(HAVE_WINSOCK2_H)+#if defined(_WIN32) #include <stdio.h>  /* to the end */
configure view
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.69 for Haskell network package 2.8.0.1.+# Generated by GNU Autoconf 2.69 for Haskell network package 3.0.0.0. # # Report bugs to <libraries@haskell.org>. #@@ -580,8 +580,8 @@ # Identity of this package. PACKAGE_NAME='Haskell network package' PACKAGE_TARNAME='network'-PACKAGE_VERSION='2.8.0.1'-PACKAGE_STRING='Haskell network package 2.8.0.1'+PACKAGE_VERSION='3.0.0.0'+PACKAGE_STRING='Haskell network package 3.0.0.0' PACKAGE_BUGREPORT='libraries@haskell.org' PACKAGE_URL='' @@ -624,9 +624,6 @@  ac_subst_vars='LTLIBOBJS LIBOBJS-EXTRA_SRCS-EXTRA_LIBS-EXTRA_CPPFLAGS EGREP GREP CPP@@ -1248,7 +1245,7 @@   # Omit some internal or obsolete options to make the list less imposing.   # This message is too long to be a string in the A/UX 3.1 sh.   cat <<_ACEOF-\`configure' configures Haskell network package 2.8.0.1 to adapt to many kinds of systems.+\`configure' configures Haskell network package 3.0.0.0 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1314,7 +1311,7 @@  if test -n "$ac_init_help"; then   case $ac_init_help in-     short | recursive ) echo "Configuration of Haskell network package 2.8.0.1:";;+     short | recursive ) echo "Configuration of Haskell network package 3.0.0.0:";;    esac   cat <<\_ACEOF @@ -1399,7 +1396,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then   cat <<\_ACEOF-Haskell network package configure 2.8.0.1+Haskell network package configure 3.0.0.0 generated by GNU Autoconf 2.69  Copyright (C) 2012 Free Software Foundation, Inc.@@ -1652,6 +1649,60 @@  } # ac_fn_c_check_header_compile +# ac_fn_c_check_type LINENO TYPE VAR INCLUDES+# -------------------------------------------+# Tests whether TYPE exists after having included INCLUDES, setting cache+# variable VAR accordingly.+ac_fn_c_check_type ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5+$as_echo_n "checking for $2... " >&6; }+if eval \${$3+:} false; then :+  $as_echo_n "(cached) " >&6+else+  eval "$3=no"+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$4+int+main ()+{+if (sizeof ($2))+	 return 0;+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$4+int+main ()+{+if (sizeof (($2)))+	    return 0;+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :++else+  eval "$3=yes"+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+eval ac_res=\$$3+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno++} # ac_fn_c_check_type+ # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded.@@ -1765,6 +1816,52 @@  } # ac_fn_c_check_func +# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES+# ---------------------------------------------+# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR+# accordingly.+ac_fn_c_check_decl ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  as_decl_name=`echo $2|sed 's/ *(.*//'`+  as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5+$as_echo_n "checking whether $as_decl_name is declared... " >&6; }+if eval \${$3+:} false; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$4+int+main ()+{+#ifndef $as_decl_name+#ifdef __cplusplus+  (void) $as_decl_use;+#else+  (void) $as_decl_name;+#endif+#endif++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  eval "$3=yes"+else+  eval "$3=no"+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+eval ac_res=\$$3+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno++} # ac_fn_c_check_decl+ # ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES # ---------------------------------------------------- # Tries to find if the field MEMBER exists in type AGGR, after including@@ -1821,57 +1918,11 @@   eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno  } # ac_fn_c_check_member--# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES-# ----------------------------------------------# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR-# accordingly.-ac_fn_c_check_decl ()-{-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-  as_decl_name=`echo $2|sed 's/ *(.*//'`-  as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5-$as_echo_n "checking whether $as_decl_name is declared... " >&6; }-if eval \${$3+:} false; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-$4-int-main ()-{-#ifndef $as_decl_name-#ifdef __cplusplus-  (void) $as_decl_use;-#else-  (void) $as_decl_name;-#endif-#endif--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  eval "$3=yes"-else-  eval "$3=no"-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi-eval ac_res=\$$3-	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno--} # ac_fn_c_check_decl cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by Haskell network package $as_me 2.8.0.1, which was+It was created by Haskell network package $as_me 3.0.0.0, which was generated by GNU Autoconf 2.69.  Invocation command line was    $ $0 $@@@ -2220,26 +2271,59 @@   -ac_includes_default="$ac_includes_default+ac_includes_default="#define _GNU_SOURCE 1  /* for struct ucred on Linux */+$ac_includes_default++#ifdef _WIN32+# include <winsock2.h>+# include <ws2tcpip.h>+# define IPV6_V6ONLY 27+#endif++#ifdef HAVE_LIMITS_H+# include <limits.h>+#endif+#ifdef HAVE_STDLIB_H+# include <stdlib.h>+#endif+#ifdef HAVE_UNISTD_H+#include <unistd.h>+#endif+#ifdef HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif+#ifdef HAVE_FCNTL_H+# include <fcntl.h>+#endif+#ifdef HAVE_SYS_UIO_H+# include <sys/uio.h>+#endif #ifdef HAVE_SYS_SOCKET_H # include <sys/socket.h> #endif #ifdef HAVE_NETINET_IN_H # include <netinet/in.h> #endif+#ifdef HAVE_NETINET_TCP_H+# include <netinet/tcp.h>+#endif+#ifdef HAVE_SYS_UN_H+# include <sys/un.h>+#endif+#ifdef HAVE_ARPA_INET_H+# include <arpa/inet.h>+#endif #ifdef HAVE_NETDB_H-# include <netdb.h>+#include <netdb.h> #endif-#ifdef HAVE_WINSOCK2_H-# include <winsock2.h>+#ifdef HAVE_NET_IF_H+# include <net/if.h> #endif-#ifdef HAVE_WS2TCPIP_H-# include <ws2tcpip.h>-// fix for MingW not defining IPV6_V6ONLY-# define IPV6_V6ONLY 27-#endif"+#ifdef HAVE_NETIOAPI_H+# include <netioapi.h>+#endif+" -# Safety check: Ensure that we are in the correct source directory.   ac_config_headers="$ac_config_headers include/HsNetworkConfig.h"@@ -3622,7 +3706,7 @@ done  -for ac_header in fcntl.h limits.h stdlib.h sys/types.h unistd.h winsock2.h ws2tcpip.h+for ac_header in limits.h stdlib.h unistd.h sys/types.h fcntl.h do :   as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"@@ -3635,7 +3719,7 @@  done -for ac_header in arpa/inet.h netdb.h netinet/in.h netinet/tcp.h sys/socket.h sys/uio.h sys/un.h linux/can.h linux/tcp.h+for ac_header in sys/uio.h sys/socket.h netinet/in.h netinet/tcp.h do :   as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"@@ -3648,294 +3732,62 @@  done -for ac_header in net/if.h+for ac_header in sys/un.h arpa/inet.h netdb.h do :-  ac_fn_c_check_header_mongrel "$LINENO" "net/if.h" "ac_cv_header_net_if_h" "$ac_includes_default"-if test "x$ac_cv_header_net_if_h" = xyes; then :+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :   cat >>confdefs.h <<_ACEOF-#define HAVE_NET_IF_H 1+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF  fi  done --for ac_func in readlink symlink if_nametoindex+for ac_header in net/if.h netioapi.h do :-  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"-if eval test \"x\$"$as_ac_var"\" = x"yes"; then :+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :   cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 _ACEOF  fi-done --ac_fn_c_check_member "$LINENO" "struct msghdr" "msg_control" "ac_cv_member_struct_msghdr_msg_control" "#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif-#if HAVE_SYS_SOCKET_H-# include <sys/socket.h>-#endif-#if HAVE_SYS_UIO_H-# include <sys/uio.h>-#endif-"-if test "x$ac_cv_member_struct_msghdr_msg_control" = xyes; then :--cat >>confdefs.h <<_ACEOF-#define HAVE_STRUCT_MSGHDR_MSG_CONTROL 1-_ACEOF---fi-ac_fn_c_check_member "$LINENO" "struct msghdr" "msg_accrights" "ac_cv_member_struct_msghdr_msg_accrights" "#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif-#if HAVE_SYS_SOCKET_H-# include <sys/socket.h>-#endif-#if HAVE_SYS_UIO_H-# include <sys/uio.h>-#endif-"-if test "x$ac_cv_member_struct_msghdr_msg_accrights" = xyes; then :--cat >>confdefs.h <<_ACEOF-#define HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS 1-_ACEOF---fi+done  -ac_fn_c_check_member "$LINENO" "struct sockaddr" "sa_len" "ac_cv_member_struct_sockaddr_sa_len" "#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif-#if HAVE_SYS_SOCKET_H-# include <sys/socket.h>-#endif-"-if test "x$ac_cv_member_struct_sockaddr_sa_len" = xyes; then :+ac_fn_c_check_type "$LINENO" "struct ucred" "ac_cv_type_struct_ucred" "$ac_includes_default"+if test "x$ac_cv_type_struct_ucred" = xyes; then :  cat >>confdefs.h <<_ACEOF-#define HAVE_STRUCT_SOCKADDR_SA_LEN 1+#define HAVE_STRUCT_UCRED 1 _ACEOF   fi  -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for in_addr_t in netinet/in.h" >&5-$as_echo_n "checking for in_addr_t in netinet/in.h... " >&6; }-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <netinet/in.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "in_addr_t" >/dev/null 2>&1; then :--$as_echo "#define HAVE_IN_ADDR_T 1" >>confdefs.h- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5-$as_echo "yes" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi-rm -f conftest*---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for SO_PEERCRED and struct ucred in sys/socket.h" >&5-$as_echo_n "checking for SO_PEERCRED and struct ucred in sys/socket.h... " >&6; }-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <sys/types.h>-#include <sys/socket.h>-#ifndef SO_PEERCRED-# error no SO_PEERCRED-#endif-struct ucred u;-int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_ucred=yes-else-  ac_cv_ucred=no-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-if test "x$ac_cv_ucred" = xno; then-    old_CFLAGS="$CFLAGS"-    CFLAGS="-D_GNU_SOURCE $CFLAGS"-    cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <sys/types.h>-#include <sys/socket.h>-#ifndef SO_PEERCRED-# error no SO_PEERCRED-#endif-struct ucred u;-int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_ucred=yes-else-  ac_cv_ucred=no-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-    if test "x$ac_cv_ucred" = xyes; then-        EXTRA_CPPFLAGS=-D_GNU_SOURCE-    fi-else-    old_CFLAGS="$CFLAGS"-fi-if test "x$ac_cv_ucred" = xno; then-    CFLAGS="$old_CFLAGS"-    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-else--$as_echo "#define HAVE_STRUCT_UCRED 1" >>confdefs.h--    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5-$as_echo "yes" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpeereid in unistd.h" >&5-$as_echo_n "checking for getpeereid in unistd.h... " >&6; }-ac_fn_c_check_func "$LINENO" "getpeereid" "ac_cv_func_getpeereid"-if test "x$ac_cv_func_getpeereid" = xyes; then :--$as_echo "#define HAVE_GETPEEREID 1" >>confdefs.h--fi---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _head_libws2_32_a in -lws2_32" >&5-$as_echo_n "checking for _head_libws2_32_a in -lws2_32... " >&6; }-if ${ac_cv_lib_ws2_32__head_libws2_32_a+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lws2_32  $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char _head_libws2_32_a ();-int-main ()-{-return _head_libws2_32_a ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_ws2_32__head_libws2_32_a=yes-else-  ac_cv_lib_ws2_32__head_libws2_32_a=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ws2_32__head_libws2_32_a" >&5-$as_echo "$ac_cv_lib_ws2_32__head_libws2_32_a" >&6; }-if test "x$ac_cv_lib_ws2_32__head_libws2_32_a" = xyes; then :+for ac_func in gai_strerror gethostent accept4+do :+  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :   cat >>confdefs.h <<_ACEOF-#define HAVE_LIBWS2_32 1+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 _ACEOF -  LIBS="-lws2_32 $LIBS"- fi---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getaddrinfo" >&5-$as_echo_n "checking for getaddrinfo... " >&6; }-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-$ac_includes_default-int testme(){ getaddrinfo; }-int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :--$as_echo "#define HAVE_GETADDRINFO 1" >>confdefs.h- ac_have_getaddrinfo=yes; { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5-$as_echo "yes" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext--if test "x$ac_have_getaddrinfo" = x; then-  old_CFLAGS="$CFLAGS"-  if test "z$ac_cv_lib_ws2_32__head_libws2_32_a" = zyes; then-    CFLAGS="-DWINVER=0x0501 $CFLAGS"-    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getaddrinfo if WINVER is 0x0501" >&5-$as_echo_n "checking for getaddrinfo if WINVER is 0x0501... " >&6; }-    cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-$ac_includes_default-    int testme(){ getaddrinfo; }-int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :--$as_echo "#define HAVE_GETADDRINFO 1" >>confdefs.h--$as_echo "#define NEED_WINVER_XP 1" >>confdefs.h- EXTRA_CPPFLAGS="-DWINVER=0x0501 $EXTRA_CPPFLAGS"; { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5-$as_echo "yes" >&6; }-else-  CFLAGS="$old_CFLAGS"; { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-  fi-fi+done -for ac_func in gai_strerror+for ac_func in getpeereid do :-  ac_fn_c_check_func "$LINENO" "gai_strerror" "ac_cv_func_gai_strerror"-if test "x$ac_cv_func_gai_strerror" = xyes; then :+  ac_fn_c_check_func "$LINENO" "getpeereid" "ac_cv_func_getpeereid"+if test "x$ac_cv_func_getpeereid" = xyes; then :   cat >>confdefs.h <<_ACEOF-#define HAVE_GAI_STRERROR 1+#define HAVE_GETPEEREID 1 _ACEOF  fi@@ -3983,7 +3835,6 @@ #define HAVE_DECL_AI_V4MAPPED $ac_have_decl _ACEOF - ac_fn_c_check_decl "$LINENO" "IPV6_V6ONLY" "ac_cv_have_decl_IPV6_V6ONLY" "$ac_includes_default" if test "x$ac_cv_have_decl_IPV6_V6ONLY" = xyes; then :   ac_have_decl=1@@ -3995,7 +3846,6 @@ #define HAVE_DECL_IPV6_V6ONLY $ac_have_decl _ACEOF - ac_fn_c_check_decl "$LINENO" "IPPROTO_IP" "ac_cv_have_decl_IPPROTO_IP" "$ac_includes_default" if test "x$ac_cv_have_decl_IPPROTO_IP" = xyes; then :   ac_have_decl=1@@ -4027,91 +3877,51 @@ #define HAVE_DECL_IPPROTO_IPV6 $ac_have_decl _ACEOF --{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sendfile in sys/sendfile.h" >&5-$as_echo_n "checking for sendfile in sys/sendfile.h... " >&6; }-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <sys/sendfile.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "sendfile" >/dev/null 2>&1; then :--$as_echo "#define HAVE_LINUX_SENDFILE 1" >>confdefs.h- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5-$as_echo "yes" >&6; }+ac_fn_c_check_decl "$LINENO" "SO_PEERCRED" "ac_cv_have_decl_SO_PEERCRED" "$ac_includes_default"+if test "x$ac_cv_have_decl_SO_PEERCRED" = xyes; then :+  ac_have_decl=1 else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }+  ac_have_decl=0 fi-rm -f conftest* --{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sendfile in sys/socket.h" >&5-$as_echo_n "checking for sendfile in sys/socket.h... " >&6; }-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <sys/socket.h>-+cat >>confdefs.h <<_ACEOF+#define HAVE_DECL_SO_PEERCRED $ac_have_decl _ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "sendfile" >/dev/null 2>&1; then : -$as_echo "#define HAVE_BSD_SENDFILE 1" >>confdefs.h- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5-$as_echo "yes" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi-rm -f conftest* +ac_fn_c_check_member "$LINENO" "struct msghdr" "msg_control" "ac_cv_member_struct_msghdr_msg_control" "$ac_includes_default"+if test "x$ac_cv_member_struct_msghdr_msg_control" = xyes; then : -for ac_func in gethostent-do :-  ac_fn_c_check_func "$LINENO" "gethostent" "ac_cv_func_gethostent"-if test "x$ac_cv_func_gethostent" = xyes; then :-  cat >>confdefs.h <<_ACEOF-#define HAVE_GETHOSTENT 1+cat >>confdefs.h <<_ACEOF+#define HAVE_STRUCT_MSGHDR_MSG_CONTROL 1 _ACEOF -fi-done +fi+ac_fn_c_check_member "$LINENO" "struct msghdr" "msg_accrights" "ac_cv_member_struct_msghdr_msg_accrights" "$ac_includes_default"+if test "x$ac_cv_member_struct_msghdr_msg_accrights" = xyes; then : -for ac_func in accept4-do :-  ac_fn_c_check_func "$LINENO" "accept4" "ac_cv_func_accept4"-if test "x$ac_cv_func_accept4" = xyes; then :-  cat >>confdefs.h <<_ACEOF-#define HAVE_ACCEPT4 1+cat >>confdefs.h <<_ACEOF+#define HAVE_STRUCT_MSGHDR_MSG_ACCRIGHTS 1 _ACEOF + fi-done +ac_fn_c_check_member "$LINENO" "struct sockaddr" "sa_len" "ac_cv_member_struct_sockaddr_sa_len" "$ac_includes_default"+if test "x$ac_cv_member_struct_sockaddr_sa_len" = xyes; then : -case "$host" in-*-mingw* | *-msys*)-	EXTRA_SRCS="cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c"-	EXTRA_LIBS=ws2_32-	;;-*-solaris2*)-	EXTRA_SRCS="cbits/ancilData.c"-	EXTRA_LIBS="nsl, socket"-	;;-*)-	EXTRA_SRCS="cbits/ancilData.c"-	EXTRA_LIBS=-	;;-esac+cat >>confdefs.h <<_ACEOF+#define HAVE_STRUCT_SOCKADDR_SA_LEN 1+_ACEOF  +fi  -ac_config_files="$ac_config_files network.buildinfo"-+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating ./network.buildinfo" >&5+$as_echo "$as_me: creating ./network.buildinfo" >&6;}+echo "install-includes: HsNetworkConfig.h" > network.buildinfo  cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure@@ -4619,7 +4429,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by Haskell network package $as_me 2.8.0.1, which was+This file was extended by Haskell network package $as_me 3.0.0.0, which was generated by GNU Autoconf 2.69.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES@@ -4633,9 +4443,6 @@  _ACEOF -case $ac_config_files in *"-"*) set x $ac_config_files; shift; ac_config_files=$*;;-esac  case $ac_config_headers in *" "*) set x $ac_config_headers; shift; ac_config_headers=$*;;@@ -4644,7 +4451,6 @@  cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for.-config_files="$ac_config_files" config_headers="$ac_config_headers"  _ACEOF@@ -4664,14 +4470,9 @@                    do not print progress messages   -d, --debug      don't remove temporary files       --recheck    update $as_me by reconfiguring in the same conditions-      --file=FILE[:TEMPLATE]-                   instantiate the configuration file FILE       --header=FILE[:TEMPLATE]                    instantiate the configuration header FILE -Configuration files:-$config_files- Configuration headers: $config_headers @@ -4681,7 +4482,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\-Haskell network package config.status 2.8.0.1+Haskell network package config.status 3.0.0.0 configured by $0, generated by GNU Autoconf 2.69,   with options \\"\$ac_cs_config\\" @@ -4727,14 +4528,6 @@     $as_echo "$ac_cs_config"; exit ;;   --debug | --debu | --deb | --de | --d | -d )     debug=: ;;-  --file | --fil | --fi | --f )-    $ac_shift-    case $ac_optarg in-    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;-    '') as_fn_error $? "missing file argument" ;;-    esac-    as_fn_append CONFIG_FILES " '$ac_optarg'"-    ac_need_defaults=false;;   --header | --heade | --head | --hea )     $ac_shift     case $ac_optarg in@@ -4803,7 +4596,6 @@ do   case $ac_config_target in     "include/HsNetworkConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsNetworkConfig.h" ;;-    "network.buildinfo") CONFIG_FILES="$CONFIG_FILES network.buildinfo" ;;    *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;   esac@@ -4815,7 +4607,6 @@ # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then-  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files   test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi @@ -4846,164 +4637,6 @@ } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 ac_tmp=$tmp -# Set up the scripts for CONFIG_FILES section.-# No need to generate them if there are no CONFIG_FILES.-# This happens for instance with `./config.status config.h'.-if test -n "$CONFIG_FILES"; then---ac_cr=`echo X | tr X '\015'`-# On cygwin, bash can eat \r inside `` if the user requested igncr.-# But we know of no other shell where ac_cr would be empty at this-# point, so we can use a bashism as a fallback.-if test "x$ac_cr" = x; then-  eval ac_cr=\$\'\\r\'-fi-ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`-if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then-  ac_cs_awk_cr='\\r'-else-  ac_cs_awk_cr=$ac_cr-fi--echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&-_ACEOF---{-  echo "cat >conf$$subs.awk <<_ACEOF" &&-  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&-  echo "_ACEOF"-} >conf$$subs.sh ||-  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5-ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`-ac_delim='%!_!# '-for ac_last_try in false false false false false :; do-  . ./conf$$subs.sh ||-    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5--  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`-  if test $ac_delim_n = $ac_delim_num; then-    break-  elif $ac_last_try; then-    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5-  else-    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "-  fi-done-rm -f conf$$subs.sh--cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&-_ACEOF-sed -n '-h-s/^/S["/; s/!.*/"]=/-p-g-s/^[^!]*!//-:repl-t repl-s/'"$ac_delim"'$//-t delim-:nl-h-s/\(.\{148\}\)..*/\1/-t more1-s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/-p-n-b repl-:more1-s/["\\]/\\&/g; s/^/"/; s/$/"\\/-p-g-s/.\{148\}//-t nl-:delim-h-s/\(.\{148\}\)..*/\1/-t more2-s/["\\]/\\&/g; s/^/"/; s/$/"/-p-b-:more2-s/["\\]/\\&/g; s/^/"/; s/$/"\\/-p-g-s/.\{148\}//-t delim-' <conf$$subs.awk | sed '-/^[^""]/{-  N-  s/\n//-}-' >>$CONFIG_STATUS || ac_write_fail=1-rm -f conf$$subs.awk-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-_ACAWK-cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&-  for (key in S) S_is_set[key] = 1-  FS = ""--}-{-  line = $ 0-  nfields = split(line, field, "@")-  substed = 0-  len = length(field[1])-  for (i = 2; i < nfields; i++) {-    key = field[i]-    keylen = length(key)-    if (S_is_set[key]) {-      value = S[key]-      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)-      len += length(value) + length(field[++i])-      substed = 1-    } else-      len += 1 + keylen-  }--  print line-}--_ACAWK-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then-  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"-else-  cat-fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \-  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5-_ACEOF--# VPATH may cause trouble with some makes, so we remove sole $(srcdir),-# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and-# trailing colons and then remove the whole line if VPATH becomes empty-# (actually we leave an empty line to preserve line numbers).-if test "x$srcdir" = x.; then-  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{-h-s///-s/^/:/-s/[	 ]*$/:/-s/:\$(srcdir):/:/g-s/:\${srcdir}:/:/g-s/:@srcdir@:/:/g-s/^:*//-s/:*$//-x-s/\(=[	 ]*\).*/\1/-G-s/\n//-s/^[^=]*=[	 ]*$//-}'-fi--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-fi # test -n "$CONFIG_FILES"- # Set up the scripts for CONFIG_HEADERS section. # No need to generate them if there are no CONFIG_HEADERS. # This happens for instance with `./config.status Makefile'.@@ -5113,7 +4746,7 @@ fi # test -n "$CONFIG_HEADERS"  -eval set X "  :F $CONFIG_FILES  :H $CONFIG_HEADERS    "+eval set X "    :H $CONFIG_HEADERS    " shift for ac_tag do@@ -5242,85 +4875,7 @@     case $ac_mode in-  :F)-  #-  # CONFIG_FILE-  # -_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# If the template does not know about datarootdir, expand it.-# FIXME: This hack should be removed a few years after 2.60.-ac_datarootdir_hack=; ac_datarootdir_seen=-ac_sed_dataroot='-/datarootdir/ {-  p-  q-}-/@datadir@/p-/@docdir@/p-/@infodir@/p-/@localedir@/p-/@mandir@/p'-case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in-*datarootdir*) ac_datarootdir_seen=yes;;-*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)-  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5-$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}-_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-  ac_datarootdir_hack='-  s&@datadir@&$datadir&g-  s&@docdir@&$docdir&g-  s&@infodir@&$infodir&g-  s&@localedir@&$localedir&g-  s&@mandir@&$mandir&g-  s&\\\${datarootdir}&$datarootdir&g' ;;-esac-_ACEOF--# Neutralize VPATH when `$srcdir' = `.'.-# Shell code in configure.ac might set extrasub.-# FIXME: do we really want to maintain this feature?-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-ac_sed_extra="$ac_vpsub-$extrasub-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-:t-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b-s|@configure_input@|$ac_sed_conf_input|;t t-s&@top_builddir@&$ac_top_builddir_sub&;t t-s&@top_build_prefix@&$ac_top_build_prefix&;t t-s&@srcdir@&$ac_srcdir&;t t-s&@abs_srcdir@&$ac_abs_srcdir&;t t-s&@top_srcdir@&$ac_top_srcdir&;t t-s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t-s&@builddir@&$ac_builddir&;t t-s&@abs_builddir@&$ac_abs_builddir&;t t-s&@abs_top_builddir@&$ac_abs_top_builddir&;t t-$ac_datarootdir_hack-"-eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \-  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5--test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&-  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&-  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \-      "$ac_tmp/out"`; test -z "$ac_out"; } &&-  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined.  Please make sure it is defined" >&5-$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined.  Please make sure it is defined" >&2;}--  rm -f "$ac_tmp/stdin"-  case $ac_file in-  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;-  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;-  esac \-  || as_fn_error $? "could not create $ac_file" "$LINENO" 5- ;;   :H)   #   # CONFIG_HEADER
configure.ac view
@@ -1,25 +1,62 @@-AC_INIT([Haskell network package], [2.8.0.1], [libraries@haskell.org], [network])+AC_INIT([Haskell network package],+        [3.0.0.0],+        [libraries@haskell.org],+        [network]) -ac_includes_default="$ac_includes_default+dnl See also HsNet.h+ac_includes_default="#define _GNU_SOURCE 1  /* for struct ucred on Linux */+$ac_includes_default++#ifdef _WIN32+# include <winsock2.h>+# include <ws2tcpip.h>+# define IPV6_V6ONLY 27+#endif++#ifdef HAVE_LIMITS_H+# include <limits.h>+#endif+#ifdef HAVE_STDLIB_H+# include <stdlib.h>+#endif+#ifdef HAVE_UNISTD_H+#include <unistd.h>+#endif+#ifdef HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif+#ifdef HAVE_FCNTL_H+# include <fcntl.h>+#endif+#ifdef HAVE_SYS_UIO_H+# include <sys/uio.h>+#endif #ifdef HAVE_SYS_SOCKET_H # include <sys/socket.h> #endif #ifdef HAVE_NETINET_IN_H # include <netinet/in.h> #endif+#ifdef HAVE_NETINET_TCP_H+# include <netinet/tcp.h>+#endif+#ifdef HAVE_SYS_UN_H+# include <sys/un.h>+#endif+#ifdef HAVE_ARPA_INET_H+# include <arpa/inet.h>+#endif #ifdef HAVE_NETDB_H-# include <netdb.h>+#include <netdb.h> #endif-#ifdef HAVE_WINSOCK2_H-# include <winsock2.h>+#ifdef HAVE_NET_IF_H+# include <net/if.h> #endif-#ifdef HAVE_WS2TCPIP_H-# include <ws2tcpip.h>-// fix for MingW not defining IPV6_V6ONLY-# define IPV6_V6ONLY 27-#endif"+#ifdef HAVE_NETIOAPI_H+# include <netioapi.h>+#endif+" -# Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([include/HsNet.h])  AC_CONFIG_HEADERS([include/HsNetworkConfig.h])@@ -33,160 +70,26 @@  AC_C_CONST -dnl ** check for specific header (.h) files that we are interested in-AC_CHECK_HEADERS([fcntl.h limits.h stdlib.h sys/types.h unistd.h winsock2.h ws2tcpip.h])-AC_CHECK_HEADERS([arpa/inet.h netdb.h netinet/in.h netinet/tcp.h sys/socket.h sys/uio.h sys/un.h linux/can.h linux/tcp.h])-AC_CHECK_HEADERS([net/if.h])--AC_CHECK_FUNCS([readlink symlink if_nametoindex])--dnl ** check what fields struct msghdr contains-AC_CHECK_MEMBERS([struct msghdr.msg_control, struct msghdr.msg_accrights], [], [], [#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif-#if HAVE_SYS_SOCKET_H-# include <sys/socket.h>-#endif-#if HAVE_SYS_UIO_H-# include <sys/uio.h>-#endif])--dnl ** check if struct sockaddr contains sa_len-AC_CHECK_MEMBERS([struct sockaddr.sa_len], [], [], [#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif-#if HAVE_SYS_SOCKET_H-# include <sys/socket.h>-#endif])--dnl ---------------------------------------------------dnl * test for in_addr_t-dnl ---------------------------------------------------AC_MSG_CHECKING(for in_addr_t in netinet/in.h)-AC_EGREP_HEADER(in_addr_t, netinet/in.h,- [ AC_DEFINE([HAVE_IN_ADDR_T], [1], [Define to 1 if in_addr_t is available.]) AC_MSG_RESULT(yes) ],- AC_MSG_RESULT(no))--dnl ---------------------------------------------------dnl * test for SO_PEERCRED and struct ucred-dnl ---------------------------------------------------AC_MSG_CHECKING(for SO_PEERCRED and struct ucred in sys/socket.h)-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>-#include <sys/socket.h>-#ifndef SO_PEERCRED-# error no SO_PEERCRED-#endif-struct ucred u;]])],ac_cv_ucred=yes,ac_cv_ucred=no)-if test "x$ac_cv_ucred" = xno; then-    old_CFLAGS="$CFLAGS"-    CFLAGS="-D_GNU_SOURCE $CFLAGS"-    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>-#include <sys/socket.h>-#ifndef SO_PEERCRED-# error no SO_PEERCRED-#endif-struct ucred u;]])],ac_cv_ucred=yes,ac_cv_ucred=no)-    if test "x$ac_cv_ucred" = xyes; then-        EXTRA_CPPFLAGS=-D_GNU_SOURCE-    fi-else-    old_CFLAGS="$CFLAGS"-fi-if test "x$ac_cv_ucred" = xno; then-    CFLAGS="$old_CFLAGS"-    AC_MSG_RESULT(no)-else-    AC_DEFINE([HAVE_STRUCT_UCRED], [1], [Define to 1 if you have both SO_PEERCRED and struct ucred.])-    AC_MSG_RESULT(yes)-fi--dnl ---------------------------------------------------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.] ))--dnl ---------------------------------------------------dnl * check for Windows networking libraries-dnl ---------------------------------------------------AC_CHECK_LIB(ws2_32, _head_libws2_32_a)--dnl ---------------------------------------------------dnl * test for getaddrinfo as proxy for IPv6 support-dnl ---------------------------------------------------AC_MSG_CHECKING(for getaddrinfo)-dnl Can't use AC_CHECK_FUNC here, because it doesn't do the right-dnl thing on Windows.-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[$ac_includes_default-int testme(){ getaddrinfo; }]])],[AC_DEFINE([HAVE_GETADDRINFO], [1], [Define to 1 if you have the `getaddrinfo' function.]) ac_have_getaddrinfo=yes; AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)])+AC_CHECK_HEADERS([limits.h stdlib.h unistd.h sys/types.h fcntl.h])+AC_CHECK_HEADERS([sys/uio.h sys/socket.h netinet/in.h netinet/tcp.h])+AC_CHECK_HEADERS([sys/un.h arpa/inet.h netdb.h])+AC_CHECK_HEADERS([net/if.h netioapi.h]) -dnl Under mingw, we may need to set WINVER to 0x0501 to expose getaddrinfo.-if test "x$ac_have_getaddrinfo" = x; then-  old_CFLAGS="$CFLAGS"-  if test "z$ac_cv_lib_ws2_32__head_libws2_32_a" = zyes; then-    CFLAGS="-DWINVER=0x0501 $CFLAGS"-    AC_MSG_CHECKING(for getaddrinfo if WINVER is 0x0501)-    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[$ac_includes_default-    int testme(){ getaddrinfo; }]])],[AC_DEFINE([HAVE_GETADDRINFO], [1], [Define to 1 if you have the `getaddrinfo' function.]) AC_DEFINE([NEED_WINVER_XP], [1], [Define to 1 if the `getaddrinfo' function needs WINVER set.]) EXTRA_CPPFLAGS="-DWINVER=0x0501 $EXTRA_CPPFLAGS"; AC_MSG_RESULT(yes)],[CFLAGS="$old_CFLAGS"; AC_MSG_RESULT(no)])-  fi-fi+AC_CHECK_TYPES([struct ucred]) -dnl Missing under mingw, sigh.-AC_CHECK_FUNCS(gai_strerror)+AC_CHECK_FUNCS([gai_strerror gethostent accept4])+AC_CHECK_FUNCS([getpeereid]) -dnl --------------------------------------------------------dnl * test for AI_* flags that not all implementations have-dnl ------------------------------------------------------- AC_CHECK_DECLS([AI_ADDRCONFIG, AI_ALL, AI_NUMERICSERV, AI_V4MAPPED])--dnl --------------------------------------------------------dnl * test for IPV6_V6ONLY flags that not all implementations have-dnl ------------------------------------------------------- AC_CHECK_DECLS([IPV6_V6ONLY])--dnl --------------------------------------------------------dnl * test for IPPROTO_* macros/constants-dnl ------------------------------------------------------- AC_CHECK_DECLS([IPPROTO_IP, IPPROTO_TCP, IPPROTO_IPV6])--dnl ---------------------------------------------------dnl * test for Linux sendfile(2)-dnl ---------------------------------------------------AC_MSG_CHECKING(for sendfile in sys/sendfile.h)-AC_EGREP_HEADER(sendfile, sys/sendfile.h,- [ AC_DEFINE([HAVE_LINUX_SENDFILE], [1], [Define to 1 if you have a Linux sendfile(2) implementation.]) AC_MSG_RESULT(yes) ],- AC_MSG_RESULT(no))--dnl ---------------------------------------------------dnl * test for BSD sendfile(2)-dnl ---------------------------------------------------AC_MSG_CHECKING(for sendfile in sys/socket.h)-AC_EGREP_HEADER(sendfile, sys/socket.h,- [ AC_DEFINE([HAVE_BSD_SENDFILE], [1], [Define to 1 if you have a BSDish sendfile(2) implementation.]) AC_MSG_RESULT(yes) ],- AC_MSG_RESULT(no))--AC_CHECK_FUNCS(gethostent)--AC_CHECK_FUNCS(accept4)+AC_CHECK_DECLS([SO_PEERCRED]) -case "$host" in-*-mingw* | *-msys*)-	EXTRA_SRCS="cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c"-	EXTRA_LIBS=ws2_32-	;;-*-solaris2*)-	EXTRA_SRCS="cbits/ancilData.c"-	EXTRA_LIBS="nsl, socket"-	;;-*)-	EXTRA_SRCS="cbits/ancilData.c"-	EXTRA_LIBS=-	;;-esac-AC_SUBST([EXTRA_CPPFLAGS])-AC_SUBST([EXTRA_LIBS])-AC_SUBST([EXTRA_SRCS])+AC_CHECK_MEMBERS([struct msghdr.msg_control, struct msghdr.msg_accrights])+AC_CHECK_MEMBERS([struct sockaddr.sa_len]) -AC_CONFIG_FILES([network.buildinfo])+dnl This is a necessary hack+AC_MSG_NOTICE([creating ./network.buildinfo])+echo "install-includes: HsNetworkConfig.h" > network.buildinfo  AC_OUTPUT
examples/EchoClient.hs view
@@ -4,7 +4,7 @@  import qualified Control.Exception as E import qualified Data.ByteString.Char8 as C-import Network.Socket hiding (recv)+import Network.Socket import Network.Socket.ByteString (recv, sendAll)  main :: IO ()
examples/EchoServer.hs view
@@ -5,7 +5,7 @@ import qualified Control.Exception as E import Control.Monad (unless, forever, void) import qualified Data.ByteString as S-import Network.Socket hiding (recv)+import Network.Socket import Network.Socket.ByteString (recv, sendAll)  main :: IO ()@@ -25,7 +25,7 @@         setSocketOption sock ReuseAddr 1         -- If the prefork technique is not used,         -- set CloseOnExec for the security reasons.-        let fd = fdSocket sock+        fd <- fdSocket sock         setCloseOnExecIfNeeded fd         bind sock (addrAddress addr)         listen sock 10
include/HsNet.h view
@@ -9,10 +9,6 @@  #include "HsNetDef.h" -#ifdef NEED_WINVER-# define WINVER 0x0501-#endif- #ifndef INLINE # if defined(_MSC_VER) #  define INLINE extern __inline@@ -23,29 +19,13 @@ # endif #endif -#ifdef HAVE_GETADDRINFO-# define IPV6_SOCKET_SUPPORT 1-#else-# undef IPV6_SOCKET_SUPPORT-#endif--#if defined(HAVE_WINSOCK2_H)-#include <winsock2.h>-# ifdef HAVE_WS2TCPIP_H-#  include <ws2tcpip.h>-// fix for MingW not defining IPV6_V6ONLY-#  define IPV6_V6ONLY 27-# endif--extern int   initWinSock ();-extern const char* getWSErrorDescr(int err);-extern void* newAcceptParams(int sock,-			     int sz,-			     void* sockaddr);-extern int   acceptNewSock(void* d);-extern int   acceptDoProc(void* param);+#define _GNU_SOURCE 1 /* for struct ucred on Linux */ -#else+#ifdef _WIN32+# include <winsock2.h>+# include <ws2tcpip.h>+# define IPV6_V6ONLY 27+#endif  #ifdef HAVE_LIMITS_H # include <limits.h>@@ -68,14 +48,12 @@ #ifdef HAVE_SYS_SOCKET_H # include <sys/socket.h> #endif-#ifdef HAVE_LINUX_TCP_H-# include <linux/tcp.h>-#elif HAVE_NETINET_TCP_H-# include <netinet/tcp.h>-#endif #ifdef HAVE_NETINET_IN_H # include <netinet/in.h> #endif+#ifdef HAVE_NETINET_TCP_H+# include <netinet/tcp.h>+#endif #ifdef HAVE_SYS_UN_H # include <sys/un.h> #endif@@ -85,34 +63,32 @@ #ifdef HAVE_NETDB_H #include <netdb.h> #endif-#ifdef HAVE_LINUX_CAN_H-# include <linux/can.h>-# define CAN_SOCKET_SUPPORT 1-#endif-#ifdef HAVE_NET_IF+#ifdef HAVE_NET_IF_H # include <net/if.h> #endif--#ifdef HAVE_BSD_SENDFILE-#include <sys/uio.h>-#endif-#ifdef HAVE_LINUX_SENDFILE-#if !defined(__USE_FILE_OFFSET64)-#include <sys/sendfile.h>-#endif+#ifdef HAVE_NETIOAPI_H+# include <netioapi.h> #endif +#ifdef _WIN32+extern int   initWinSock ();+extern const char* getWSErrorDescr(int err);+extern void* newAcceptParams(int sock,+			     int sz,+			     void* sockaddr);+extern int   acceptNewSock(void* d);+extern int   acceptDoProc(void* param);+#else  /* _WIN32 */ extern int sendFd(int sock, int outfd);  extern int recvFd(int sock);--#endif /* HAVE_WINSOCK2_H */+#endif /* _WIN32 */  INLINE char * hsnet_inet_ntoa(-#if defined(HAVE_WINSOCK2_H)+#if defined(_WIN32)              u_long addr #elif defined(HAVE_IN_ADDR_T)              in_addr_t addr@@ -128,10 +104,9 @@     return inet_ntoa(a); } -#ifdef HAVE_GETADDRINFO INLINE int hsnet_getnameinfo(const struct sockaddr* a,socklen_t b, char* c,-# if defined(HAVE_WINSOCK2_H)+# if defined(_WIN32)                   DWORD d, char* e, DWORD f, int g) # else                   socklen_t d, char* e, socklen_t f, int g)@@ -152,13 +127,12 @@ {     freeaddrinfo(ai); }-#endif -#if !defined(IOV_MAX)+#ifndef IOV_MAX # define IOV_MAX 1024 #endif -#if !defined(SOCK_NONBLOCK) // Missing define in Bionic libc (Android)+#ifndef SOCK_NONBLOCK // Missing define in Bionic libc (Android) # define SOCK_NONBLOCK O_NONBLOCK #endif
include/HsNetDef.h view
@@ -10,14 +10,22 @@ #undef PACKAGE_TARNAME #undef PACKAGE_VERSION -#if defined(HAVE_WINSOCK2_H)-# define WITH_WINSOCK  1-#endif- #if !defined(mingw32_HOST_OS) && !defined(_WIN32) # define DOMAIN_SOCKET_SUPPORT 1 #endif +#if defined(HAVE_STRUCT_UCRED) && HAVE_DECL_SO_PEERCRED+# define HAVE_STRUCT_UCRED_SO_PEERCRED 1+#else+# undef HAVE_STRUCT_UCRED_SO_PEERCRED+#endif++#ifdef HAVE_ACCEPT4+# define HAVE_ADVANCED_SOCKET_FLAGS 1+#else+# undef HAVE_ADVANCED_SOCKET_FLAGS+#endif+ /* stdcall is for Windows 32.    Haskell FFI does not have a keyword for Windows 64.    If ccall/stdcall is specified on Windows 64,@@ -36,6 +44,7 @@ #else # define CALLCONV ccall #endif+ #if defined(mingw32_HOST_OS) # define SAFE_ON_WIN safe #else
include/HsNetworkConfig.h.in view
@@ -6,9 +6,6 @@ /* Define to 1 if you have the <arpa/inet.h> header file. */ #undef HAVE_ARPA_INET_H -/* Define to 1 if you have a BSDish sendfile(2) implementation. */-#undef HAVE_BSD_SENDFILE- /* Define to 1 if you have the declaration of `AI_ADDRCONFIG', and to 0 if you    don't. */ #undef HAVE_DECL_AI_ADDRCONFIG@@ -41,45 +38,28 @@    don't. */ #undef HAVE_DECL_IPV6_V6ONLY +/* Define to 1 if you have the declaration of `SO_PEERCRED', and to 0 if you+   don't. */+#undef HAVE_DECL_SO_PEERCRED+ /* Define to 1 if you have the <fcntl.h> header file. */ #undef HAVE_FCNTL_H  /* Define to 1 if you have the `gai_strerror' function. */ #undef HAVE_GAI_STRERROR -/* Define to 1 if you have the `getaddrinfo' function. */-#undef HAVE_GETADDRINFO- /* Define to 1 if you have the `gethostent' function. */ #undef HAVE_GETHOSTENT -/* Define to 1 if you have getpeereid. */+/* Define to 1 if you have the `getpeereid' function. */ #undef HAVE_GETPEEREID -/* Define to 1 if you have the `if_nametoindex' function. */-#undef HAVE_IF_NAMETOINDEX- /* Define to 1 if you have the <inttypes.h> header file. */ #undef HAVE_INTTYPES_H -/* Define to 1 if in_addr_t is available. */-#undef HAVE_IN_ADDR_T--/* Define to 1 if you have the `ws2_32' library (-lws2_32). */-#undef HAVE_LIBWS2_32- /* Define to 1 if you have the <limits.h> header file. */ #undef HAVE_LIMITS_H -/* Define to 1 if you have the <linux/can.h> header file. */-#undef HAVE_LINUX_CAN_H--/* Define to 1 if you have a Linux sendfile(2) implementation. */-#undef HAVE_LINUX_SENDFILE--/* Define to 1 if you have the <linux/tcp.h> header file. */-#undef HAVE_LINUX_TCP_H- /* Define to 1 if you have the <memory.h> header file. */ #undef HAVE_MEMORY_H @@ -92,12 +72,12 @@ /* Define to 1 if you have the <netinet/tcp.h> header file. */ #undef HAVE_NETINET_TCP_H +/* Define to 1 if you have the <netioapi.h> header file. */+#undef HAVE_NETIOAPI_H+ /* Define to 1 if you have the <net/if.h> header file. */ #undef HAVE_NET_IF_H -/* Define to 1 if you have the `readlink' function. */-#undef HAVE_READLINK- /* Define to 1 if you have the <stdint.h> header file. */ #undef HAVE_STDINT_H @@ -119,12 +99,9 @@ /* Define to 1 if `sa_len' is a member of `struct sockaddr'. */ #undef HAVE_STRUCT_SOCKADDR_SA_LEN -/* Define to 1 if you have both SO_PEERCRED and struct ucred. */+/* Define to 1 if the system has the type `struct ucred'. */ #undef HAVE_STRUCT_UCRED -/* Define to 1 if you have the `symlink' function. */-#undef HAVE_SYMLINK- /* Define to 1 if you have the <sys/socket.h> header file. */ #undef HAVE_SYS_SOCKET_H @@ -142,15 +119,6 @@  /* Define to 1 if you have the <unistd.h> header file. */ #undef HAVE_UNISTD_H--/* Define to 1 if you have the <winsock2.h> header file. */-#undef HAVE_WINSOCK2_H--/* Define to 1 if you have the <ws2tcpip.h> header file. */-#undef HAVE_WS2TCPIP_H--/* Define to 1 if the `getaddrinfo' function needs WINVER set. */-#undef NEED_WINVER_XP  /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT
− network.buildinfo.in 
@@ -1,7 +0,0 @@-ghc-options: @EXTRA_CPPFLAGS@-ghc-prof-options: @EXTRA_CPPFLAGS@-ld-options: @LDFLAGS@-cc-options: @EXTRA_CPPFLAGS@-c-sources: @EXTRA_SRCS@-extra-libraries: @EXTRA_LIBS@-install-includes: HsNetworkConfig.h
network.cabal view
@@ -1,5 +1,6 @@+cabal-version:  1.18 name:           network-version:        2.8.0.1+version:        3.0.0.0 license:        BSD3 license-file:   LICENSE maintainer:     Kazu Yamamoto, Evan Borden@@ -7,23 +8,35 @@ description:   This package provides a low-level networking interface.   .-  In network-2.6 the @Network.URI@ module was split off into its own-  package, network-uri-2.6. If you're using the @Network.URI@ module-  you can automatically get it from the right package by adding this-  to your .cabal file:+  === High-Level Packages+  Other packages provide higher level interfaces:   .+  * connection+  * hookup+  * network-simple+  .+  === Related Packages+  ==== @network-bsd@+  In @network-3.0.0.0@ the @Network.BSD@ module was split off into its own+  package, @network-bsd-3.0.0.0@.+  .+  ==== @network-uri@+  In @network-2.6@ the @Network.URI@ module was split off into its own package,+  @network-uri-2.6@. If you're using the @Network.URI@ module you can+  automatically get it from the right package by adding this to your @.cabal@+  file:+  .   > library   >   build-depends: network-uri-flag category:       Network build-type:     Configure-cabal-version:  >=1.8 extra-tmp-files:   config.log config.status autom4te.cache network.buildinfo   include/HsNetworkConfig.h extra-source-files:   README.md CHANGELOG.md   examples/*.hs tests/*.hs config.guess config.sub install-sh-  configure.ac configure network.buildinfo.in+  configure.ac configure   include/HsNetworkConfig.h.in include/HsNet.h include/HsNetDef.h   -- C sources only used on some systems   cbits/ancilData.c cbits/asyncAccept.c cbits/initWinSock.c@@ -34,53 +47,76 @@              , GHC == 7.10.3              , GHC == 8.0.2              , GHC == 8.2.2-             , GHC == 8.4.3+             , GHC == 8.4.4+             , GHC == 8.6.2  library+  default-language: Haskell2010   exposed-modules:-    Network-    Network.BSD     Network.Socket+    Network.Socket.Address     Network.Socket.ByteString     Network.Socket.ByteString.Lazy     Network.Socket.Internal   other-modules:+    Network.Socket.Buffer     Network.Socket.ByteString.Internal+    Network.Socket.ByteString.IO+    Network.Socket.Cbits+    Network.Socket.Fcntl+    Network.Socket.Handle+    Network.Socket.Imports+    Network.Socket.If+    Network.Socket.Info+    Network.Socket.Name+    Network.Socket.Options+    Network.Socket.Shutdown+    Network.Socket.SockAddr+    Network.Socket.Syscall     Network.Socket.Types--  if !os(windows)-    other-modules:-      Network.Socket.ByteString.IOVec-      Network.Socket.ByteString.Lazy.Posix-      Network.Socket.ByteString.MsgHdr-  if os(windows)-    other-modules:-      Network.Socket.ByteString.Lazy.Windows+    Network.Socket.Unix    build-depends:     base >= 4.7 && < 5,-    bytestring == 0.10.*--  if !os(windows)-    build-depends:-      unix >= 2+    bytestring == 0.10.*,+    deepseq -  extensions:-    CPP, DeriveDataTypeable, ForeignFunctionInterface, TypeSynonymInstances   include-dirs: include   includes: HsNet.h HsNetDef.h   install-includes: HsNet.h HsNetDef.h   c-sources: cbits/HsNet.c   ghc-options: -Wall -fwarn-tabs+  build-tools: hsc2hs ++  -- Add some platform specific stuff+  if !os(windows)+    other-modules:+      Network.Socket.ByteString.IOVec+      Network.Socket.ByteString.Lazy.Posix+      Network.Socket.ByteString.MsgHdr+    build-depends:+      unix >= 2+    c-sources: cbits/ancilData.c++  if os(solaris)+    extra-libraries: nsl, socket++  if os(windows)+    other-modules:+      Network.Socket.ByteString.Lazy.Windows+    c-sources: cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c+    extra-libraries: ws2_32+    -- See https://github.com/haskell/network/pull/362+    if impl(ghc >= 7.10)+      cpp-options: -D_WIN32_WINNT=0x0600+ test-suite spec+  default-language: Haskell2010   hs-source-dirs: tests   main-is: Spec.hs-  other-modules:-    Network.Test.Common-    Network.SocketSpec-    Network.Socket.ByteStringSpec-    Network.Socket.ByteString.LazySpec+  other-modules: RegressionSpec+                 SimpleSpec   type: exitcode-stdio-1.0   ghc-options: -Wall -threaded   -- NB: make sure to versions of hspec and hspec-discover@@ -95,14 +131,17 @@     network,     hspec >= 2.6 -test-suite doctest+test-suite doctests+  buildable: False+  default-language: Haskell2010   hs-source-dirs: tests   main-is: doctests.hs   type: exitcode-stdio-1.0    build-depends:     base >= 4.7 && < 5,-    doctest >= 0.10.1+    doctest >= 0.10.1,+    network    ghc-options: -Wall
− tests/Network/Socket/ByteString/LazySpec.hs 
@@ -1,54 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}--module Network.Socket.ByteString.LazySpec (main, spec) where--import Prelude hiding (getContents)--import qualified Data.ByteString.Lazy as L-import Network.Socket hiding (recv, recvFrom, send, sendTo)-import Network.Socket.ByteString.Lazy-import Network.Test.Common-import Control.Monad--import Test.Hspec--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-    describe "send" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` lazyTestMsg-                client sock = send sock lazyTestMsg-            tcpTest client server--    describe "sendAll" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` lazyTestMsg-                client sock = sendAll sock lazyTestMsg-            tcpTest client server--    describe "getContents" $ do-        it "works well" $ do-            let server sock = getContents sock `shouldReturn` lazyTestMsg-                client sock = do-                    void $ send sock lazyTestMsg-                    shutdown sock ShutdownSend-            tcpTest client server--    describe "recv" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` lazyTestMsg-                client sock = send sock lazyTestMsg-            tcpTest client server--        it "can treat overflow" $ do-            let server sock = do-                    seg1 <- recv sock (L.length lazyTestMsg - 3)-                    seg2 <- recv sock 1024-                    let msg = L.append seg1 seg2-                    msg `shouldBe` lazyTestMsg-                client sock = send sock lazyTestMsg-            tcpTest client server
− tests/Network/Socket/ByteStringSpec.hs 
@@ -1,109 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.Socket.ByteStringSpec (main, spec) where--import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as C-import Network.Socket hiding (recv, recvFrom, send, sendTo)-import Network.Socket.ByteString-import Network.Test.Common--import Test.Hspec--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-    describe "send" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` testMsg-                client sock = send sock testMsg-            tcpTest client server--        it "checks -1 correctly on Windows" $ do-            sock <- socket AF_INET Stream defaultProtocol-            send sock "hello world" `shouldThrow` anyException--    describe "sendAll" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` testMsg-                client sock = sendAll sock testMsg-            tcpTest client server--    describe "sendTo" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` testMsg-                client sock serverPort = do-                    let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }-                    addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)-                    sendTo sock testMsg $ addrAddress addr-            udpTest client server--    describe "sendAllTo" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` testMsg-                client sock serverPort = do-                    let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }-                    addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)-                    sendAllTo sock testMsg $ addrAddress addr-            udpTest client server--    describe "sendMany" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` S.append seg1 seg2-                client sock = sendMany sock [seg1, seg2]--                seg1 = C.pack "This is a "-                seg2 = C.pack "test message."-            tcpTest client server--    describe "sendManyTo" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` S.append seg1 seg2-                client sock serverPort = do-                    let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }-                    addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)-                    sendManyTo sock [seg1, seg2] $ addrAddress addr--                seg1 = C.pack "This is a "-                seg2 = C.pack "test message."-            udpTest client server--    describe "recv" $ do-        it "works well" $ do-            let server sock = recv sock 1024 `shouldReturn` testMsg-                client sock = send sock testMsg-            tcpTest client server--        it "can treat overflow" $ do-            let server sock = do-                    seg1 <- recv sock (S.length testMsg - 3)-                    seg2 <- recv sock 1024-                    let msg = S.append seg1 seg2-                    msg `shouldBe` testMsg-                client sock = send sock testMsg-            tcpTest client server--        it "checks -1 correctly on Windows" $ do-            sock <- socket AF_INET Stream defaultProtocol-            recv sock 1024 `shouldThrow` anyException--    describe "recvFrom" $ do-        it "works well" $ do-            let server sock = do-                    (msg, _) <- recvFrom sock 1024-                    testMsg `shouldBe` msg-                client sock = do-                    addr <- getPeerName sock-                    sendTo sock testMsg addr-            tcpTest client server--        it "can treat overflow" $ do-            let server sock = do-                    (seg1, _) <- recvFrom sock (S.length testMsg - 3)-                    (seg2, _) <- recvFrom sock 1024-                    let msg = S.append seg1 seg2-                    testMsg `shouldBe` msg-                client sock = send sock testMsg-            tcpTest client server
− tests/Network/SocketSpec.hs 
@@ -1,126 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}--module Network.SocketSpec (main, spec) where--import Control.Concurrent.MVar (readMVar)-import Control.Monad-import Network.Socket hiding (recv, send)-import Network.Socket.ByteString-import Network.Test.Common--import Test.Hspec--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-    describe "connect" $ do-        let-          hints = defaultHints { addrSocketType = Stream }-          connect' serverPort = do-              addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)-              sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)-              connect sock (addrAddress addr)-              return sock--        it "fails to connect and throws an IOException" $ do-            connect' (8080 :: Int) `shouldThrow` anyIOException--        it "successfully connects to a socket with no exception" $ do-            tcpTestUsingClient return return $ readMVar >=> connect'--    describe "UserTimeout" $ do-        it "can be set" $ do-            when (isSupportedSocketOption UserTimeout) $ do-              sock <- socket AF_INET Stream defaultProtocol-              setSocketOption sock UserTimeout 1000-              getSocketOption sock UserTimeout `shouldReturn` 1000-              setSocketOption sock UserTimeout 2000-              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] }-            AddrInfo{addrAddress = (SockAddrInet _ hostAddr)}:_ <--                getAddrInfo (Just hints) (Just "127.128.129.130") Nothing-            hostAddressToTuple hostAddr `shouldBe` (0x7f, 0x80, 0x81, 0x82)--#if defined(IPV6_SOCKET_SUPPORT)-        it "works for IPv6 address" $ do-            let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }-                host = "2001:0db8:85a3:0000:0000:8a2e:0370:7334"-            AddrInfo{addrAddress = (SockAddrInet6 _ _ hostAddr _)}:_ <--                getAddrInfo (Just hints) (Just host) Nothing-            hostAddress6ToTuple hostAddr-                `shouldBe` (0x2001, 0x0db8, 0x85a3, 0x0000, 0x0000, 0x8a2e, 0x0370, 0x7334)-#endif--        it "does not cause segfault on macOS 10.8.2 due to AI_NUMERICSERV" $ do-            let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }-            void $ getAddrInfo (Just hints) (Just "localhost") Nothing--    describe "unix sockets" $ do-        it "basic unix sockets end-to-end" $ do-            when isUnixDomainSocketAvailable $ do-                let client sock = send sock testMsg-                    server (sock, addr) = do-                      recv sock 1024 `shouldReturn` testMsg-                      addr `shouldBe` (SockAddrUnix "")-                unixTest client server-#ifdef linux_HOST_OS-        it "can end-to-end with an abstract socket" $ do-            when isUnixDomainSocketAvailable $ do-                let-                    abstractAddress = toEnum 0:"/haskell/network/abstract"-                    clientAct sock = send sock testMsg-                    server (sock, addr) = do-                      recv sock 1024 `shouldReturn` testMsg-                      addr `shouldBe` (SockAddrUnix "")-                unixTestWith abstractAddress (const $ return ()) clientAct server-        it "safely throws an exception" $ do-            when isUnixDomainSocketAvailable $ do-                let abstractAddress = toEnum 0:"/haskell/network/abstract-longlonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglonglong"-                sock <- socket AF_UNIX Stream defaultProtocol-                bind sock (SockAddrUnix abstractAddress) `shouldThrow` anyErrorCall-#endif
− tests/Network/Test/Common.hs 
@@ -1,200 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Network.Test.Common-  ( serverAddr-  , testMsg-  , lazyTestMsg-  , tcpTest-  , tcpTestUsingClient-  , unixTest-  , unixTestWith-  , udpTest-  ) where--import Control.Concurrent (ThreadId, forkIO, myThreadId)-import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar)-import qualified Control.Exception as E-import Control.Monad-import Data.ByteString (ByteString)-import Network.Socket-import System.Directory-import qualified Data.ByteString.Lazy as L-import System.Timeout (timeout)--import Test.Hspec--serverAddr :: String-serverAddr = "127.0.0.1"--testMsg :: ByteString-testMsg = "This is a test message."--lazyTestMsg :: L.ByteString-lazyTestMsg = L.fromStrict "This is a test message."--unixAddr :: String-unixAddr = "/tmp/network-test"---- | 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 = unixTestWith unixAddr unlink-  where-    unlink file = do-        exist <- doesFileExist file-        when exist $ removeFile file--unixTestWith-    :: String -- ^ address-    -> (String -> IO ()) -- ^ clean up action-    -> (Socket -> IO a) -- ^ client action-    -> ((Socket, SockAddr) -> IO b) -- ^ server action-    -> IO ()-unixTestWith address cleanupAct clientAct serverAct =-    test clientSetup clientAct serverSetup server-  where-    clientSetup = do-        sock <- socket AF_UNIX Stream defaultProtocol-        connect sock (SockAddrUnix address)-        return sock--    serverSetup = do-        sock <- socket AF_UNIX Stream defaultProtocol-        cleanupAct address -- just in case-        bind sock (SockAddrUnix address)-        listen sock 1-        return sock--    server sock = E.bracket (accept sock) (killClientSock . fst) serverAct--    killClientSock sock = do-        shutdown sock ShutdownBoth-        close sock-        cleanupAct address---- | 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 ()-tcpTest clientAct serverAct =-    tcpTestUsingClient serverAct clientAct clientSetup-  where-    clientSetup portVar = do-        let hints = defaultHints { addrSocketType = Stream }-        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--tcpTestUsingClient-    :: (Socket -> IO a) -> (Socket -> IO b) -> (MVar PortNumber -> IO Socket) -> IO ()-tcpTestUsingClient serverAct clientAct clientSetup = do-    portVar <- newEmptyMVar-    test (clientSetup portVar) clientAct (serverSetup portVar) server-  where-    serverSetup portVar = do-        let hints = defaultHints {-                addrFlags = [AI_PASSIVE]-              , addrSocketType = Stream-              }-        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-        putMVar portVar serverPort-        return sock--    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---- | Create an unconnected 'Socket' for sending UDP and receiving--- datagrams and then run 'clientAct' and 'serverAct'.-udpTest :: (Socket -> PortNumber -> IO a) -> (Socket -> IO b) -> IO ()-udpTest clientAct serverAct = do-    portVar <- newEmptyMVar-    test clientSetup (client portVar) (serverSetup portVar) serverAct-  where-    clientSetup = socket AF_INET Datagram defaultProtocol--    client portVar sock = do-        serverPort <- readMVar portVar-        clientAct sock serverPort--    serverSetup portVar = do-        let hints = defaultHints {-                addrFlags = [AI_PASSIVE]-              , addrSocketType = Datagram-              }-        addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing-        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)-        setSocketOption sock ReuseAddr 1-        bind sock $ addrAddress addr-        serverPort <- socketPort sock-        putMVar portVar serverPort-        return sock---- | Run a client/server pair and synchronize them so that the server--- is started before the client and the specified server action is--- finished before the client closes the 'Socket'.-test :: IO Socket -> (Socket -> IO b) -> IO Socket -> (Socket -> IO c) -> IO ()-test clientSetup clientAct serverSetup serverAct = do-    tid <- myThreadId-    barrier <- newEmptyMVar-    _ <- forkIO $ server barrier-        -- Release MVar if server setup fails-        `E.catch` \(e :: E.SomeException) -> putMVar barrier $ Just e-    client tid barrier-  where-    server barrier =-        E.bracket serverSetup close $ \sock -> do-        serverReady-        Just _ <- timeout 1000000 $ serverAct sock-        putMVar barrier Nothing-      where-        -- | Signal to the client that it can proceed.-        serverReady = putMVar barrier Nothing--    client tid barrier = do-        maybe (return ()) E.throwIO =<< takeMVar barrier-        -- Transfer exceptions to the main thread.-        bracketWithReraise tid clientSetup close $ \res -> do-            Just _ <- timeout 1000000 $ clientAct res-            maybe (return ()) E.throwIO =<< takeMVar barrier---- | Like 'bracket' but catches and reraises the exception in another--- thread, specified by the first argument.-bracketWithReraise :: ThreadId -> IO a -> (a -> IO b) -> (a -> IO ()) -> IO ()-bracketWithReraise tid setup teardown thing =-    E.bracket setup teardown thing-    `E.catch` \ (e :: E.SomeException) -> E.throwTo tid e
+ tests/RegressionSpec.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Tests for things that didn't work in the past.+module RegressionSpec (main, spec) where++import Control.Monad+import Network.Socket+import Network.Socket.ByteString++import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+    describe "getAddrInfo" $ do+        it "does not cause segfault on macOS 10.8.2 due to AI_NUMERICSERV" $ do+            let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }+            void $ getAddrInfo (Just hints) (Just "localhost") Nothing++    describe "Network.Socket.ByteString.recv" $ do+        it "checks -1 correctly on Windows" $ do+            sock <- socket AF_INET Stream defaultProtocol+            recv sock 1024 `shouldThrow` anyException++    describe "Network.Socket.ByteString.send" $ do+        it "checks -1 correctly on Windows" $ do+            sock <- socket AF_INET Stream defaultProtocol+            send sock "hello world" `shouldThrow` anyException
+ tests/SimpleSpec.hs view
@@ -0,0 +1,353 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module SimpleSpec (main, spec) where++import Control.Concurrent (ThreadId, forkIO, myThreadId)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, readMVar)+import qualified Control.Exception as E+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy as L+import Network.Socket+import Network.Socket.ByteString+import qualified Network.Socket.ByteString.Lazy as Lazy+import System.Directory+import System.Timeout (timeout)++import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+    describe "send" $ do+        it "works well" $ do+            let server sock = recv sock 1024 `shouldReturn` testMsg+                client sock = send sock testMsg+            tcpTest client server++    describe "sendAll" $ do+        it "works well" $ do+            let server sock = recv sock 1024 `shouldReturn` testMsg+                client sock = sendAll sock testMsg+            tcpTest client server++    describe "sendTo" $ do+        it "works well" $ do+            let server sock = recv sock 1024 `shouldReturn` testMsg+                client sock serverPort = do+                    let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+                    addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+                    sendTo sock testMsg $ addrAddress addr+            udpTest client server++    describe "sendAllTo" $ do+        it "works well" $ do+            let server sock = recv sock 1024 `shouldReturn` testMsg+                client sock serverPort = do+                    let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+                    addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+                    sendAllTo sock testMsg $ addrAddress addr+            udpTest client server++    describe "sendMany" $ do+        it "works well" $ do+            let server sock = recv sock 1024 `shouldReturn` (S.append seg1 seg2)+                client sock = sendMany sock [seg1, seg2]++                seg1 = C.pack "This is a "+                seg2 = C.pack "test message."+            tcpTest client server++    describe "sendManyTo" $ do+        it "works well" $ do+            let server sock = recv sock 1024 `shouldReturn` (S.append seg1 seg2)+                client sock serverPort = do+                    let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+                    addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+                    sendManyTo sock [seg1, seg2] $ addrAddress addr++                seg1 = C.pack "This is a "+                seg2 = C.pack "test message."+            udpTest client server++    describe "recv" $ do+        it "works well" $ do+            let server sock = recv sock 1024 `shouldReturn` testMsg+                client sock = send sock testMsg+            tcpTest client server++        it "can treat overflow" $ do+            let server sock = do seg1 <- recv sock (S.length testMsg - 3)+                                 seg2 <- recv sock 1024+                                 let msg = S.append seg1 seg2+                                 msg `shouldBe` testMsg+                client sock = send sock testMsg+            tcpTest client server++        it "returns empty string at EOF" $ do+            let client s = recv s 4096 `shouldReturn` S.empty+                server s = shutdown s ShutdownSend+            tcpTest client server++    describe "recvFrom" $ do+        it "works well" $ do+            let server sock = do (msg, _) <- recvFrom sock 1024+                                 testMsg `shouldBe` msg+                client sock = do+                    addr <- getPeerName sock+                    sendTo sock testMsg addr+            tcpTest client server+        it "can treat overflow" $ do+            let server sock = do (seg1, _) <- recvFrom sock (S.length testMsg - 3)+                                 (seg2, _) <- recvFrom sock 1024+                                 let msg = S.append seg1 seg2+                                 testMsg `shouldBe` msg++                client sock = send sock testMsg+            tcpTest client server++    describe "UserTimeout" $ do+        it "can be set" $ do+            when (isSupportedSocketOption UserTimeout) $ do+              sock <- socket AF_INET Stream defaultProtocol+              setSocketOption sock UserTimeout 1000+              getSocketOption sock UserTimeout `shouldReturn` 1000+              setSocketOption sock UserTimeout 2000+              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] }+            AddrInfo{addrAddress = (SockAddrInet _ hostAddr)}:_ <-+                getAddrInfo (Just hints) (Just "127.128.129.130") Nothing+            hostAddressToTuple hostAddr `shouldBe` (0x7f, 0x80, 0x81, 0x82)+#if defined(IPV6_SOCKET_SUPPORT)+        it "works for IPv6 address" $ do+            let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }+                host = "2001:0db8:85a3:0000:0000:8a2e:0370:7334"+            AddrInfo{addrAddress = (SockAddrInet6 _ _ hostAddr _)}:_ <-+                getAddrInfo (Just hints) (Just host) Nothing+            hostAddress6ToTuple hostAddr+                `shouldBe` (0x2001, 0x0db8, 0x85a3, 0x0000, 0x0000, 0x8a2e, 0x0370, 0x7334)+#endif++    describe "unix sockets" $ do+        it "basic unix sockets end-to-end" $ do+            when isUnixDomainSocketAvailable $ do+                let client sock = send sock testMsg+                    server (sock, addr) = do+                      recv sock 1024 `shouldReturn` testMsg+                      addr `shouldBe` (SockAddrUnix "")+                unixTest client server++    describe "Lazy.sendAll" $ do+        it "works well" $ do+            let server sock = recv sock 1024 `shouldReturn` testMsg+                client sock = Lazy.sendAll sock $ L.fromChunks [testMsg]+            tcpTest client server++------------------------------------------------------------------------++serverAddr :: String+serverAddr = "127.0.0.1"++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 ()+tcpTest clientAct serverAct = do+    portVar <- newEmptyMVar+    test (clientSetup portVar) clientAct (serverSetup portVar) server+  where+    clientSetup portVar = do+        let hints = defaultHints { addrSocketType = Stream }+        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)+        fd <- fdSocket sock+        getNonBlock fd `shouldReturn` True+        getCloseOnExec fd `shouldReturn` False+#endif+        connect sock $ addrAddress addr+        return sock++    serverSetup portVar = do+        let hints = defaultHints {+                addrFlags = [AI_PASSIVE]+              , addrSocketType = Stream+              }+        addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing+        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+        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+        putMVar portVar serverPort+        return sock++    server sock = do+        (clientSock, _) <- accept sock+#if !defined(mingw32_HOST_OS)+        fd <- fdSocket clientSock+        getNonBlock fd `shouldReturn` True+        getCloseOnExec fd `shouldReturn` True+#endif+        _ <- serverAct clientSock+        close clientSock++-- | Create an unconnected 'Socket' for sending UDP and receiving+-- datagrams and then run 'clientAct' and 'serverAct'.+udpTest :: (Socket -> PortNumber -> IO a) -> (Socket -> IO b) -> IO ()+udpTest clientAct serverAct = do+    portVar <- newEmptyMVar+    test clientSetup (client portVar) (serverSetup portVar) serverAct+  where+    clientSetup = socket AF_INET Datagram defaultProtocol++    client portVar sock = do+        serverPort <- readMVar portVar+        clientAct sock serverPort++    serverSetup portVar = do+        let hints = defaultHints {+                addrFlags = [AI_PASSIVE]+              , addrSocketType = Datagram+              }+        addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing+        sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+        setSocketOption sock ReuseAddr 1+        bind sock $ addrAddress addr+        serverPort <- socketPort sock+        putMVar portVar serverPort+        return sock++-- | Run a client/server pair and synchronize them so that the server+-- is started before the client and the specified server action is+-- finished before the client closes the 'Socket'.+test :: IO Socket -> (Socket -> IO b) -> IO Socket -> (Socket -> IO c) -> IO ()+test clientSetup clientAct serverSetup serverAct = do+    tid <- myThreadId+    barrier <- newEmptyMVar+    _ <- forkIO $ server barrier+    client tid barrier+  where+    server barrier = do+        E.bracket serverSetup close $ \sock -> do+            serverReady+            Just _ <- timeout 1000000 $ serverAct sock+            putMVar barrier ()+      where+        -- | Signal to the client that it can proceed.+        serverReady = putMVar barrier ()++    client tid barrier = do+        takeMVar barrier+        -- Transfer exceptions to the main thread.+        bracketWithReraise tid clientSetup close $ \res -> do+            Just _ <- timeout 1000000 $ clientAct res+            takeMVar barrier++-- | Like 'bracket' but catches and reraises the exception in another+-- thread, specified by the first argument.+bracketWithReraise :: ThreadId -> IO a -> (a -> IO b) -> (a -> IO ()) -> IO ()+bracketWithReraise tid setup teardown thing =+    E.bracket setup teardown thing+    `E.catch` \ (e :: E.SomeException) -> E.throwTo tid e
tests/doctests.hs view
@@ -1,20 +1,15 @@-import Test.DocTest+module Main where +import Build_doctests (flags, pkgs, module_sources)+import Data.Foldable (traverse_)+import Data.List (isSuffixOf, isPrefixOf)+import Test.DocTest (doctest)+ main :: IO ()-main = doctest [-    "-i"-  , "-idist/build"-  , "-i."-  , "-idist/build/autogen"-  , "-Idist/build/autogen"-  , "-Idist/build"-  , "-Iinclude"-  , "-optP-include"-  , "-optPdist/build/autogen/cabal_macros.h"-  , "-DCALLCONV=ccall"-  , "-XCPP"-  , "-XDeriveDataTypeable"-  , "-package-db dist/package.conf.inplace"-  , "-package network"-  , "Network"-  ]+main = do+    traverse_ putStrLn args+    doctest args+  where+    builddir = filter ("build" `isSuffixOf`) $ filter ("-i" `isPrefixOf`) flags+    addinc path = "-I" ++ drop 2 path ++ "/include"+    args = map addinc builddir ++ flags ++ pkgs ++ module_sources