{-# LINE 1 "Network/Socket.hsc" #-} {-# LANGUAGE CPP #-} {-# LINE 2 "Network/Socket.hsc" #-} ----------------------------------------------------------------------------- -- | -- 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 23 "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 39 "Network/Socket.hsc" #-} , HostAddress6 , FlowInfo , ScopeID {-# LINE 43 "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 56 "Network/Socket.hsc" #-} , AddrInfo(..) , AddrInfoFlag(..) , addrInfoFlagImplemented , defaultHints , getAddrInfo , NameInfoFlag(..) , getNameInfo {-# LINE 69 "Network/Socket.hsc" #-} -- * Socket operations , socket {-# LINE 73 "Network/Socket.hsc" #-} , socketPair {-# LINE 75 "Network/Socket.hsc" #-} , connect , bindSocket , listen , accept , getPeerName , getSocketName {-# LINE 83 "Network/Socket.hsc" #-} -- get the credentials of our domain socket peer. , getPeerCred {-# LINE 86 "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 123 "Network/Socket.hsc" #-} , sendFd , recvFd -- Note: these two will disappear shortly , sendAncillary , recvAncillary {-# LINE 131 "Network/Socket.hsc" #-} -- * Special constants , aNY_PORT , iNADDR_ANY {-# LINE 136 "Network/Socket.hsc" #-} , iN6ADDR_ANY {-# LINE 138 "Network/Socket.hsc" #-} , sOMAXCONN , sOL_SOCKET {-# LINE 141 "Network/Socket.hsc" #-} , sCM_RIGHTS {-# LINE 143 "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 176 "Network/Socket.hsc" #-} import Data.Bits import Data.List (foldl') import Data.Word (Word8, Word16, Word32) import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr) import Foreign.Storable (Storable(..)) import Foreign.C.Error import Foreign.C.String (CString, withCString, peekCString, peekCStringLen, castCharToCChar) 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, pokeArray, pokeArray0 ) import Foreign.Marshal.Utils ( maybeWith, with ) import System.IO import Control.Monad (liftM, when) import Data.Ratio ((%)) import qualified Control.Exception 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" #-} when (family == AF_INET6) $ setSocketOption sock IPv6Only 0 {-# LINE 429 "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 436 "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 <- mkSocket fd1 s2 <- mkSocket fd2 return (s1,s2) where mkSocket fd = do {-# LINE 453 "Network/Socket.hsc" #-} {-# LINE 456 "Network/Socket.hsc" #-} System.Posix.Internals.setNonBlockingFD fd True {-# LINE 458 "Network/Socket.hsc" #-} {-# LINE 459 "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 465 "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 509 "Network/Socket.hsc" #-} err <- getErrno case () of _ | err == eINTR -> connectLoop _ | err == eINPROGRESS -> connectBlocked -- _ | err == eAGAIN -> connectBlocked otherwise -> throwSocketError "connect" {-# LINE 526 "Network/Socket.hsc" #-} else return r connectBlocked = do {-# LINE 530 "Network/Socket.hsc" #-} threadWaitWrite (fromIntegral s) {-# LINE 532 "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 604 "Network/Socket.hsc" #-} with (fromIntegral sz) $ \ ptr_len -> do new_sock <- {-# LINE 607 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "accept" (threadWaitRead (fromIntegral s)) {-# LINE 610 "Network/Socket.hsc" #-} (c_accept s sockaddr ptr_len) {-# LINE 612 "Network/Socket.hsc" #-} {-# LINE 615 "Network/Socket.hsc" #-} System.Posix.Internals.setNonBlockingFD new_sock True {-# LINE 617 "Network/Socket.hsc" #-} {-# LINE 618 "Network/Socket.hsc" #-} {-# LINE 619 "Network/Socket.hsc" #-} addr <- peekSockAddr sockaddr new_status <- newMVar Connected return ((MkSocket new_sock family stype protocol new_status), addr) {-# LINE 633 "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 675 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "sendTo" (threadWaitWrite (fromIntegral s)) $ {-# LINE 678 "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 713 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "recvFrom" (threadWaitRead (fromIntegral s)) $ {-# LINE 716 "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 765 "Network/Socket.hsc" #-} {-# LINE 766 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "send" (threadWaitWrite (fromIntegral s)) $ {-# LINE 769 "Network/Socket.hsc" #-} c_send s str (fromIntegral len) 0{-flags-} {-# LINE 771 "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 801 "Network/Socket.hsc" #-} {-# LINE 802 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "recv" (threadWaitRead (fromIntegral s)) $ {-# LINE 805 "Network/Socket.hsc" #-} c_recv s ptr (fromIntegral nbytes) 0{-flags-} {-# LINE 807 "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 827 "Network/Socket.hsc" #-} socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do (SockAddrInet6 port _ _ _) <- getSocketName sock return port {-# LINE 831 "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 865 "Network/Socket.hsc" #-} | Debug {- SO_DEBUG -} {-# LINE 867 "Network/Socket.hsc" #-} {-# LINE 868 "Network/Socket.hsc" #-} | ReuseAddr {- SO_REUSEADDR -} {-# LINE 870 "Network/Socket.hsc" #-} {-# LINE 871 "Network/Socket.hsc" #-} | Type {- SO_TYPE -} {-# LINE 873 "Network/Socket.hsc" #-} {-# LINE 874 "Network/Socket.hsc" #-} | SoError {- SO_ERROR -} {-# LINE 876 "Network/Socket.hsc" #-} {-# LINE 877 "Network/Socket.hsc" #-} | DontRoute {- SO_DONTROUTE -} {-# LINE 879 "Network/Socket.hsc" #-} {-# LINE 880 "Network/Socket.hsc" #-} | Broadcast {- SO_BROADCAST -} {-# LINE 882 "Network/Socket.hsc" #-} {-# LINE 883 "Network/Socket.hsc" #-} | SendBuffer {- SO_SNDBUF -} {-# LINE 885 "Network/Socket.hsc" #-} {-# LINE 886 "Network/Socket.hsc" #-} | RecvBuffer {- SO_RCVBUF -} {-# LINE 888 "Network/Socket.hsc" #-} {-# LINE 889 "Network/Socket.hsc" #-} | KeepAlive {- SO_KEEPALIVE -} {-# LINE 891 "Network/Socket.hsc" #-} {-# LINE 892 "Network/Socket.hsc" #-} | OOBInline {- SO_OOBINLINE -} {-# LINE 894 "Network/Socket.hsc" #-} {-# LINE 895 "Network/Socket.hsc" #-} | TimeToLive {- IP_TTL -} {-# LINE 897 "Network/Socket.hsc" #-} {-# LINE 898 "Network/Socket.hsc" #-} | MaxSegment {- TCP_MAXSEG -} {-# LINE 900 "Network/Socket.hsc" #-} {-# LINE 901 "Network/Socket.hsc" #-} | NoDelay {- TCP_NODELAY -} {-# LINE 903 "Network/Socket.hsc" #-} {-# LINE 904 "Network/Socket.hsc" #-} | Linger {- SO_LINGER -} {-# LINE 906 "Network/Socket.hsc" #-} {-# LINE 909 "Network/Socket.hsc" #-} {-# LINE 910 "Network/Socket.hsc" #-} | RecvLowWater {- SO_RCVLOWAT -} {-# LINE 912 "Network/Socket.hsc" #-} {-# LINE 913 "Network/Socket.hsc" #-} | SendLowWater {- SO_SNDLOWAT -} {-# LINE 915 "Network/Socket.hsc" #-} {-# LINE 916 "Network/Socket.hsc" #-} | RecvTimeOut {- SO_RCVTIMEO -} {-# LINE 918 "Network/Socket.hsc" #-} {-# LINE 919 "Network/Socket.hsc" #-} | SendTimeOut {- SO_SNDTIMEO -} {-# LINE 921 "Network/Socket.hsc" #-} {-# LINE 924 "Network/Socket.hsc" #-} {-# LINE 925 "Network/Socket.hsc" #-} | IPv6Only {- IPV6_V6ONLY -} {-# LINE 927 "Network/Socket.hsc" #-} deriving Typeable socketOptLevel :: SocketOption -> CInt socketOptLevel so = case so of {-# LINE 933 "Network/Socket.hsc" #-} TimeToLive -> 0 {-# LINE 934 "Network/Socket.hsc" #-} {-# LINE 935 "Network/Socket.hsc" #-} {-# LINE 936 "Network/Socket.hsc" #-} MaxSegment -> 6 {-# LINE 937 "Network/Socket.hsc" #-} {-# LINE 938 "Network/Socket.hsc" #-} {-# LINE 939 "Network/Socket.hsc" #-} NoDelay -> 6 {-# LINE 940 "Network/Socket.hsc" #-} {-# LINE 941 "Network/Socket.hsc" #-} {-# LINE 942 "Network/Socket.hsc" #-} IPv6Only -> 41 {-# LINE 943 "Network/Socket.hsc" #-} {-# LINE 944 "Network/Socket.hsc" #-} _ -> 1 {-# LINE 945 "Network/Socket.hsc" #-} packSocketOption :: SocketOption -> CInt packSocketOption so = case so of {-# LINE 950 "Network/Socket.hsc" #-} Debug -> 1 {-# LINE 951 "Network/Socket.hsc" #-} {-# LINE 952 "Network/Socket.hsc" #-} {-# LINE 953 "Network/Socket.hsc" #-} ReuseAddr -> 2 {-# LINE 954 "Network/Socket.hsc" #-} {-# LINE 955 "Network/Socket.hsc" #-} {-# LINE 956 "Network/Socket.hsc" #-} Type -> 3 {-# LINE 957 "Network/Socket.hsc" #-} {-# LINE 958 "Network/Socket.hsc" #-} {-# LINE 959 "Network/Socket.hsc" #-} SoError -> 4 {-# LINE 960 "Network/Socket.hsc" #-} {-# LINE 961 "Network/Socket.hsc" #-} {-# LINE 962 "Network/Socket.hsc" #-} DontRoute -> 5 {-# LINE 963 "Network/Socket.hsc" #-} {-# LINE 964 "Network/Socket.hsc" #-} {-# LINE 965 "Network/Socket.hsc" #-} Broadcast -> 6 {-# LINE 966 "Network/Socket.hsc" #-} {-# LINE 967 "Network/Socket.hsc" #-} {-# LINE 968 "Network/Socket.hsc" #-} SendBuffer -> 7 {-# LINE 969 "Network/Socket.hsc" #-} {-# LINE 970 "Network/Socket.hsc" #-} {-# LINE 971 "Network/Socket.hsc" #-} RecvBuffer -> 8 {-# LINE 972 "Network/Socket.hsc" #-} {-# LINE 973 "Network/Socket.hsc" #-} {-# LINE 974 "Network/Socket.hsc" #-} KeepAlive -> 9 {-# LINE 975 "Network/Socket.hsc" #-} {-# LINE 976 "Network/Socket.hsc" #-} {-# LINE 977 "Network/Socket.hsc" #-} OOBInline -> 10 {-# LINE 978 "Network/Socket.hsc" #-} {-# LINE 979 "Network/Socket.hsc" #-} {-# LINE 980 "Network/Socket.hsc" #-} TimeToLive -> 2 {-# LINE 981 "Network/Socket.hsc" #-} {-# LINE 982 "Network/Socket.hsc" #-} {-# LINE 983 "Network/Socket.hsc" #-} MaxSegment -> 2 {-# LINE 984 "Network/Socket.hsc" #-} {-# LINE 985 "Network/Socket.hsc" #-} {-# LINE 986 "Network/Socket.hsc" #-} NoDelay -> 1 {-# LINE 987 "Network/Socket.hsc" #-} {-# LINE 988 "Network/Socket.hsc" #-} {-# LINE 989 "Network/Socket.hsc" #-} Linger -> 13 {-# LINE 990 "Network/Socket.hsc" #-} {-# LINE 991 "Network/Socket.hsc" #-} {-# LINE 994 "Network/Socket.hsc" #-} {-# LINE 995 "Network/Socket.hsc" #-} RecvLowWater -> 18 {-# LINE 996 "Network/Socket.hsc" #-} {-# LINE 997 "Network/Socket.hsc" #-} {-# LINE 998 "Network/Socket.hsc" #-} SendLowWater -> 19 {-# LINE 999 "Network/Socket.hsc" #-} {-# LINE 1000 "Network/Socket.hsc" #-} {-# LINE 1001 "Network/Socket.hsc" #-} RecvTimeOut -> 20 {-# LINE 1002 "Network/Socket.hsc" #-} {-# LINE 1003 "Network/Socket.hsc" #-} {-# LINE 1004 "Network/Socket.hsc" #-} SendTimeOut -> 21 {-# LINE 1005 "Network/Socket.hsc" #-} {-# LINE 1006 "Network/Socket.hsc" #-} {-# LINE 1009 "Network/Socket.hsc" #-} {-# LINE 1010 "Network/Socket.hsc" #-} IPv6Only -> 26 {-# LINE 1011 "Network/Socket.hsc" #-} {-# LINE 1012 "Network/Socket.hsc" #-} 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 1037 "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 1044 "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 1049 "Network/Socket.hsc" #-} pid <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr_cr {-# LINE 1050 "Network/Socket.hsc" #-} uid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr_cr {-# LINE 1051 "Network/Socket.hsc" #-} gid <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr_cr {-# LINE 1052 "Network/Socket.hsc" #-} return (pid, uid, gid) {-# LINE 1054 "Network/Socket.hsc" #-} #if !(MIN_VERSION_base(4,3,1)) closeFdWith closer fd = closer fd #endif {-# LINE 1060 "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 1066 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "sendFd" (threadWaitWrite (fromIntegral fd)) $ c_sendFd fd outfd {-# LINE 1072 "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 1081 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "recvFd" (threadWaitRead (fromIntegral fd)) $ {-# LINE 1084 "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 1099 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "sendAncillary" (threadWaitWrite (fromIntegral fd)) $ {-# LINE 1102 "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 1119 "Network/Socket.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock "recvAncillary" (threadWaitRead (fromIntegral fd)) $ {-# LINE 1122 "Network/Socket.hsc" #-} c_recvAncillary fd ptr_lev ptr_ty (fromIntegral flags) ptr_pData ptr_len len <- 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, len) 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 1138 "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 1185 "Network/Socket.hsc" #-} {-# LINE 1186 "Network/Socket.hsc" #-} AF_UNIX -> 1 {-# LINE 1187 "Network/Socket.hsc" #-} {-# LINE 1188 "Network/Socket.hsc" #-} {-# LINE 1189 "Network/Socket.hsc" #-} AF_INET -> 2 {-# LINE 1190 "Network/Socket.hsc" #-} {-# LINE 1191 "Network/Socket.hsc" #-} {-# LINE 1192 "Network/Socket.hsc" #-} AF_INET6 -> 10 {-# LINE 1193 "Network/Socket.hsc" #-} {-# LINE 1194 "Network/Socket.hsc" #-} {-# LINE 1197 "Network/Socket.hsc" #-} {-# LINE 1200 "Network/Socket.hsc" #-} {-# LINE 1203 "Network/Socket.hsc" #-} {-# LINE 1206 "Network/Socket.hsc" #-} {-# LINE 1209 "Network/Socket.hsc" #-} {-# LINE 1212 "Network/Socket.hsc" #-} {-# LINE 1215 "Network/Socket.hsc" #-} {-# LINE 1218 "Network/Socket.hsc" #-} {-# LINE 1219 "Network/Socket.hsc" #-} AF_SNA -> 22 {-# LINE 1220 "Network/Socket.hsc" #-} {-# LINE 1221 "Network/Socket.hsc" #-} {-# LINE 1222 "Network/Socket.hsc" #-} AF_DECnet -> 12 {-# LINE 1223 "Network/Socket.hsc" #-} {-# LINE 1224 "Network/Socket.hsc" #-} {-# LINE 1227 "Network/Socket.hsc" #-} {-# LINE 1230 "Network/Socket.hsc" #-} {-# LINE 1233 "Network/Socket.hsc" #-} {-# LINE 1234 "Network/Socket.hsc" #-} AF_APPLETALK -> 5 {-# LINE 1235 "Network/Socket.hsc" #-} {-# LINE 1236 "Network/Socket.hsc" #-} {-# LINE 1237 "Network/Socket.hsc" #-} AF_ROUTE -> 16 {-# LINE 1238 "Network/Socket.hsc" #-} {-# LINE 1239 "Network/Socket.hsc" #-} {-# LINE 1242 "Network/Socket.hsc" #-} {-# LINE 1245 "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_X25 -> 9 {-# LINE 1259 "Network/Socket.hsc" #-} {-# LINE 1260 "Network/Socket.hsc" #-} {-# LINE 1261 "Network/Socket.hsc" #-} AF_AX25 -> 3 {-# LINE 1262 "Network/Socket.hsc" #-} {-# LINE 1263 "Network/Socket.hsc" #-} {-# LINE 1266 "Network/Socket.hsc" #-} {-# LINE 1269 "Network/Socket.hsc" #-} {-# LINE 1270 "Network/Socket.hsc" #-} AF_IPX -> 4 {-# LINE 1271 "Network/Socket.hsc" #-} {-# LINE 1272 "Network/Socket.hsc" #-} {-# LINE 1275 "Network/Socket.hsc" #-} {-# LINE 1278 "Network/Socket.hsc" #-} {-# LINE 1281 "Network/Socket.hsc" #-} {-# LINE 1284 "Network/Socket.hsc" #-} {-# LINE 1287 "Network/Socket.hsc" #-} {-# LINE 1290 "Network/Socket.hsc" #-} {-# LINE 1293 "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 1309 "Network/Socket.hsc" #-} AF_ISDN -> 34 {-# LINE 1310 "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 1335 "Network/Socket.hsc" #-} {-# LINE 1336 "Network/Socket.hsc" #-} AF_NETROM -> 6 {-# LINE 1337 "Network/Socket.hsc" #-} {-# LINE 1338 "Network/Socket.hsc" #-} {-# LINE 1339 "Network/Socket.hsc" #-} AF_BRIDGE -> 7 {-# LINE 1340 "Network/Socket.hsc" #-} {-# LINE 1341 "Network/Socket.hsc" #-} {-# LINE 1342 "Network/Socket.hsc" #-} AF_ATMPVC -> 8 {-# LINE 1343 "Network/Socket.hsc" #-} {-# LINE 1344 "Network/Socket.hsc" #-} {-# LINE 1345 "Network/Socket.hsc" #-} AF_ROSE -> 11 {-# LINE 1346 "Network/Socket.hsc" #-} {-# LINE 1347 "Network/Socket.hsc" #-} {-# LINE 1348 "Network/Socket.hsc" #-} AF_NETBEUI -> 13 {-# LINE 1349 "Network/Socket.hsc" #-} {-# LINE 1350 "Network/Socket.hsc" #-} {-# LINE 1351 "Network/Socket.hsc" #-} AF_SECURITY -> 14 {-# LINE 1352 "Network/Socket.hsc" #-} {-# LINE 1353 "Network/Socket.hsc" #-} {-# LINE 1354 "Network/Socket.hsc" #-} AF_PACKET -> 17 {-# LINE 1355 "Network/Socket.hsc" #-} {-# LINE 1356 "Network/Socket.hsc" #-} {-# LINE 1357 "Network/Socket.hsc" #-} AF_ASH -> 18 {-# LINE 1358 "Network/Socket.hsc" #-} {-# LINE 1359 "Network/Socket.hsc" #-} {-# LINE 1360 "Network/Socket.hsc" #-} AF_ECONET -> 19 {-# LINE 1361 "Network/Socket.hsc" #-} {-# LINE 1362 "Network/Socket.hsc" #-} {-# LINE 1363 "Network/Socket.hsc" #-} AF_ATMSVC -> 20 {-# LINE 1364 "Network/Socket.hsc" #-} {-# LINE 1365 "Network/Socket.hsc" #-} {-# LINE 1366 "Network/Socket.hsc" #-} AF_IRDA -> 23 {-# LINE 1367 "Network/Socket.hsc" #-} {-# LINE 1368 "Network/Socket.hsc" #-} {-# LINE 1369 "Network/Socket.hsc" #-} AF_PPPOX -> 24 {-# LINE 1370 "Network/Socket.hsc" #-} {-# LINE 1371 "Network/Socket.hsc" #-} {-# LINE 1372 "Network/Socket.hsc" #-} AF_WANPIPE -> 25 {-# LINE 1373 "Network/Socket.hsc" #-} {-# LINE 1374 "Network/Socket.hsc" #-} {-# LINE 1375 "Network/Socket.hsc" #-} AF_BLUETOOTH -> 31 {-# LINE 1376 "Network/Socket.hsc" #-} {-# LINE 1377 "Network/Socket.hsc" #-} --------- ---------- unpackFamily f = case f of (0) -> AF_UNSPEC {-# LINE 1382 "Network/Socket.hsc" #-} {-# LINE 1383 "Network/Socket.hsc" #-} (1) -> AF_UNIX {-# LINE 1384 "Network/Socket.hsc" #-} {-# LINE 1385 "Network/Socket.hsc" #-} {-# LINE 1386 "Network/Socket.hsc" #-} (2) -> AF_INET {-# LINE 1387 "Network/Socket.hsc" #-} {-# LINE 1388 "Network/Socket.hsc" #-} {-# LINE 1389 "Network/Socket.hsc" #-} (10) -> AF_INET6 {-# LINE 1390 "Network/Socket.hsc" #-} {-# LINE 1391 "Network/Socket.hsc" #-} {-# LINE 1394 "Network/Socket.hsc" #-} {-# LINE 1397 "Network/Socket.hsc" #-} {-# LINE 1400 "Network/Socket.hsc" #-} {-# LINE 1403 "Network/Socket.hsc" #-} {-# LINE 1406 "Network/Socket.hsc" #-} {-# LINE 1409 "Network/Socket.hsc" #-} {-# LINE 1412 "Network/Socket.hsc" #-} {-# LINE 1415 "Network/Socket.hsc" #-} {-# LINE 1416 "Network/Socket.hsc" #-} (22) -> AF_SNA {-# LINE 1417 "Network/Socket.hsc" #-} {-# LINE 1418 "Network/Socket.hsc" #-} {-# LINE 1419 "Network/Socket.hsc" #-} (12) -> AF_DECnet {-# LINE 1420 "Network/Socket.hsc" #-} {-# LINE 1421 "Network/Socket.hsc" #-} {-# LINE 1424 "Network/Socket.hsc" #-} {-# LINE 1427 "Network/Socket.hsc" #-} {-# LINE 1430 "Network/Socket.hsc" #-} {-# LINE 1431 "Network/Socket.hsc" #-} (5) -> AF_APPLETALK {-# LINE 1432 "Network/Socket.hsc" #-} {-# LINE 1433 "Network/Socket.hsc" #-} {-# LINE 1434 "Network/Socket.hsc" #-} (16) -> AF_ROUTE {-# LINE 1435 "Network/Socket.hsc" #-} {-# LINE 1436 "Network/Socket.hsc" #-} {-# LINE 1439 "Network/Socket.hsc" #-} {-# LINE 1442 "Network/Socket.hsc" #-} {-# LINE 1445 "Network/Socket.hsc" #-} {-# LINE 1448 "Network/Socket.hsc" #-} {-# LINE 1453 "Network/Socket.hsc" #-} {-# LINE 1456 "Network/Socket.hsc" #-} {-# LINE 1457 "Network/Socket.hsc" #-} (9) -> AF_X25 {-# LINE 1458 "Network/Socket.hsc" #-} {-# LINE 1459 "Network/Socket.hsc" #-} {-# LINE 1460 "Network/Socket.hsc" #-} (3) -> AF_AX25 {-# LINE 1461 "Network/Socket.hsc" #-} {-# LINE 1462 "Network/Socket.hsc" #-} {-# LINE 1465 "Network/Socket.hsc" #-} {-# LINE 1468 "Network/Socket.hsc" #-} {-# LINE 1469 "Network/Socket.hsc" #-} (4) -> AF_IPX {-# LINE 1470 "Network/Socket.hsc" #-} {-# LINE 1471 "Network/Socket.hsc" #-} {-# LINE 1474 "Network/Socket.hsc" #-} {-# LINE 1477 "Network/Socket.hsc" #-} {-# LINE 1480 "Network/Socket.hsc" #-} {-# LINE 1483 "Network/Socket.hsc" #-} {-# LINE 1486 "Network/Socket.hsc" #-} {-# LINE 1489 "Network/Socket.hsc" #-} {-# LINE 1492 "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 1508 "Network/Socket.hsc" #-} (34) -> AF_ISDN {-# LINE 1509 "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 1534 "Network/Socket.hsc" #-} {-# LINE 1535 "Network/Socket.hsc" #-} (6) -> AF_NETROM {-# LINE 1536 "Network/Socket.hsc" #-} {-# LINE 1537 "Network/Socket.hsc" #-} {-# LINE 1538 "Network/Socket.hsc" #-} (7) -> AF_BRIDGE {-# LINE 1539 "Network/Socket.hsc" #-} {-# LINE 1540 "Network/Socket.hsc" #-} {-# LINE 1541 "Network/Socket.hsc" #-} (8) -> AF_ATMPVC {-# LINE 1542 "Network/Socket.hsc" #-} {-# LINE 1543 "Network/Socket.hsc" #-} {-# LINE 1544 "Network/Socket.hsc" #-} (11) -> AF_ROSE {-# LINE 1545 "Network/Socket.hsc" #-} {-# LINE 1546 "Network/Socket.hsc" #-} {-# LINE 1547 "Network/Socket.hsc" #-} (13) -> AF_NETBEUI {-# LINE 1548 "Network/Socket.hsc" #-} {-# LINE 1549 "Network/Socket.hsc" #-} {-# LINE 1550 "Network/Socket.hsc" #-} (14) -> AF_SECURITY {-# LINE 1551 "Network/Socket.hsc" #-} {-# LINE 1552 "Network/Socket.hsc" #-} {-# LINE 1553 "Network/Socket.hsc" #-} (17) -> AF_PACKET {-# LINE 1554 "Network/Socket.hsc" #-} {-# LINE 1555 "Network/Socket.hsc" #-} {-# LINE 1556 "Network/Socket.hsc" #-} (18) -> AF_ASH {-# LINE 1557 "Network/Socket.hsc" #-} {-# LINE 1558 "Network/Socket.hsc" #-} {-# LINE 1559 "Network/Socket.hsc" #-} (19) -> AF_ECONET {-# LINE 1560 "Network/Socket.hsc" #-} {-# LINE 1561 "Network/Socket.hsc" #-} {-# LINE 1562 "Network/Socket.hsc" #-} (20) -> AF_ATMSVC {-# LINE 1563 "Network/Socket.hsc" #-} {-# LINE 1564 "Network/Socket.hsc" #-} {-# LINE 1565 "Network/Socket.hsc" #-} (23) -> AF_IRDA {-# LINE 1566 "Network/Socket.hsc" #-} {-# LINE 1567 "Network/Socket.hsc" #-} {-# LINE 1568 "Network/Socket.hsc" #-} (24) -> AF_PPPOX {-# LINE 1569 "Network/Socket.hsc" #-} {-# LINE 1570 "Network/Socket.hsc" #-} {-# LINE 1571 "Network/Socket.hsc" #-} (25) -> AF_WANPIPE {-# LINE 1572 "Network/Socket.hsc" #-} {-# LINE 1573 "Network/Socket.hsc" #-} {-# LINE 1574 "Network/Socket.hsc" #-} (31) -> AF_BLUETOOTH {-# LINE 1575 "Network/Socket.hsc" #-} {-# LINE 1576 "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 1588 "Network/Socket.hsc" #-} | Stream {-# LINE 1590 "Network/Socket.hsc" #-} {-# LINE 1591 "Network/Socket.hsc" #-} | Datagram {-# LINE 1593 "Network/Socket.hsc" #-} {-# LINE 1594 "Network/Socket.hsc" #-} | Raw {-# LINE 1596 "Network/Socket.hsc" #-} {-# LINE 1597 "Network/Socket.hsc" #-} | RDM {-# LINE 1599 "Network/Socket.hsc" #-} {-# LINE 1600 "Network/Socket.hsc" #-} | SeqPacket {-# LINE 1602 "Network/Socket.hsc" #-} deriving (Eq, Ord, Read, Show, Typeable) packSocketType stype = case stype of NoSocketType -> 0 {-# LINE 1607 "Network/Socket.hsc" #-} Stream -> 1 {-# LINE 1608 "Network/Socket.hsc" #-} {-# LINE 1609 "Network/Socket.hsc" #-} {-# LINE 1610 "Network/Socket.hsc" #-} Datagram -> 2 {-# LINE 1611 "Network/Socket.hsc" #-} {-# LINE 1612 "Network/Socket.hsc" #-} {-# LINE 1613 "Network/Socket.hsc" #-} Raw -> 3 {-# LINE 1614 "Network/Socket.hsc" #-} {-# LINE 1615 "Network/Socket.hsc" #-} {-# LINE 1616 "Network/Socket.hsc" #-} RDM -> 4 {-# LINE 1617 "Network/Socket.hsc" #-} {-# LINE 1618 "Network/Socket.hsc" #-} {-# LINE 1619 "Network/Socket.hsc" #-} SeqPacket -> 5 {-# LINE 1620 "Network/Socket.hsc" #-} {-# LINE 1621 "Network/Socket.hsc" #-} unpackSocketType t = case t of 0 -> NoSocketType {-# LINE 1625 "Network/Socket.hsc" #-} (1) -> Stream {-# LINE 1626 "Network/Socket.hsc" #-} {-# LINE 1627 "Network/Socket.hsc" #-} {-# LINE 1628 "Network/Socket.hsc" #-} (2) -> Datagram {-# LINE 1629 "Network/Socket.hsc" #-} {-# LINE 1630 "Network/Socket.hsc" #-} {-# LINE 1631 "Network/Socket.hsc" #-} (3) -> Raw {-# LINE 1632 "Network/Socket.hsc" #-} {-# LINE 1633 "Network/Socket.hsc" #-} {-# LINE 1634 "Network/Socket.hsc" #-} (4) -> RDM {-# LINE 1635 "Network/Socket.hsc" #-} {-# LINE 1636 "Network/Socket.hsc" #-} {-# LINE 1637 "Network/Socket.hsc" #-} (5) -> SeqPacket {-# LINE 1638 "Network/Socket.hsc" #-} {-# LINE 1639 "Network/Socket.hsc" #-} -- --------------------------------------------------------------------------- -- Utility Functions aNY_PORT :: PortNumber aNY_PORT = 0 -- | The IPv4 wild card address. iNADDR_ANY :: HostAddress iNADDR_ANY = htonl (0) {-# LINE 1650 "Network/Socket.hsc" #-} {-# LINE 1652 "Network/Socket.hsc" #-} -- | The IPv6 wild card address. iN6ADDR_ANY :: HostAddress6 iN6ADDR_ANY = (0, 0, 0, 0) {-# LINE 1657 "Network/Socket.hsc" #-} sOMAXCONN :: Int sOMAXCONN = 128 {-# LINE 1660 "Network/Socket.hsc" #-} sOL_SOCKET :: Int sOL_SOCKET = 1 {-# LINE 1663 "Network/Socket.hsc" #-} {-# LINE 1665 "Network/Socket.hsc" #-} sCM_RIGHTS :: Int sCM_RIGHTS = 1 {-# LINE 1667 "Network/Socket.hsc" #-} {-# LINE 1668 "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 1740 "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 1746 "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 1776 "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 1783 "Network/Socket.hsc" #-} h <- fdToHandle' (fromIntegral fd) (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-} {-# LINE 1791 "Network/Socket.hsc" #-} return (ConvertedToHandle, h) {-# LINE 1796 "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, 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 :: 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 1824 "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 1841 "Network/Socket.hsc" #-} (AI_ADDRCONFIG, 32), {-# LINE 1842 "Network/Socket.hsc" #-} {-# LINE 1845 "Network/Socket.hsc" #-} {-# LINE 1846 "Network/Socket.hsc" #-} (AI_ALL, 16), {-# LINE 1847 "Network/Socket.hsc" #-} {-# LINE 1850 "Network/Socket.hsc" #-} (AI_CANONNAME, 2), {-# LINE 1851 "Network/Socket.hsc" #-} (AI_NUMERICHOST, 4), {-# LINE 1852 "Network/Socket.hsc" #-} {-# LINE 1853 "Network/Socket.hsc" #-} (AI_NUMERICSERV, 1024), {-# LINE 1854 "Network/Socket.hsc" #-} {-# LINE 1857 "Network/Socket.hsc" #-} (AI_PASSIVE, 1), {-# LINE 1858 "Network/Socket.hsc" #-} {-# LINE 1859 "Network/Socket.hsc" #-} (AI_V4MAPPED, 8) {-# LINE 1860 "Network/Socket.hsc" #-} {-# LINE 1863 "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 1883 "Network/Socket.hsc" #-} alignment _ = alignment (undefined :: CInt) peek p = do ai_flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p {-# LINE 1887 "Network/Socket.hsc" #-} ai_family <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p {-# LINE 1888 "Network/Socket.hsc" #-} ai_socktype <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p {-# LINE 1889 "Network/Socket.hsc" #-} ai_protocol <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p {-# LINE 1890 "Network/Socket.hsc" #-} ai_addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p >>= peekSockAddr {-# LINE 1891 "Network/Socket.hsc" #-} ai_canonname_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p {-# LINE 1892 "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 1909 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p (packFamily family) {-# LINE 1910 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (packSocketType socketType) {-# LINE 1911 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p protocol {-# LINE 1912 "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 1916 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) p nullPtr {-# LINE 1917 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p nullPtr {-# LINE 1918 "Network/Socket.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) p nullPtr {-# LINE 1919 "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 1931 "Network/Socket.hsc" #-} (NI_NAMEREQD, 8), {-# LINE 1932 "Network/Socket.hsc" #-} (NI_NOFQDN, 4), {-# LINE 1933 "Network/Socket.hsc" #-} (NI_NUMERICHOST, 1), {-# LINE 1934 "Network/Socket.hsc" #-} (NI_NUMERICSERV, 2)] {-# LINE 1935 "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 2061 "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 2073 "Network/Socket.hsc" #-} gai_strerror n = c_gai_strerror n >>= peekCString foreign import ccall safe "gai_strerror" c_gai_strerror :: CInt -> IO CString {-# LINE 2080 "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 2135 "Network/Socket.hsc" #-} withCStringIf doService (32) $ \c_servlen c_serv -> do {-# LINE 2136 "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 2156 "Network/Socket.hsc" #-} mkInvalidRecvArgError :: String -> IOError mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError {-# LINE 2160 "Network/Socket.hsc" #-} InvalidArgument {-# LINE 2164 "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 2185 "Network/Socket.hsc" #-} foreign import ccall unsafe "close" c_close :: CInt -> IO CInt {-# LINE 2191 "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 foreign import CALLCONV safe "accept" c_accept_safe :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt foreign import CALLCONV unsafe "listen" c_listen :: CInt -> CInt -> IO CInt {-# LINE 2206 "Network/Socket.hsc" #-} foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool {-# LINE 2208 "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