{-# LINE 1 "Network/Socket.hsc" #-} {-# LANGUAGE CPP, ScopedTypeVariables #-} {-# LINE 2 "Network/Socket.hsc" #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-do-bind #-} ----------------------------------------------------------------------------- -- | -- 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 -- -- The "Network.Socket" module is for when you want full control over -- sockets. Essentially the entire C socket API is exposed through -- this module; in general the operations follow the behaviour of the C -- functions of the same name (consult your favourite Unix networking book). -- -- A higher level interface to networking operations is provided -- through the module "Network". -- ----------------------------------------------------------------------------- {-# LINE 24 "Network/Socket.hsc" #-} -- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs. #include "Typeable.h" -- In order to process this file, you need to have CALLCONV defined. module Network.Socket ( -- * Types Socket(..) , Family(..) , SocketType(..) , SockAddr(..) , SocketStatus(..) , HostAddress {-# LINE 40 "Network/Socket.hsc" #-} , HostAddress6 , FlowInfo , ScopeID {-# LINE 44 "Network/Socket.hsc" #-} , ShutdownCmd(..) , ProtocolNumber , defaultProtocol , PortNumber(..) -- PortNumber is used non-abstractly in Network.BSD. ToDo: remove -- this use and make the type abstract. -- * Address operations , HostName , ServiceName {-# LINE 57 "Network/Socket.hsc" #-} , AddrInfo(..) , AddrInfoFlag(..) , addrInfoFlagImplemented , defaultHints , getAddrInfo , NameInfoFlag(..) , getNameInfo {-# LINE 70 "Network/Socket.hsc" #-} -- * Socket operations , socket {-# LINE 74 "Network/Socket.hsc" #-} , socketPair {-# LINE 76 "Network/Socket.hsc" #-} , connect , bindSocket , listen , accept , getPeerName , getSocketName {-# LINE 84 "Network/Socket.hsc" #-} -- get the credentials of our domain socket peer. , getPeerCred {-# LINE 87 "Network/Socket.hsc" #-} , socketPort , socketToHandle -- ** Sending and receiving data -- $sendrecv , sendTo , sendBufTo , recvFrom , recvBufFrom , send , recv , recvLen , inet_addr , inet_ntoa , shutdown , sClose -- ** Predicates on sockets , sIsConnected , sIsBound , sIsListening , sIsReadable , sIsWritable -- * Socket options , SocketOption(..) , getSocketOption , setSocketOption -- * File descriptor transmission {-# LINE 124 "Network/Socket.hsc" #-} , sendFd , recvFd -- Note: these two will disappear shortly , sendAncillary , recvAncillary {-# LINE 132 "Network/Socket.hsc" #-} -- * Special constants , aNY_PORT , iNADDR_ANY {-# LINE 137 "Network/Socket.hsc" #-} , iN6ADDR_ANY {-# LINE 139 "Network/Socket.hsc" #-} , sOMAXCONN , sOL_SOCKET {-# LINE 142 "Network/Socket.hsc" #-} , sCM_RIGHTS {-# LINE 144 "Network/Socket.hsc" #-} , maxListenQueue -- * Initialisation , withSocketsDo -- * Very low level operations -- in case you ever want to get at the underlying file descriptor.. , fdSocket , mkSocket -- * Internal -- | The following are exported ONLY for use in the BSD module and -- should not be used anywhere else. , packFamily , unpackFamily , packSocketType , throwSocketErrorIfMinus1_ ) where {-# LINE 177 "Network/Socket.hsc" #-} import Data.Bits import Data.List (foldl') import Data.Word (Word16, Word32) import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.Storable (Storable(..)) import Foreign.C.Error import Foreign.C.String (CString, withCString, peekCString, peekCStringLen) import Foreign.C.Types (CUInt, CChar) {-# LINE 187 "Network/Socket.hsc" #-} import Foreign.C.Types (CInt(..), CSize(..)) {-# LINE 191 "Network/Socket.hsc" #-} 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) import Data.Ratio ((%)) import qualified Control.Exception as E import Control.Concurrent.MVar import Data.Typeable import System.IO.Error {-# LINE 205 "Network/Socket.hsc" #-} import GHC.Conc (threadWaitRead, threadWaitWrite) #if MIN_VERSION_base(4,3,1) import GHC.Conc (closeFdWith) #endif {-# LINE 213 "Network/Socket.hsc" #-} {-# LINE 214 "Network/Socket.hsc" #-} import qualified GHC.IO.Device import GHC.IO.Handle.FD import GHC.IO.Exception import GHC.IO {-# LINE 222 "Network/Socket.hsc" #-} import qualified System.Posix.Internals {-# LINE 226 "Network/Socket.hsc" #-} {-# LINE 228 "Network/Socket.hsc" #-} import GHC.IO.FD {-# LINE 230 "Network/Socket.hsc" #-} import Network.Socket.Internal -- | 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 -- There are a few possible ways to do this. The first is convert the -- structs used in the C library into an equivalent Haskell type. An -- other possible implementation is to keep all the internals in the C -- code and use an Int## and a status flag. The second method is used -- here since a lot of the C structures are not required to be -- manipulated. -- Originally the status was non-mutable so we had to return a new -- socket each time we changed the status. This version now uses -- mutable variables to avoid the need to do this. The result is a -- cleaner interface and better security since the application -- programmer now can't circumvent the status information to perform -- invalid operations on sockets. data SocketStatus -- Returned Status Function called = NotConnected -- socket | Bound -- bindSocket | Listening -- listen | Connected -- connect/accept | ConvertedToHandle -- is now a Handle, don't touch | Closed -- sClose deriving (Eq, Show, Typeable) data Socket = MkSocket CInt -- File Descriptor Family SocketType ProtocolNumber -- Protocol Number (MVar SocketStatus) -- Status Flag deriving Typeable {-# LINE 300 "Network/Socket.hsc" #-} mkSocket :: CInt -> Family -> SocketType -> ProtocolNumber -> SocketStatus -> IO Socket mkSocket fd fam sType pNum stat = do mStat <- newMVar stat return (MkSocket fd fam sType pNum mStat) instance Eq Socket where (MkSocket _ _ _ _ m1) == (MkSocket _ _ _ _ m2) = m1 == m2 instance Show Socket where showsPrec _n (MkSocket fd _ _ _ _) = showString "<socket: " . shows fd . showString ">" fdSocket :: Socket -> CInt fdSocket (MkSocket fd _ _ _ _) = fd type ProtocolNumber = CInt -- | This is the default protocol for a given service. defaultProtocol :: ProtocolNumber defaultProtocol = 0 ---------------------------------------------------------------------------- -- Port Numbers instance Show PortNumber where showsPrec p pn = showsPrec p (portNumberToInt pn) intToPortNumber :: Int -> PortNumber intToPortNumber v = PortNum (htons (fromIntegral v)) portNumberToInt :: PortNumber -> Int portNumberToInt (PortNum po) = fromIntegral (ntohs po) foreign import CALLCONV unsafe "ntohs" ntohs :: Word16 -> Word16 foreign import CALLCONV unsafe "htons" htons :: Word16 -> Word16 --foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32 foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32 instance Enum PortNumber where toEnum = intToPortNumber fromEnum = portNumberToInt instance Num PortNumber where fromInteger i = intToPortNumber (fromInteger i) -- for completeness. (+) x y = intToPortNumber (portNumberToInt x + portNumberToInt y) (-) x y = intToPortNumber (portNumberToInt x - portNumberToInt y) negate x = intToPortNumber (-portNumberToInt x) (*) x y = intToPortNumber (portNumberToInt x * portNumberToInt y) abs n = intToPortNumber (abs (portNumberToInt n)) signum n = intToPortNumber (signum (portNumberToInt n)) instance Real PortNumber where toRational x = toInteger x % 1 instance Integral PortNumber where quotRem a b = let (c,d) = quotRem (portNumberToInt a) (portNumberToInt b) in (intToPortNumber c, intToPortNumber d) toInteger a = toInteger (portNumberToInt a) instance Storable PortNumber where sizeOf _ = sizeOf (undefined :: Word16) alignment _ = alignment (undefined :: Word16) poke p (PortNum po) = poke (castPtr p) po peek p = PortNum `liftM` peek (castPtr p) ----------------------------------------------------------------------------- -- SockAddr instance Show SockAddr where {-# LINE 378 "Network/Socket.hsc" #-} showsPrec _ (SockAddrUnix str) = showString str {-# LINE 380 "Network/Socket.hsc" #-} showsPrec _ (SockAddrInet port ha) = showString (unsafePerformIO (inet_ntoa ha)) . showString ":" . shows port {-# LINE 385 "Network/Socket.hsc" #-} 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 {-# LINE 393 "Network/Socket.hsc" #-} ----------------------------------------------------------------------------- -- 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, the 'IPv6Only' socket option is set to 0 -- so that both IPv4 and IPv6 can be handled with one socket. 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 fd <- throwSocketErrorIfMinus1Retry "socket" $ c_socket (packFamily family) (packSocketType stype) protocol {-# LINE 418 "Network/Socket.hsc" #-} {-# LINE 421 "Network/Socket.hsc" #-} System.Posix.Internals.setNonBlockingFD fd True {-# LINE 423 "Network/Socket.hsc" #-} {-# LINE 424 "Network/Socket.hsc" #-} socket_status <- newMVar NotConnected let sock = MkSocket fd family stype protocol socket_status {-# LINE 427 "Network/Socket.hsc" #-} {-# LINE 433 "Network/Socket.hsc" #-} when (family == AF_INET6) $ setSocketOption sock IPv6Only 0 {-# LINE 435 "Network/Socket.hsc" #-} {-# LINE 436 "Network/Socket.hsc" #-} 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. {-# LINE 443 "Network/Socket.hsc" #-} socketPair :: Family -- Family Name (usually AF_INET or AF_INET6) -> SocketType -- Socket Type (usually Stream) -> ProtocolNumber -- Protocol Number -> IO (Socket, Socket) -- unnamed and connected. socketPair family stype protocol = do allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do _rc <- throwSocketErrorIfMinus1Retry "socketpair" $ c_socketpair (packFamily family) (packSocketType stype) protocol fdArr [fd1,fd2] <- peekArray 2 fdArr s1 <- mkNonBlockingSocket fd1 s2 <- mkNonBlockingSocket fd2 return (s1,s2) where mkNonBlockingSocket fd = do {-# LINE 460 "Network/Socket.hsc" #-} {-# LINE 463 "Network/Socket.hsc" #-} System.Posix.Internals.setNonBlockingFD fd True {-# LINE 465 "Network/Socket.hsc" #-} {-# LINE 466 "Network/Socket.hsc" #-} stat <- newMVar Connected return (MkSocket fd family stype protocol stat) foreign import ccall unsafe "socketpair" c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt {-# LINE 472 "Network/Socket.hsc" #-} ----------------------------------------------------------------------------- -- Binding a socket -- | Bind the socket to an address. The socket must not already be -- bound. The 'Family' passed to @bindSocket@ must be the -- same as that passed to 'socket'. If the special port number -- 'aNY_PORT' is passed then the system assigns the next available -- use port. bindSocket :: Socket -- Unconnected Socket -> SockAddr -- Address to Bind to -> IO () bindSocket (MkSocket s _family _stype _protocol socketStatus) addr = do modifyMVar_ socketStatus $ \ status -> do if status /= NotConnected then ioError (userError ("bindSocket: can't peform bind on socket in status " ++ show status)) else do withSockAddr addr $ \p_addr sz -> do _status <- throwSocketErrorIfMinus1Retry "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 = do modifyMVar_ socketStatus $ \currentStatus -> do if currentStatus /= NotConnected && currentStatus /= Bound then ioError (userError ("connect: can't peform connect on socket in 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 {-# LINE 516 "Network/Socket.hsc" #-} err <- getErrno case () of _ | err == eINTR -> connectLoop _ | err == eINPROGRESS -> connectBlocked -- _ | err == eAGAIN -> connectBlocked _otherwise -> throwSocketError "connect" {-# LINE 533 "Network/Socket.hsc" #-} else return r connectBlocked = do {-# LINE 537 "Network/Socket.hsc" #-} threadWaitWrite (fromIntegral s) {-# LINE 539 "Network/Socket.hsc" #-} err <- getSocketOption sock SoError if (err == 0) then return 0 else do ioError (errnoToIOError "connect" (Errno (fromIntegral err)) Nothing Nothing) connectLoop return Connected ----------------------------------------------------------------------------- -- 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 ("listen: can't peform listen on socket in status " ++ show status)) else do throwSocketErrorIfMinus1Retry "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 okay <- sIsAcceptable sock if not okay then ioError (userError ("accept: can't perform accept on socket (" ++ (show (family,stype,protocol)) ++") in status " ++ show currentStatus)) else do let sz = sizeOfSockAddrByFamily family allocaBytes sz $ \ sockaddr -> do {-# LINE 611 "Network/Socket.hsc" #-} with (fromIntegral sz) $ \ ptr_len -> do new_sock <- {-# LINE 614 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "accept" (threadWaitRead (fromIntegral s)) (c_accept4 s sockaddr ptr_len (2048)) {-# LINE 617 "Network/Socket.hsc" #-} {-# LINE 631 "Network/Socket.hsc" #-} {-# LINE 632 "Network/Socket.hsc" #-} addr <- peekSockAddr sockaddr new_status <- newMVar Connected return ((MkSocket new_sock family stype protocol new_status), addr) {-# LINE 646 "Network/Socket.hsc" #-} ----------------------------------------------------------------------------- -- ** Sending and reciving data -- $sendrecv -- -- Do not use the @send@ and @recv@ functions defined in this module -- 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) sendTo :: Socket -- (possibly) bound/connected Socket -> String -- Data to send -> SockAddr -> IO Int -- Number of Bytes sent sendTo sock xs addr = do withCString xs $ \str -> do sendBufTo sock str (length xs) 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 (MkSocket s _family _stype _protocol _status) ptr nbytes addr = do withSockAddr addr $ \p_addr sz -> do liftM fromIntegral $ {-# LINE 688 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "sendTo" (threadWaitWrite (fromIntegral s)) $ {-# LINE 691 "Network/Socket.hsc" #-} 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) 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.recvFrom") | otherwise = withNewSockAddr family $ \ptr_addr sz -> do alloca $ \ptr_len -> do poke ptr_len (fromIntegral sz) len <- {-# LINE 726 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "recvFrom" (threadWaitRead (fromIntegral s)) $ {-# LINE 729 "Network/Socket.hsc" #-} 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 <- sIsConnected 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. send :: Socket -- Bound/Connected Socket -> String -- Data to send -> IO Int -- Number of Bytes sent send sock@(MkSocket s _family _stype _protocol _status) xs = do let len = length xs withCString xs $ \str -> do liftM fromIntegral $ {-# LINE 778 "Network/Socket.hsc" #-} {-# LINE 779 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "send" (threadWaitWrite (fromIntegral s)) $ {-# LINE 782 "Network/Socket.hsc" #-} c_send s str (fromIntegral len) 0{-flags-} {-# LINE 784 "Network/Socket.hsc" #-} -- | 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. recv :: Socket -> Int -> IO String recv sock l = recvLen sock l >>= \ (s,_) -> return s recvLen :: Socket -> Int -> IO (String, Int) recvLen sock@(MkSocket s _family _stype _protocol _status) nbytes | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recv") | otherwise = do allocaBytes nbytes $ \ptr -> do len <- {-# LINE 814 "Network/Socket.hsc" #-} {-# LINE 815 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "recv" (threadWaitRead (fromIntegral s)) $ {-# LINE 818 "Network/Socket.hsc" #-} c_recv s ptr (fromIntegral nbytes) 0{-flags-} {-# LINE 820 "Network/Socket.hsc" #-} let len' = fromIntegral len if len' == 0 then ioError (mkEOFError "Network.Socket.recv") else do s' <- peekCStringLen (castPtr ptr,len') return (s', 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$. socketPort :: Socket -- Connected & Bound Socket -> IO PortNumber -- Port Number of Socket socketPort sock@(MkSocket _ AF_INET _ _ _) = do (SockAddrInet port _) <- getSocketName sock return port {-# LINE 840 "Network/Socket.hsc" #-} socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do (SockAddrInet6 port _ _ _) <- getSocketName sock return port {-# LINE 844 "Network/Socket.hsc" #-} socketPort (MkSocket _ family _ _ _) = ioError (userError ("socketPort: not supported for Family " ++ show family)) -- --------------------------------------------------------------------------- -- 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 "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 "getSocketName" $ c_getsockname s ptr int_star peekSockAddr ptr ----------------------------------------------------------------------------- -- Socket Properties data SocketOption = DummySocketOption__ {-# LINE 878 "Network/Socket.hsc" #-} | Debug {- SO_DEBUG -} {-# LINE 880 "Network/Socket.hsc" #-} {-# LINE 881 "Network/Socket.hsc" #-} | ReuseAddr {- SO_REUSEADDR -} {-# LINE 883 "Network/Socket.hsc" #-} {-# LINE 884 "Network/Socket.hsc" #-} | Type {- SO_TYPE -} {-# LINE 886 "Network/Socket.hsc" #-} {-# LINE 887 "Network/Socket.hsc" #-} | SoError {- SO_ERROR -} {-# LINE 889 "Network/Socket.hsc" #-} {-# LINE 890 "Network/Socket.hsc" #-} | DontRoute {- SO_DONTROUTE -} {-# LINE 892 "Network/Socket.hsc" #-} {-# LINE 893 "Network/Socket.hsc" #-} | Broadcast {- SO_BROADCAST -} {-# LINE 895 "Network/Socket.hsc" #-} {-# LINE 896 "Network/Socket.hsc" #-} | SendBuffer {- SO_SNDBUF -} {-# LINE 898 "Network/Socket.hsc" #-} {-# LINE 899 "Network/Socket.hsc" #-} | RecvBuffer {- SO_RCVBUF -} {-# LINE 901 "Network/Socket.hsc" #-} {-# LINE 902 "Network/Socket.hsc" #-} | KeepAlive {- SO_KEEPALIVE -} {-# LINE 904 "Network/Socket.hsc" #-} {-# LINE 905 "Network/Socket.hsc" #-} | OOBInline {- SO_OOBINLINE -} {-# LINE 907 "Network/Socket.hsc" #-} {-# LINE 908 "Network/Socket.hsc" #-} | TimeToLive {- IP_TTL -} {-# LINE 910 "Network/Socket.hsc" #-} {-# LINE 911 "Network/Socket.hsc" #-} | MaxSegment {- TCP_MAXSEG -} {-# LINE 913 "Network/Socket.hsc" #-} {-# LINE 914 "Network/Socket.hsc" #-} | NoDelay {- TCP_NODELAY -} {-# LINE 916 "Network/Socket.hsc" #-} {-# LINE 917 "Network/Socket.hsc" #-} | Cork {- TCP_CORK -} {-# LINE 919 "Network/Socket.hsc" #-} {-# LINE 920 "Network/Socket.hsc" #-} | Linger {- SO_LINGER -} {-# LINE 922 "Network/Socket.hsc" #-} {-# LINE 925 "Network/Socket.hsc" #-} {-# LINE 926 "Network/Socket.hsc" #-} | RecvLowWater {- SO_RCVLOWAT -} {-# LINE 928 "Network/Socket.hsc" #-} {-# LINE 929 "Network/Socket.hsc" #-} | SendLowWater {- SO_SNDLOWAT -} {-# LINE 931 "Network/Socket.hsc" #-} {-# LINE 932 "Network/Socket.hsc" #-} | RecvTimeOut {- SO_RCVTIMEO -} {-# LINE 934 "Network/Socket.hsc" #-} {-# LINE 935 "Network/Socket.hsc" #-} | SendTimeOut {- SO_SNDTIMEO -} {-# LINE 937 "Network/Socket.hsc" #-} {-# LINE 940 "Network/Socket.hsc" #-} {-# LINE 941 "Network/Socket.hsc" #-} | IPv6Only {- IPV6_V6ONLY -} {-# LINE 943 "Network/Socket.hsc" #-} deriving (Show, Typeable) socketOptLevel :: SocketOption -> CInt socketOptLevel so = case so of {-# LINE 949 "Network/Socket.hsc" #-} TimeToLive -> 0 {-# LINE 950 "Network/Socket.hsc" #-} {-# LINE 951 "Network/Socket.hsc" #-} {-# LINE 952 "Network/Socket.hsc" #-} MaxSegment -> 6 {-# LINE 953 "Network/Socket.hsc" #-} {-# LINE 954 "Network/Socket.hsc" #-} {-# LINE 955 "Network/Socket.hsc" #-} NoDelay -> 6 {-# LINE 956 "Network/Socket.hsc" #-} {-# LINE 957 "Network/Socket.hsc" #-} {-# LINE 958 "Network/Socket.hsc" #-} Cork -> 6 {-# LINE 959 "Network/Socket.hsc" #-} {-# LINE 960 "Network/Socket.hsc" #-} {-# LINE 961 "Network/Socket.hsc" #-} IPv6Only -> 41 {-# LINE 962 "Network/Socket.hsc" #-} {-# LINE 963 "Network/Socket.hsc" #-} _ -> 1 {-# LINE 964 "Network/Socket.hsc" #-} packSocketOption :: SocketOption -> CInt packSocketOption so = case so of {-# LINE 969 "Network/Socket.hsc" #-} Debug -> 1 {-# LINE 970 "Network/Socket.hsc" #-} {-# LINE 971 "Network/Socket.hsc" #-} {-# LINE 972 "Network/Socket.hsc" #-} ReuseAddr -> 2 {-# LINE 973 "Network/Socket.hsc" #-} {-# LINE 974 "Network/Socket.hsc" #-} {-# LINE 975 "Network/Socket.hsc" #-} Type -> 3 {-# LINE 976 "Network/Socket.hsc" #-} {-# LINE 977 "Network/Socket.hsc" #-} {-# LINE 978 "Network/Socket.hsc" #-} SoError -> 4 {-# LINE 979 "Network/Socket.hsc" #-} {-# LINE 980 "Network/Socket.hsc" #-} {-# LINE 981 "Network/Socket.hsc" #-} DontRoute -> 5 {-# LINE 982 "Network/Socket.hsc" #-} {-# LINE 983 "Network/Socket.hsc" #-} {-# LINE 984 "Network/Socket.hsc" #-} Broadcast -> 6 {-# LINE 985 "Network/Socket.hsc" #-} {-# LINE 986 "Network/Socket.hsc" #-} {-# LINE 987 "Network/Socket.hsc" #-} SendBuffer -> 7 {-# LINE 988 "Network/Socket.hsc" #-} {-# LINE 989 "Network/Socket.hsc" #-} {-# LINE 990 "Network/Socket.hsc" #-} RecvBuffer -> 8 {-# LINE 991 "Network/Socket.hsc" #-} {-# LINE 992 "Network/Socket.hsc" #-} {-# LINE 993 "Network/Socket.hsc" #-} KeepAlive -> 9 {-# LINE 994 "Network/Socket.hsc" #-} {-# LINE 995 "Network/Socket.hsc" #-} {-# LINE 996 "Network/Socket.hsc" #-} OOBInline -> 10 {-# LINE 997 "Network/Socket.hsc" #-} {-# LINE 998 "Network/Socket.hsc" #-} {-# LINE 999 "Network/Socket.hsc" #-} TimeToLive -> 2 {-# LINE 1000 "Network/Socket.hsc" #-} {-# LINE 1001 "Network/Socket.hsc" #-} {-# LINE 1002 "Network/Socket.hsc" #-} MaxSegment -> 2 {-# LINE 1003 "Network/Socket.hsc" #-} {-# LINE 1004 "Network/Socket.hsc" #-} {-# LINE 1005 "Network/Socket.hsc" #-} NoDelay -> 1 {-# LINE 1006 "Network/Socket.hsc" #-} {-# LINE 1007 "Network/Socket.hsc" #-} {-# LINE 1008 "Network/Socket.hsc" #-} Cork -> 3 {-# LINE 1009 "Network/Socket.hsc" #-} {-# LINE 1010 "Network/Socket.hsc" #-} {-# LINE 1011 "Network/Socket.hsc" #-} Linger -> 13 {-# LINE 1012 "Network/Socket.hsc" #-} {-# LINE 1013 "Network/Socket.hsc" #-} {-# LINE 1016 "Network/Socket.hsc" #-} {-# LINE 1017 "Network/Socket.hsc" #-} RecvLowWater -> 18 {-# LINE 1018 "Network/Socket.hsc" #-} {-# LINE 1019 "Network/Socket.hsc" #-} {-# LINE 1020 "Network/Socket.hsc" #-} SendLowWater -> 19 {-# LINE 1021 "Network/Socket.hsc" #-} {-# LINE 1022 "Network/Socket.hsc" #-} {-# LINE 1023 "Network/Socket.hsc" #-} RecvTimeOut -> 20 {-# LINE 1024 "Network/Socket.hsc" #-} {-# LINE 1025 "Network/Socket.hsc" #-} {-# LINE 1026 "Network/Socket.hsc" #-} SendTimeOut -> 21 {-# LINE 1027 "Network/Socket.hsc" #-} {-# LINE 1028 "Network/Socket.hsc" #-} {-# LINE 1031 "Network/Socket.hsc" #-} {-# LINE 1032 "Network/Socket.hsc" #-} IPv6Only -> 26 {-# LINE 1033 "Network/Socket.hsc" #-} {-# LINE 1034 "Network/Socket.hsc" #-} unknown -> error ("Network.Socket.packSocketOption: unknown option " ++ show unknown) setSocketOption :: Socket -> SocketOption -- Option Name -> Int -- Option Value -> IO () setSocketOption (MkSocket s _ _ _ _) so v = do with (fromIntegral v) $ \ptr_v -> do throwErrnoIfMinus1_ "setSocketOption" $ c_setsockopt s (socketOptLevel so) (packSocketOption so) ptr_v (fromIntegral (sizeOf (undefined :: CInt))) return () getSocketOption :: Socket -> SocketOption -- Option Name -> IO Int -- Option Value getSocketOption (MkSocket s _ _ _ _) so = do alloca $ \ptr_v -> with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do throwErrnoIfMinus1 "getSocketOption" $ c_getsockopt s (socketOptLevel so) (packSocketOption so) ptr_v ptr_sz fromIntegral `liftM` peek ptr_v {-# LINE 1061 "Network/Socket.hsc" #-} -- | Returns the processID, userID and groupID of the socket's peer. -- -- Only available on platforms that support SO_PEERCRED on domain sockets. getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt) getPeerCred sock = do let fd = fdSocket sock let sz = (fromIntegral (12)) {-# LINE 1068 "Network/Socket.hsc" #-} with sz $ \ ptr_cr -> alloca $ \ ptr_sz -> do poke ptr_sz sz throwErrnoIfMinus1 "getPeerCred" $ c_getsockopt fd (1) (17) ptr_cr ptr_sz {-# LINE 1073 "Network/Socket.hsc" #-} pid <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr_cr {-# LINE 1074 "Network/Socket.hsc" #-} uid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr_cr {-# LINE 1075 "Network/Socket.hsc" #-} gid <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr_cr {-# LINE 1076 "Network/Socket.hsc" #-} return (pid, uid, gid) {-# LINE 1078 "Network/Socket.hsc" #-} #if !(MIN_VERSION_base(4,3,1)) closeFdWith closer fd = closer fd #endif {-# LINE 1084 "Network/Socket.hsc" #-} -- sending/receiving ancillary socket data; low-level mechanism -- for transmitting file descriptors, mainly. sendFd :: Socket -> CInt -> IO () sendFd sock outfd = do let fd = fdSocket sock {-# LINE 1090 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "sendFd" (threadWaitWrite (fromIntegral fd)) $ c_sendFd fd outfd {-# LINE 1096 "Network/Socket.hsc" #-} -- Note: If Winsock supported FD-passing, thi would have been -- incorrect (since socket FDs need to be closed via closesocket().) close outfd recvFd :: Socket -> IO CInt recvFd sock = do let fd = fdSocket sock theFd <- {-# LINE 1105 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "recvFd" (threadWaitRead (fromIntegral fd)) $ {-# LINE 1108 "Network/Socket.hsc" #-} c_recvFd fd return theFd sendAncillary :: Socket -> Int -> Int -> Int -> Ptr a -> Int -> IO () sendAncillary sock level ty flags datum len = do let fd = fdSocket sock _ <- {-# LINE 1123 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "sendAncillary" (threadWaitWrite (fromIntegral fd)) $ {-# LINE 1126 "Network/Socket.hsc" #-} c_sendAncillary fd (fromIntegral level) (fromIntegral ty) (fromIntegral flags) datum (fromIntegral len) return () recvAncillary :: Socket -> Int -> Int -> IO (Int,Int,Ptr a,Int) recvAncillary sock flags len = do let fd = fdSocket sock alloca $ \ ptr_len -> alloca $ \ ptr_lev -> alloca $ \ ptr_ty -> alloca $ \ ptr_pData -> do poke ptr_len (fromIntegral len) _ <- {-# LINE 1143 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "recvAncillary" (threadWaitRead (fromIntegral fd)) $ {-# LINE 1146 "Network/Socket.hsc" #-} c_recvAncillary fd ptr_lev ptr_ty (fromIntegral flags) ptr_pData ptr_len rcvlen <- fromIntegral `liftM` peek ptr_len lev <- fromIntegral `liftM` peek ptr_lev ty <- fromIntegral `liftM` peek ptr_ty pD <- peek ptr_pData return (lev,ty,pD, rcvlen) foreign import ccall SAFE_ON_WIN "sendAncillary" c_sendAncillary :: CInt -> CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt foreign import ccall SAFE_ON_WIN "recvAncillary" c_recvAncillary :: CInt -> Ptr CInt -> Ptr CInt -> CInt -> Ptr (Ptr a) -> Ptr CInt -> IO CInt foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt {-# LINE 1162 "Network/Socket.hsc" #-} {- A calling sequence table for the main functions is shown in the table below. \begin{figure}[h] \begin{center} \begin{tabular}{|l|c|c|c|c|c|c|c|}d \hline {\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\ \hline {\bf Precedes} & & & & & & & \\ \hline socket & & & & & & & \\ \hline connect & + & & & & & & \\ \hline bindSocket & + & & & & & & \\ \hline listen & & & + & & & & \\ \hline accept & & & & + & & & \\ \hline read & & + & & + & + & + & + \\ \hline write & & + & & + & + & + & + \\ \hline \end{tabular} \caption{Sequence Table for Major functions of Socket} \label{tab:api-seq} \end{center} \end{figure} -} -- --------------------------------------------------------------------------- -- OS Dependent Definitions unpackFamily :: CInt -> Family packFamily :: Family -> CInt packSocketType :: SocketType -> CInt unpackSocketType:: CInt -> SocketType ------ ------ packFamily f = case f of AF_UNSPEC -> 0 {-# LINE 1209 "Network/Socket.hsc" #-} {-# LINE 1210 "Network/Socket.hsc" #-} AF_UNIX -> 1 {-# LINE 1211 "Network/Socket.hsc" #-} {-# LINE 1212 "Network/Socket.hsc" #-} {-# LINE 1213 "Network/Socket.hsc" #-} AF_INET -> 2 {-# LINE 1214 "Network/Socket.hsc" #-} {-# LINE 1215 "Network/Socket.hsc" #-} {-# LINE 1216 "Network/Socket.hsc" #-} AF_INET6 -> 10 {-# LINE 1217 "Network/Socket.hsc" #-} {-# LINE 1218 "Network/Socket.hsc" #-} {-# LINE 1221 "Network/Socket.hsc" #-} {-# LINE 1224 "Network/Socket.hsc" #-} {-# LINE 1227 "Network/Socket.hsc" #-} {-# LINE 1230 "Network/Socket.hsc" #-} {-# LINE 1233 "Network/Socket.hsc" #-} {-# LINE 1236 "Network/Socket.hsc" #-} {-# LINE 1239 "Network/Socket.hsc" #-} {-# LINE 1242 "Network/Socket.hsc" #-} {-# LINE 1243 "Network/Socket.hsc" #-} AF_SNA -> 22 {-# LINE 1244 "Network/Socket.hsc" #-} {-# LINE 1245 "Network/Socket.hsc" #-} {-# LINE 1246 "Network/Socket.hsc" #-} AF_DECnet -> 12 {-# LINE 1247 "Network/Socket.hsc" #-} {-# LINE 1248 "Network/Socket.hsc" #-} {-# LINE 1251 "Network/Socket.hsc" #-} {-# LINE 1254 "Network/Socket.hsc" #-} {-# LINE 1257 "Network/Socket.hsc" #-} {-# LINE 1258 "Network/Socket.hsc" #-} AF_APPLETALK -> 5 {-# LINE 1259 "Network/Socket.hsc" #-} {-# LINE 1260 "Network/Socket.hsc" #-} {-# LINE 1261 "Network/Socket.hsc" #-} AF_ROUTE -> 16 {-# LINE 1262 "Network/Socket.hsc" #-} {-# LINE 1263 "Network/Socket.hsc" #-} {-# LINE 1266 "Network/Socket.hsc" #-} {-# LINE 1269 "Network/Socket.hsc" #-} {-# LINE 1272 "Network/Socket.hsc" #-} {-# LINE 1275 "Network/Socket.hsc" #-} {-# LINE 1278 "Network/Socket.hsc" #-} {-# LINE 1281 "Network/Socket.hsc" #-} {-# LINE 1282 "Network/Socket.hsc" #-} AF_X25 -> 9 {-# LINE 1283 "Network/Socket.hsc" #-} {-# LINE 1284 "Network/Socket.hsc" #-} {-# LINE 1285 "Network/Socket.hsc" #-} AF_AX25 -> 3 {-# LINE 1286 "Network/Socket.hsc" #-} {-# LINE 1287 "Network/Socket.hsc" #-} {-# LINE 1290 "Network/Socket.hsc" #-} {-# LINE 1293 "Network/Socket.hsc" #-} {-# LINE 1294 "Network/Socket.hsc" #-} AF_IPX -> 4 {-# LINE 1295 "Network/Socket.hsc" #-} {-# LINE 1296 "Network/Socket.hsc" #-} {-# LINE 1299 "Network/Socket.hsc" #-} {-# LINE 1302 "Network/Socket.hsc" #-} {-# LINE 1305 "Network/Socket.hsc" #-} {-# LINE 1308 "Network/Socket.hsc" #-} {-# LINE 1311 "Network/Socket.hsc" #-} {-# LINE 1314 "Network/Socket.hsc" #-} {-# LINE 1317 "Network/Socket.hsc" #-} {-# LINE 1320 "Network/Socket.hsc" #-} {-# LINE 1323 "Network/Socket.hsc" #-} {-# LINE 1326 "Network/Socket.hsc" #-} {-# LINE 1329 "Network/Socket.hsc" #-} {-# LINE 1332 "Network/Socket.hsc" #-} {-# LINE 1333 "Network/Socket.hsc" #-} AF_ISDN -> 34 {-# LINE 1334 "Network/Socket.hsc" #-} {-# LINE 1335 "Network/Socket.hsc" #-} {-# LINE 1338 "Network/Socket.hsc" #-} {-# LINE 1341 "Network/Socket.hsc" #-} {-# LINE 1344 "Network/Socket.hsc" #-} {-# LINE 1347 "Network/Socket.hsc" #-} {-# LINE 1350 "Network/Socket.hsc" #-} {-# LINE 1353 "Network/Socket.hsc" #-} {-# LINE 1356 "Network/Socket.hsc" #-} {-# LINE 1359 "Network/Socket.hsc" #-} {-# LINE 1360 "Network/Socket.hsc" #-} AF_NETROM -> 6 {-# LINE 1361 "Network/Socket.hsc" #-} {-# LINE 1362 "Network/Socket.hsc" #-} {-# LINE 1363 "Network/Socket.hsc" #-} AF_BRIDGE -> 7 {-# LINE 1364 "Network/Socket.hsc" #-} {-# LINE 1365 "Network/Socket.hsc" #-} {-# LINE 1366 "Network/Socket.hsc" #-} AF_ATMPVC -> 8 {-# LINE 1367 "Network/Socket.hsc" #-} {-# LINE 1368 "Network/Socket.hsc" #-} {-# LINE 1369 "Network/Socket.hsc" #-} AF_ROSE -> 11 {-# LINE 1370 "Network/Socket.hsc" #-} {-# LINE 1371 "Network/Socket.hsc" #-} {-# LINE 1372 "Network/Socket.hsc" #-} AF_NETBEUI -> 13 {-# LINE 1373 "Network/Socket.hsc" #-} {-# LINE 1374 "Network/Socket.hsc" #-} {-# LINE 1375 "Network/Socket.hsc" #-} AF_SECURITY -> 14 {-# LINE 1376 "Network/Socket.hsc" #-} {-# LINE 1377 "Network/Socket.hsc" #-} {-# LINE 1378 "Network/Socket.hsc" #-} AF_PACKET -> 17 {-# LINE 1379 "Network/Socket.hsc" #-} {-# LINE 1380 "Network/Socket.hsc" #-} {-# LINE 1381 "Network/Socket.hsc" #-} AF_ASH -> 18 {-# LINE 1382 "Network/Socket.hsc" #-} {-# LINE 1383 "Network/Socket.hsc" #-} {-# LINE 1384 "Network/Socket.hsc" #-} AF_ECONET -> 19 {-# LINE 1385 "Network/Socket.hsc" #-} {-# LINE 1386 "Network/Socket.hsc" #-} {-# LINE 1387 "Network/Socket.hsc" #-} AF_ATMSVC -> 20 {-# LINE 1388 "Network/Socket.hsc" #-} {-# LINE 1389 "Network/Socket.hsc" #-} {-# LINE 1390 "Network/Socket.hsc" #-} AF_IRDA -> 23 {-# LINE 1391 "Network/Socket.hsc" #-} {-# LINE 1392 "Network/Socket.hsc" #-} {-# LINE 1393 "Network/Socket.hsc" #-} AF_PPPOX -> 24 {-# LINE 1394 "Network/Socket.hsc" #-} {-# LINE 1395 "Network/Socket.hsc" #-} {-# LINE 1396 "Network/Socket.hsc" #-} AF_WANPIPE -> 25 {-# LINE 1397 "Network/Socket.hsc" #-} {-# LINE 1398 "Network/Socket.hsc" #-} {-# LINE 1399 "Network/Socket.hsc" #-} AF_BLUETOOTH -> 31 {-# LINE 1400 "Network/Socket.hsc" #-} {-# LINE 1401 "Network/Socket.hsc" #-} --------- ---------- unpackFamily f = case f of (0) -> AF_UNSPEC {-# LINE 1406 "Network/Socket.hsc" #-} {-# LINE 1407 "Network/Socket.hsc" #-} (1) -> AF_UNIX {-# LINE 1408 "Network/Socket.hsc" #-} {-# LINE 1409 "Network/Socket.hsc" #-} {-# LINE 1410 "Network/Socket.hsc" #-} (2) -> AF_INET {-# LINE 1411 "Network/Socket.hsc" #-} {-# LINE 1412 "Network/Socket.hsc" #-} {-# LINE 1413 "Network/Socket.hsc" #-} (10) -> AF_INET6 {-# LINE 1414 "Network/Socket.hsc" #-} {-# LINE 1415 "Network/Socket.hsc" #-} {-# LINE 1418 "Network/Socket.hsc" #-} {-# LINE 1421 "Network/Socket.hsc" #-} {-# LINE 1424 "Network/Socket.hsc" #-} {-# LINE 1427 "Network/Socket.hsc" #-} {-# LINE 1430 "Network/Socket.hsc" #-} {-# LINE 1433 "Network/Socket.hsc" #-} {-# LINE 1436 "Network/Socket.hsc" #-} {-# LINE 1439 "Network/Socket.hsc" #-} {-# LINE 1440 "Network/Socket.hsc" #-} (22) -> AF_SNA {-# LINE 1441 "Network/Socket.hsc" #-} {-# LINE 1442 "Network/Socket.hsc" #-} {-# LINE 1443 "Network/Socket.hsc" #-} (12) -> AF_DECnet {-# LINE 1444 "Network/Socket.hsc" #-} {-# LINE 1445 "Network/Socket.hsc" #-} {-# LINE 1448 "Network/Socket.hsc" #-} {-# LINE 1451 "Network/Socket.hsc" #-} {-# LINE 1454 "Network/Socket.hsc" #-} {-# LINE 1455 "Network/Socket.hsc" #-} (5) -> AF_APPLETALK {-# LINE 1456 "Network/Socket.hsc" #-} {-# LINE 1457 "Network/Socket.hsc" #-} {-# LINE 1458 "Network/Socket.hsc" #-} (16) -> AF_ROUTE {-# LINE 1459 "Network/Socket.hsc" #-} {-# LINE 1460 "Network/Socket.hsc" #-} {-# LINE 1463 "Network/Socket.hsc" #-} {-# LINE 1466 "Network/Socket.hsc" #-} {-# LINE 1469 "Network/Socket.hsc" #-} {-# LINE 1472 "Network/Socket.hsc" #-} {-# LINE 1477 "Network/Socket.hsc" #-} {-# LINE 1480 "Network/Socket.hsc" #-} {-# LINE 1481 "Network/Socket.hsc" #-} (9) -> AF_X25 {-# LINE 1482 "Network/Socket.hsc" #-} {-# LINE 1483 "Network/Socket.hsc" #-} {-# LINE 1484 "Network/Socket.hsc" #-} (3) -> AF_AX25 {-# LINE 1485 "Network/Socket.hsc" #-} {-# LINE 1486 "Network/Socket.hsc" #-} {-# LINE 1489 "Network/Socket.hsc" #-} {-# LINE 1492 "Network/Socket.hsc" #-} {-# LINE 1493 "Network/Socket.hsc" #-} (4) -> AF_IPX {-# LINE 1494 "Network/Socket.hsc" #-} {-# LINE 1495 "Network/Socket.hsc" #-} {-# LINE 1498 "Network/Socket.hsc" #-} {-# LINE 1501 "Network/Socket.hsc" #-} {-# LINE 1504 "Network/Socket.hsc" #-} {-# LINE 1507 "Network/Socket.hsc" #-} {-# LINE 1510 "Network/Socket.hsc" #-} {-# LINE 1513 "Network/Socket.hsc" #-} {-# LINE 1516 "Network/Socket.hsc" #-} {-# LINE 1519 "Network/Socket.hsc" #-} {-# LINE 1522 "Network/Socket.hsc" #-} {-# LINE 1525 "Network/Socket.hsc" #-} {-# LINE 1528 "Network/Socket.hsc" #-} {-# LINE 1531 "Network/Socket.hsc" #-} {-# LINE 1532 "Network/Socket.hsc" #-} (34) -> AF_ISDN {-# LINE 1533 "Network/Socket.hsc" #-} {-# LINE 1534 "Network/Socket.hsc" #-} {-# LINE 1537 "Network/Socket.hsc" #-} {-# LINE 1540 "Network/Socket.hsc" #-} {-# LINE 1543 "Network/Socket.hsc" #-} {-# LINE 1546 "Network/Socket.hsc" #-} {-# LINE 1549 "Network/Socket.hsc" #-} {-# LINE 1552 "Network/Socket.hsc" #-} {-# LINE 1555 "Network/Socket.hsc" #-} {-# LINE 1558 "Network/Socket.hsc" #-} {-# LINE 1559 "Network/Socket.hsc" #-} (6) -> AF_NETROM {-# LINE 1560 "Network/Socket.hsc" #-} {-# LINE 1561 "Network/Socket.hsc" #-} {-# LINE 1562 "Network/Socket.hsc" #-} (7) -> AF_BRIDGE {-# LINE 1563 "Network/Socket.hsc" #-} {-# LINE 1564 "Network/Socket.hsc" #-} {-# LINE 1565 "Network/Socket.hsc" #-} (8) -> AF_ATMPVC {-# LINE 1566 "Network/Socket.hsc" #-} {-# LINE 1567 "Network/Socket.hsc" #-} {-# LINE 1568 "Network/Socket.hsc" #-} (11) -> AF_ROSE {-# LINE 1569 "Network/Socket.hsc" #-} {-# LINE 1570 "Network/Socket.hsc" #-} {-# LINE 1571 "Network/Socket.hsc" #-} (13) -> AF_NETBEUI {-# LINE 1572 "Network/Socket.hsc" #-} {-# LINE 1573 "Network/Socket.hsc" #-} {-# LINE 1574 "Network/Socket.hsc" #-} (14) -> AF_SECURITY {-# LINE 1575 "Network/Socket.hsc" #-} {-# LINE 1576 "Network/Socket.hsc" #-} {-# LINE 1577 "Network/Socket.hsc" #-} (17) -> AF_PACKET {-# LINE 1578 "Network/Socket.hsc" #-} {-# LINE 1579 "Network/Socket.hsc" #-} {-# LINE 1580 "Network/Socket.hsc" #-} (18) -> AF_ASH {-# LINE 1581 "Network/Socket.hsc" #-} {-# LINE 1582 "Network/Socket.hsc" #-} {-# LINE 1583 "Network/Socket.hsc" #-} (19) -> AF_ECONET {-# LINE 1584 "Network/Socket.hsc" #-} {-# LINE 1585 "Network/Socket.hsc" #-} {-# LINE 1586 "Network/Socket.hsc" #-} (20) -> AF_ATMSVC {-# LINE 1587 "Network/Socket.hsc" #-} {-# LINE 1588 "Network/Socket.hsc" #-} {-# LINE 1589 "Network/Socket.hsc" #-} (23) -> AF_IRDA {-# LINE 1590 "Network/Socket.hsc" #-} {-# LINE 1591 "Network/Socket.hsc" #-} {-# LINE 1592 "Network/Socket.hsc" #-} (24) -> AF_PPPOX {-# LINE 1593 "Network/Socket.hsc" #-} {-# LINE 1594 "Network/Socket.hsc" #-} {-# LINE 1595 "Network/Socket.hsc" #-} (25) -> AF_WANPIPE {-# LINE 1596 "Network/Socket.hsc" #-} {-# LINE 1597 "Network/Socket.hsc" #-} {-# LINE 1598 "Network/Socket.hsc" #-} (31) -> AF_BLUETOOTH {-# LINE 1599 "Network/Socket.hsc" #-} {-# LINE 1600 "Network/Socket.hsc" #-} unknown -> error ("Network.Socket.unpackFamily: unknown address " ++ "family " ++ show unknown) -- Socket Types. -- | Socket Types. -- -- This data type might have different constructors depending on what is -- supported by the operating system. data SocketType = NoSocketType {-# LINE 1612 "Network/Socket.hsc" #-} | Stream {-# LINE 1614 "Network/Socket.hsc" #-} {-# LINE 1615 "Network/Socket.hsc" #-} | Datagram {-# LINE 1617 "Network/Socket.hsc" #-} {-# LINE 1618 "Network/Socket.hsc" #-} | Raw {-# LINE 1620 "Network/Socket.hsc" #-} {-# LINE 1621 "Network/Socket.hsc" #-} | RDM {-# LINE 1623 "Network/Socket.hsc" #-} {-# LINE 1624 "Network/Socket.hsc" #-} | SeqPacket {-# LINE 1626 "Network/Socket.hsc" #-} deriving (Eq, Ord, Read, Show, Typeable) packSocketType stype = case stype of NoSocketType -> 0 {-# LINE 1631 "Network/Socket.hsc" #-} Stream -> 1 {-# LINE 1632 "Network/Socket.hsc" #-} {-# LINE 1633 "Network/Socket.hsc" #-} {-# LINE 1634 "Network/Socket.hsc" #-} Datagram -> 2 {-# LINE 1635 "Network/Socket.hsc" #-} {-# LINE 1636 "Network/Socket.hsc" #-} {-# LINE 1637 "Network/Socket.hsc" #-} Raw -> 3 {-# LINE 1638 "Network/Socket.hsc" #-} {-# LINE 1639 "Network/Socket.hsc" #-} {-# LINE 1640 "Network/Socket.hsc" #-} RDM -> 4 {-# LINE 1641 "Network/Socket.hsc" #-} {-# LINE 1642 "Network/Socket.hsc" #-} {-# LINE 1643 "Network/Socket.hsc" #-} SeqPacket -> 5 {-# LINE 1644 "Network/Socket.hsc" #-} {-# LINE 1645 "Network/Socket.hsc" #-} unpackSocketType t = case t of 0 -> NoSocketType {-# LINE 1649 "Network/Socket.hsc" #-} (1) -> Stream {-# LINE 1650 "Network/Socket.hsc" #-} {-# LINE 1651 "Network/Socket.hsc" #-} {-# LINE 1652 "Network/Socket.hsc" #-} (2) -> Datagram {-# LINE 1653 "Network/Socket.hsc" #-} {-# LINE 1654 "Network/Socket.hsc" #-} {-# LINE 1655 "Network/Socket.hsc" #-} (3) -> Raw {-# LINE 1656 "Network/Socket.hsc" #-} {-# LINE 1657 "Network/Socket.hsc" #-} {-# LINE 1658 "Network/Socket.hsc" #-} (4) -> RDM {-# LINE 1659 "Network/Socket.hsc" #-} {-# LINE 1660 "Network/Socket.hsc" #-} {-# LINE 1661 "Network/Socket.hsc" #-} (5) -> SeqPacket {-# LINE 1662 "Network/Socket.hsc" #-} {-# LINE 1663 "Network/Socket.hsc" #-} _ -> NoSocketType -- --------------------------------------------------------------------------- -- Utility Functions aNY_PORT :: PortNumber aNY_PORT = 0 -- | The IPv4 wild card address. iNADDR_ANY :: HostAddress iNADDR_ANY = htonl (0) {-# LINE 1675 "Network/Socket.hsc" #-} {-# LINE 1677 "Network/Socket.hsc" #-} -- | The IPv6 wild card address. iN6ADDR_ANY :: HostAddress6 iN6ADDR_ANY = (0, 0, 0, 0) {-# LINE 1682 "Network/Socket.hsc" #-} sOMAXCONN :: Int sOMAXCONN = 128 {-# LINE 1685 "Network/Socket.hsc" #-} sOL_SOCKET :: Int sOL_SOCKET = 1 {-# LINE 1688 "Network/Socket.hsc" #-} {-# LINE 1690 "Network/Socket.hsc" #-} sCM_RIGHTS :: Int sCM_RIGHTS = 1 {-# LINE 1692 "Network/Socket.hsc" #-} {-# LINE 1693 "Network/Socket.hsc" #-} 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 "shutdown" (c_shutdown s (sdownCmdToInt stype)) return () -- ----------------------------------------------------------------------------- -- | Close the socket. All future operations on the socket object -- will fail. The remote end will receive no more data (after queued -- data is flushed). sClose :: Socket -> IO () sClose (MkSocket s _ _ _ socketStatus) = do modifyMVar_ socketStatus $ \ status -> case status of ConvertedToHandle -> ioError (userError ("sClose: converted to a Handle, use hClose instead")) Closed -> return status _ -> closeFdWith (close . fromIntegral) (fromIntegral s) >> return Closed -- ----------------------------------------------------------------------------- sIsConnected :: Socket -> IO Bool sIsConnected (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Connected) -- ----------------------------------------------------------------------------- -- Socket Predicates sIsBound :: Socket -> IO Bool sIsBound (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Bound) sIsListening :: Socket -> IO Bool sIsListening (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening) sIsReadable :: Socket -> IO Bool sIsReadable (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Listening || value == Connected) sIsWritable :: Socket -> IO Bool sIsWritable = sIsReadable -- sort of. sIsAcceptable :: Socket -> IO Bool {-# LINE 1765 "Network/Socket.hsc" #-} sIsAcceptable (MkSocket _ AF_UNIX x _ status) | x == Stream || x == SeqPacket = do value <- readMVar status return (value == Connected || value == Bound || value == Listening) sIsAcceptable (MkSocket _ AF_UNIX _ _ _) = return False {-# LINE 1771 "Network/Socket.hsc" #-} sIsAcceptable (MkSocket _ _ _ _ status) = do value <- readMVar status return (value == Connected || value == Listening) -- ----------------------------------------------------------------------------- -- Internet address manipulation routines: inet_addr :: String -> IO HostAddress inet_addr ipstr = do withCString ipstr $ \str -> do had <- c_inet_addr str if had == -1 then ioError (userError ("inet_addr: Malformed address: " ++ ipstr)) else return had -- network byte order inet_ntoa :: HostAddress -> IO String inet_ntoa haddr = 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'. {-# LINE 1801 "Network/Socket.hsc" #-} 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 {-# LINE 1808 "Network/Socket.hsc" #-} h <- fdToHandle' (fromIntegral fd) (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-} {-# LINE 1816 "Network/Socket.hsc" #-} return (ConvertedToHandle, h) {-# LINE 1821 "Network/Socket.hsc" #-} -- | 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 {-# LINE 1849 "Network/Socket.hsc" #-} -- | Flags that control the querying behaviour of 'getAddrInfo'. data AddrInfoFlag = AI_ADDRCONFIG | AI_ALL | AI_CANONNAME | AI_NUMERICHOST | AI_NUMERICSERV | AI_PASSIVE | AI_V4MAPPED deriving (Eq, Read, Show, Typeable) aiFlagMapping :: [(AddrInfoFlag, CInt)] aiFlagMapping = [ {-# LINE 1866 "Network/Socket.hsc" #-} (AI_ADDRCONFIG, 32), {-# LINE 1867 "Network/Socket.hsc" #-} {-# LINE 1870 "Network/Socket.hsc" #-} {-# LINE 1871 "Network/Socket.hsc" #-} (AI_ALL, 16), {-# LINE 1872 "Network/Socket.hsc" #-} {-# LINE 1875 "Network/Socket.hsc" #-} (AI_CANONNAME, 2), {-# LINE 1876 "Network/Socket.hsc" #-} (AI_NUMERICHOST, 4), {-# LINE 1877 "Network/Socket.hsc" #-} {-# LINE 1878 "Network/Socket.hsc" #-} (AI_NUMERICSERV, 1024), {-# LINE 1879 "Network/Socket.hsc" #-} {-# LINE 1882 "Network/Socket.hsc" #-} (AI_PASSIVE, 1), {-# LINE 1883 "Network/Socket.hsc" #-} {-# LINE 1884 "Network/Socket.hsc" #-} (AI_V4MAPPED, 8) {-# LINE 1885 "Network/Socket.hsc" #-} {-# LINE 1888 "Network/Socket.hsc" #-} ] -- | 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 _ = 32 {-# LINE 1908 "Network/Socket.hsc" #-} alignment _ = alignment (undefined :: CInt) peek p = do ai_flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p {-# LINE 1912 "Network/Socket.hsc" #-} ai_family <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p {-# LINE 1913 "Network/Socket.hsc" #-} ai_socktype <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p {-# LINE 1914 "Network/Socket.hsc" #-} ai_protocol <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p {-# LINE 1915 "Network/Socket.hsc" #-} ai_addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p >>= peekSockAddr {-# LINE 1916 "Network/Socket.hsc" #-} ai_canonname_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p {-# LINE 1917 "Network/Socket.hsc" #-} ai_canonname <- if ai_canonname_ptr == nullPtr then return Nothing else liftM Just $ peekCString ai_canonname_ptr return (AddrInfo { addrFlags = unpackBits aiFlagMapping ai_flags, addrFamily = unpackFamily ai_family, addrSocketType = unpackSocketType ai_socktype, addrProtocol = ai_protocol, addrAddress = ai_addr, addrCanonName = ai_canonname }) poke p (AddrInfo flags family socketType protocol _ _) = do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (packBits aiFlagMapping flags) {-# LINE 1934 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p (packFamily family) {-# LINE 1935 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (packSocketType socketType) {-# LINE 1936 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p protocol {-# LINE 1937 "Network/Socket.hsc" #-} -- stuff below is probably not needed, but let's zero it for safety ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p (0::CSize) {-# LINE 1941 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) p nullPtr {-# LINE 1942 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p nullPtr {-# LINE 1943 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) p nullPtr {-# LINE 1944 "Network/Socket.hsc" #-} data NameInfoFlag = NI_DGRAM | NI_NAMEREQD | NI_NOFQDN | NI_NUMERICHOST | NI_NUMERICSERV deriving (Eq, Read, Show, Typeable) niFlagMapping :: [(NameInfoFlag, CInt)] niFlagMapping = [(NI_DGRAM, 16), {-# LINE 1956 "Network/Socket.hsc" #-} (NI_NAMEREQD, 8), {-# LINE 1957 "Network/Socket.hsc" #-} (NI_NOFQDN, 4), {-# LINE 1958 "Network/Socket.hsc" #-} (NI_NUMERICHOST, 1), {-# LINE 1959 "Network/Socket.hsc" #-} (NI_NUMERICSERV, 2)] {-# LINE 1960 "Network/Socket.hsc" #-} -- | Default hints for address lookup with 'getAddrInfo'. The values -- of the 'addrAddress' and 'addrCanonName' fields are 'undefined', -- and are never inspected by 'getAddrInfo'. defaultHints :: AddrInfo defaultHints = AddrInfo { addrFlags = [], addrFamily = AF_UNSPEC, addrSocketType = NoSocketType, addrProtocol = defaultProtocol, addrAddress = undefined, addrCanonName = 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 -- 'bindSocket'. -- -- 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: -- -- @ -- myHints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] } -- @ -- -- Values for 'addrFlags' control query behaviour. The supported -- flags are as follows: -- -- [@AI_PASSIVE@] If no 'HostName' value is provided, the network -- address in each 'SockAddr' -- will be left as a "wild card", i.e. as either 'iNADDR_ANY' -- or 'iN6ADDR_ANY'. This is useful for server applications that -- will accept connections from any client. -- -- [@AI_CANONNAME@] The 'addrCanonName' field of the first returned -- 'AddrInfo' will contain the "canonical name" of the host. -- -- [@AI_NUMERICHOST@] The 'HostName' argument /must/ be a numeric -- address in string form, and network name lookups will not be -- attempted. -- -- /Note/: Although the following flags are required by RFC 3493, they -- may not have an effect on all platforms, because the underlying -- network stack may not support them. To see whether a flag from the -- list below will have any effect, call 'addrInfoFlagImplemented'. -- -- [@AI_NUMERICSERV@] The 'ServiceName' argument /must/ be a port -- number in string form, and service name lookups will not be -- attempted. -- -- [@AI_ADDRCONFIG@] 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. -- -- [@AI_V4MAPPED@] If an IPv6 lookup is performed, and no IPv6 -- addresses are found, IPv6-mapped IPv4 addresses will be -- returned. -- -- [@AI_ALL@] If 'AI_ALL' is specified, return all matching IPv6 and -- IPv4 addresses. Otherwise, this flag has no effect. -- -- 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. -- -- Example: -- @ -- let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] } -- addrs <- getAddrInfo (Just hints) (Just "www.haskell.org") (Just "http") -- let addr = head addrs -- sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) -- connect sock (addrAddress addr) -- @ 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 = maybeWith withCString node $ \c_node -> maybeWith withCString service $ \c_service -> maybeWith with hints $ \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 ioError (ioeSetErrorString (mkIOError NoSuchThing "getAddrInfo" Nothing Nothing) err) followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo] followAddrInfo ptr_ai | ptr_ai == nullPtr = return [] | otherwise = do a <- peek ptr_ai as <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr_ai >>= followAddrInfo {-# LINE 2086 "Network/Socket.hsc" #-} 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 {-# LINE 2098 "Network/Socket.hsc" #-} gai_strerror n = c_gai_strerror n >>= peekCString foreign import ccall safe "gai_strerror" c_gai_strerror :: CInt -> IO CString {-# LINE 2105 "Network/Socket.hsc" #-} 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. The -- supported flags are as follows: -- -- [@NI_NOFQDN@] If a host is local, return only the -- hostname part of the FQDN. -- -- [@NI_NUMERICHOST@] 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_NUMERICSERV@] The name of the service is not -- looked up. Instead, a numeric representation of the -- service is returned. -- -- [@NI_NAMEREQD@] If the hostname cannot be looked up, an IO error -- is thrown. -- -- [@NI_DGRAM@] 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. -- -- Hostname and service name lookups can be expensive. You can -- specify which lookups to perform via the two 'Bool' arguments. If -- one of these is 'False', the corresponding value in the returned -- tuple will be 'Nothing', and no lookup will be performed. -- -- 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 = withCStringIf doHost (1025) $ \c_hostlen c_host -> {-# LINE 2160 "Network/Socket.hsc" #-} withCStringIf doService (32) $ \c_servlen c_serv -> do {-# LINE 2161 "Network/Socket.hsc" #-} 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 ioError (ioeSetErrorString (mkIOError NoSuchThing "getNameInfo" Nothing Nothing) err) foreign import ccall safe "hsnet_getnameinfo" c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString -> CSize -> CInt -> IO CInt {-# LINE 2181 "Network/Socket.hsc" #-} mkInvalidRecvArgError :: String -> IOError mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError {-# LINE 2185 "Network/Socket.hsc" #-} InvalidArgument {-# LINE 2189 "Network/Socket.hsc" #-} 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 "my_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 close :: CInt -> IO () close fd = throwErrnoIfMinus1Retry_ "Network.Socket.close" $ c_close fd {-# LINE 2210 "Network/Socket.hsc" #-} foreign import ccall unsafe "close" c_close :: CInt -> IO CInt {-# LINE 2216 "Network/Socket.hsc" #-} 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 unsafe "connect" c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt foreign import CALLCONV unsafe "accept" c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt {-# LINE 2226 "Network/Socket.hsc" #-} foreign import CALLCONV unsafe "accept4" c_accept4 :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt {-# LINE 2229 "Network/Socket.hsc" #-} foreign import CALLCONV unsafe "listen" c_listen :: CInt -> CInt -> IO CInt {-# LINE 2238 "Network/Socket.hsc" #-} 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