{-# INCLUDE "HsNet.h" #-} {-# OPTIONS_GHC -optc-DWITH_WINSOCK=1 #-} {-# LINE 1 "Network\Socket.hsc" #-} {-# OPTIONS -fglasgow-exts -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" {-# LINE 28 "Network\Socket.hsc" #-} {-# LINE 29 "Network\Socket.hsc" #-} {-# LINE 30 "Network\Socket.hsc" #-} {-# LINE 34 "Network\Socket.hsc" #-} {-# LINE 42 "Network\Socket.hsc" #-} -- In order to process this file, you need to have CALLCONV defined. module Network.Socket ( -- * Types Socket(..), -- instance Eq, Show Family(..), SocketType(..), SockAddr(..), SocketStatus(..), HostAddress, {-# LINE 59 "Network\Socket.hsc" #-} ShutdownCmd(..), ProtocolNumber, defaultProtocol, -- :: ProtocolNumber PortNumber(..), -- PortNumber is used non-abstractly in Network.BSD. ToDo: remove -- this use and make the type abstract. -- * Address operations HostName, ServiceName, {-# LINE 85 "Network\Socket.hsc" #-} -- * Socket Operations socket, -- :: Family -> SocketType -> ProtocolNumber -> IO Socket {-# LINE 91 "Network\Socket.hsc" #-} connect, -- :: Socket -> SockAddr -> IO () bindSocket, -- :: Socket -> SockAddr -> IO () listen, -- :: Socket -> Int -> IO () accept, -- :: Socket -> IO (Socket, SockAddr) getPeerName, -- :: Socket -> IO SockAddr getSocketName, -- :: Socket -> IO SockAddr {-# LINE 102 "Network\Socket.hsc" #-} socketPort, -- :: Socket -> IO PortNumber socketToHandle, -- :: Socket -> IOMode -> IO Handle sendTo, -- :: Socket -> String -> SockAddr -> IO Int sendBufTo, -- :: Socket -> Ptr a -> Int -> SockAddr -> IO Int recvFrom, -- :: Socket -> Int -> IO (String, Int, SockAddr) recvBufFrom, -- :: Socket -> Ptr a -> Int -> IO (Int, SockAddr) send, -- :: Socket -> String -> IO Int recv, -- :: Socket -> Int -> IO String recvLen, -- :: Socket -> Int -> IO (String, Int) inet_addr, -- :: String -> IO HostAddress inet_ntoa, -- :: HostAddress -> IO String shutdown, -- :: Socket -> ShutdownCmd -> IO () sClose, -- :: Socket -> IO () -- ** Predicates on sockets sIsConnected, -- :: Socket -> IO Bool sIsBound, -- :: Socket -> IO Bool sIsListening, -- :: Socket -> IO Bool sIsReadable, -- :: Socket -> IO Bool sIsWritable, -- :: Socket -> IO Bool -- * Socket options SocketOption(..), getSocketOption, -- :: Socket -> SocketOption -> IO Int setSocketOption, -- :: Socket -> SocketOption -> Int -> IO () -- * File descriptor transmission {-# LINE 145 "Network\Socket.hsc" #-} -- * Special Constants aNY_PORT, -- :: PortNumber iNADDR_ANY, -- :: HostAddress {-# LINE 152 "Network\Socket.hsc" #-} sOMAXCONN, -- :: Int sOL_SOCKET, -- :: Int {-# LINE 157 "Network\Socket.hsc" #-} maxListenQueue, -- :: Int -- * Initialisation withSocketsDo, -- :: IO a -> IO a -- * Very low level operations -- in case you ever want to get at the underlying file descriptor.. fdSocket, -- :: Socket -> CInt mkSocket, -- :: CInt -> Family -- -> SocketType -- -> ProtocolNumber -- -> SocketStatus -- -> IO Socket -- * 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 194 "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 ( CInt, CUInt, CChar, CSize ) 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 217 "Network\Socket.hsc" #-} import GHC.Conc (threadWaitRead, threadWaitWrite) {-# LINE 219 "Network\Socket.hsc" #-} import GHC.Conc ( asyncDoProc ) import Foreign( FunPtr ) {-# LINE 222 "Network\Socket.hsc" #-} import GHC.Handle import GHC.IOBase import qualified System.Posix.Internals {-# LINE 228 "Network\Socket.hsc" #-} import Network.Socket.Internal 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 deriving (Eq, Show) INSTANCE_TYPEABLE0(SocketStatus,socketStatusTc,"SocketStatus") data Socket = MkSocket CInt -- File Descriptor Family SocketType ProtocolNumber -- Protocol Number (MVar SocketStatus) -- Status Flag INSTANCE_TYPEABLE0(Socket,socketTc,"Socket") 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_TYPEABLE0(PortNumber,portNumberTc,"PortNumber") 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_TYPEABLE0(SockAddr,sockAddrTc,"SockAddr") instance Show SockAddr where {-# LINE 375 "Network\Socket.hsc" #-} showsPrec _ (SockAddrInet port ha) = showString (unsafePerformIO (inet_ntoa ha)) . showString ":" . shows port {-# LINE 388 "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 an unconnected socket of the given family, type and -- protocol. The most common invocation of $socket$ is the following: -- ... -- my_socket <- socket AF_INET Stream 6 -- ... 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 414 "Network\Socket.hsc" #-} System.Posix.Internals.setNonBlockingFD fd {-# LINE 416 "Network\Socket.hsc" #-} socket_status <- newMVar NotConnected return (MkSocket fd family stype protocol socket_status) -- Create an unnamed pair of connected sockets, given family, type and -- protocol. Differs from a normal pipe in being a bi-directional channel -- of communication. {-# LINE 449 "Network\Socket.hsc" #-} ----------------------------------------------------------------------------- -- Binding a socket -- -- Given a port number this {\em binds} the socket to that port. This -- means that the programmer is only interested in data being sent to -- that port number. 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. -- -- Port numbers for standard unix services can be found by calling -- $getServiceEntry$. These are traditionally port numbers below -- 1000; although there are afew, namely NFS and IRC, which used higher -- numbered ports. -- -- The port number allocated to a socket bound by using $aNY\_PORT$ can be -- found by calling $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 -- -- Make a connection to an already opened socket on a given machine -- and port. assumes that we have already called createSocket, -- otherwise it will fail. -- -- This is the dual to $bindSocket$. The {\em server} process will -- usually bind to a port number, the {\em client} will then connect -- to the same port number. Port numbers of user applications are -- normally agreed in advance, otherwise we must rely on some meta -- protocol for telling the other side what port number we have been -- allocated. 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 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 522 "Network\Socket.hsc" #-} rc <- c_getLastError case rc of 10093 -> do -- WSANOTINITIALISED withSocketsDo (return ()) r <- c_connect s p_addr (fromIntegral sz) if r == -1 then (c_getLastError >>= throwSocketError "connect") else return r _ -> throwSocketError "connect" rc {-# LINE 532 "Network\Socket.hsc" #-} else return r connectBlocked = do {-# LINE 536 "Network\Socket.hsc" #-} threadWaitWrite (fromIntegral s) {-# LINE 538 "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 -- -- The programmer must call $listen$ to tell the system software that -- they are now interested in receiving data on this port. This must -- be called on the bound socket before any calls to read or write -- data are made. -- The programmer also gives a number which indicates the length of -- the incoming queue of unread messages for this socket. On most -- systems the maximum queue length is around 5. To remove a message -- from the queue for processing a call to $accept$ should be made. 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 :: 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 599 "Network\Socket.hsc" #-} new_sock <- if threaded then with (fromIntegral sz) $ \ ptr_len -> throwErrnoIfMinus1Retry "Network.Socket.accept" $ c_accept_safe s sockaddr ptr_len else do paramData <- c_newAcceptParams s (fromIntegral sz) sockaddr rc <- asyncDoProc c_acceptDoProc paramData new_sock <- c_acceptNewSock paramData c_free paramData when (rc /= 0) (ioError (errnoToIOError "Network.Socket.accept" (Errno (fromIntegral rc)) Nothing Nothing)) return new_sock {-# LINE 624 "Network\Socket.hsc" #-} addr <- peekSockAddr sockaddr new_status <- newMVar Connected return ((MkSocket new_sock family stype protocol new_status), addr) {-# LINE 629 "Network\Socket.hsc" #-} foreign import ccall unsafe "HsNet.h acceptNewSock" c_acceptNewSock :: Ptr () -> IO CInt foreign import ccall unsafe "HsNet.h newAcceptParams" c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ()) foreign import ccall unsafe "HsNet.h &acceptDoProc" c_acceptDoProc :: FunPtr (Ptr () -> IO Int) foreign import ccall unsafe "free" c_free:: Ptr a -> IO () {-# LINE 638 "Network\Socket.hsc" #-} ----------------------------------------------------------------------------- -- sendTo & recvFrom -- | 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 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 662 "Network\Socket.hsc" #-} throwErrnoIfMinus1Retry_repeatOnBlock "sendTo" (threadWaitWrite (fromIntegral s)) $ {-# LINE 665 "Network\Socket.hsc" #-} c_sendto s ptr (fromIntegral $ nbytes) 0{-flags-} p_addr (fromIntegral sz) -- | 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) 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 686 "Network\Socket.hsc" #-} throwErrnoIfMinus1Retry_repeatOnBlock "recvFrom" (threadWaitRead (fromIntegral s)) $ {-# LINE 689 "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 :: Socket -- Bound/Connected Socket -> String -- Data to send -> IO Int -- Number of Bytes sent send (MkSocket s _family _stype _protocol status) xs = do let len = length xs withCString xs $ \str -> do liftM fromIntegral $ {-# LINE 717 "Network\Socket.hsc" #-} writeRawBufferPtr "Network.Socket.send" (fromIntegral s) True str 0 (fromIntegral len) {-# LINE 726 "Network\Socket.hsc" #-} 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 737 "Network\Socket.hsc" #-} readRawBufferPtr "Network.Socket.recvLen" (fromIntegral s) True ptr 0 (fromIntegral nbytes) {-# LINE 746 "Network\Socket.hsc" #-} let len' = fromIntegral len if len' == 0 then ioError (mkEOFError "Network.Socket.recv") else do s <- peekCStringLen (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 770 "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 804 "Network\Socket.hsc" #-} | Debug {- SO_DEBUG -} {-# LINE 806 "Network\Socket.hsc" #-} {-# LINE 807 "Network\Socket.hsc" #-} | ReuseAddr {- SO_REUSEADDR -} {-# LINE 809 "Network\Socket.hsc" #-} {-# LINE 810 "Network\Socket.hsc" #-} | Type {- SO_TYPE -} {-# LINE 812 "Network\Socket.hsc" #-} {-# LINE 813 "Network\Socket.hsc" #-} | SoError {- SO_ERROR -} {-# LINE 815 "Network\Socket.hsc" #-} {-# LINE 816 "Network\Socket.hsc" #-} | DontRoute {- SO_DONTROUTE -} {-# LINE 818 "Network\Socket.hsc" #-} {-# LINE 819 "Network\Socket.hsc" #-} | Broadcast {- SO_BROADCAST -} {-# LINE 821 "Network\Socket.hsc" #-} {-# LINE 822 "Network\Socket.hsc" #-} | SendBuffer {- SO_SNDBUF -} {-# LINE 824 "Network\Socket.hsc" #-} {-# LINE 825 "Network\Socket.hsc" #-} | RecvBuffer {- SO_RCVBUF -} {-# LINE 827 "Network\Socket.hsc" #-} {-# LINE 828 "Network\Socket.hsc" #-} | KeepAlive {- SO_KEEPALIVE -} {-# LINE 830 "Network\Socket.hsc" #-} {-# LINE 831 "Network\Socket.hsc" #-} | OOBInline {- SO_OOBINLINE -} {-# LINE 833 "Network\Socket.hsc" #-} {-# LINE 836 "Network\Socket.hsc" #-} {-# LINE 839 "Network\Socket.hsc" #-} {-# LINE 840 "Network\Socket.hsc" #-} | NoDelay {- TCP_NODELAY -} {-# LINE 842 "Network\Socket.hsc" #-} {-# LINE 843 "Network\Socket.hsc" #-} | Linger {- SO_LINGER -} {-# LINE 845 "Network\Socket.hsc" #-} {-# LINE 848 "Network\Socket.hsc" #-} {-# LINE 849 "Network\Socket.hsc" #-} | RecvLowWater {- SO_RCVLOWAT -} {-# LINE 851 "Network\Socket.hsc" #-} {-# LINE 852 "Network\Socket.hsc" #-} | SendLowWater {- SO_SNDLOWAT -} {-# LINE 854 "Network\Socket.hsc" #-} {-# LINE 855 "Network\Socket.hsc" #-} | RecvTimeOut {- SO_RCVTIMEO -} {-# LINE 857 "Network\Socket.hsc" #-} {-# LINE 858 "Network\Socket.hsc" #-} | SendTimeOut {- SO_SNDTIMEO -} {-# LINE 860 "Network\Socket.hsc" #-} {-# LINE 861 "Network\Socket.hsc" #-} | UseLoopBack {- SO_USELOOPBACK -} {-# LINE 863 "Network\Socket.hsc" #-} INSTANCE_TYPEABLE0(SocketOption,socketOptionTc,"SocketOption") socketOptLevel :: SocketOption -> CInt socketOptLevel so = case so of {-# LINE 872 "Network\Socket.hsc" #-} {-# LINE 875 "Network\Socket.hsc" #-} {-# LINE 876 "Network\Socket.hsc" #-} NoDelay -> 6 {-# LINE 877 "Network\Socket.hsc" #-} {-# LINE 878 "Network\Socket.hsc" #-} _ -> 65535 {-# LINE 879 "Network\Socket.hsc" #-} packSocketOption :: SocketOption -> CInt packSocketOption so = case so of {-# LINE 884 "Network\Socket.hsc" #-} Debug -> 1 {-# LINE 885 "Network\Socket.hsc" #-} {-# LINE 886 "Network\Socket.hsc" #-} {-# LINE 887 "Network\Socket.hsc" #-} ReuseAddr -> 4 {-# LINE 888 "Network\Socket.hsc" #-} {-# LINE 889 "Network\Socket.hsc" #-} {-# LINE 890 "Network\Socket.hsc" #-} Type -> 4104 {-# LINE 891 "Network\Socket.hsc" #-} {-# LINE 892 "Network\Socket.hsc" #-} {-# LINE 893 "Network\Socket.hsc" #-} SoError -> 4103 {-# LINE 894 "Network\Socket.hsc" #-} {-# LINE 895 "Network\Socket.hsc" #-} {-# LINE 896 "Network\Socket.hsc" #-} DontRoute -> 16 {-# LINE 897 "Network\Socket.hsc" #-} {-# LINE 898 "Network\Socket.hsc" #-} {-# LINE 899 "Network\Socket.hsc" #-} Broadcast -> 32 {-# LINE 900 "Network\Socket.hsc" #-} {-# LINE 901 "Network\Socket.hsc" #-} {-# LINE 902 "Network\Socket.hsc" #-} SendBuffer -> 4097 {-# LINE 903 "Network\Socket.hsc" #-} {-# LINE 904 "Network\Socket.hsc" #-} {-# LINE 905 "Network\Socket.hsc" #-} RecvBuffer -> 4098 {-# LINE 906 "Network\Socket.hsc" #-} {-# LINE 907 "Network\Socket.hsc" #-} {-# LINE 908 "Network\Socket.hsc" #-} KeepAlive -> 8 {-# LINE 909 "Network\Socket.hsc" #-} {-# LINE 910 "Network\Socket.hsc" #-} {-# LINE 911 "Network\Socket.hsc" #-} OOBInline -> 256 {-# LINE 912 "Network\Socket.hsc" #-} {-# LINE 913 "Network\Socket.hsc" #-} {-# LINE 916 "Network\Socket.hsc" #-} {-# LINE 919 "Network\Socket.hsc" #-} {-# LINE 920 "Network\Socket.hsc" #-} NoDelay -> 1 {-# LINE 921 "Network\Socket.hsc" #-} {-# LINE 922 "Network\Socket.hsc" #-} {-# LINE 923 "Network\Socket.hsc" #-} Linger -> 128 {-# LINE 924 "Network\Socket.hsc" #-} {-# LINE 925 "Network\Socket.hsc" #-} {-# LINE 928 "Network\Socket.hsc" #-} {-# LINE 929 "Network\Socket.hsc" #-} RecvLowWater -> 4100 {-# LINE 930 "Network\Socket.hsc" #-} {-# LINE 931 "Network\Socket.hsc" #-} {-# LINE 932 "Network\Socket.hsc" #-} SendLowWater -> 4099 {-# LINE 933 "Network\Socket.hsc" #-} {-# LINE 934 "Network\Socket.hsc" #-} {-# LINE 935 "Network\Socket.hsc" #-} RecvTimeOut -> 4102 {-# LINE 936 "Network\Socket.hsc" #-} {-# LINE 937 "Network\Socket.hsc" #-} {-# LINE 938 "Network\Socket.hsc" #-} SendTimeOut -> 4101 {-# LINE 939 "Network\Socket.hsc" #-} {-# LINE 940 "Network\Socket.hsc" #-} {-# LINE 941 "Network\Socket.hsc" #-} UseLoopBack -> 64 {-# LINE 942 "Network\Socket.hsc" #-} {-# LINE 943 "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 v)) 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 985 "Network\Socket.hsc" #-} {-# LINE 1066 "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 1113 "Network\Socket.hsc" #-} {-# LINE 1114 "Network\Socket.hsc" #-} AF_UNIX -> 1 {-# LINE 1115 "Network\Socket.hsc" #-} {-# LINE 1116 "Network\Socket.hsc" #-} {-# LINE 1117 "Network\Socket.hsc" #-} AF_INET -> 2 {-# LINE 1118 "Network\Socket.hsc" #-} {-# LINE 1119 "Network\Socket.hsc" #-} {-# LINE 1120 "Network\Socket.hsc" #-} AF_INET6 -> 23 {-# LINE 1121 "Network\Socket.hsc" #-} {-# LINE 1122 "Network\Socket.hsc" #-} {-# LINE 1123 "Network\Socket.hsc" #-} AF_IMPLINK -> 3 {-# LINE 1124 "Network\Socket.hsc" #-} {-# LINE 1125 "Network\Socket.hsc" #-} {-# LINE 1126 "Network\Socket.hsc" #-} AF_PUP -> 4 {-# LINE 1127 "Network\Socket.hsc" #-} {-# LINE 1128 "Network\Socket.hsc" #-} {-# LINE 1129 "Network\Socket.hsc" #-} AF_CHAOS -> 5 {-# LINE 1130 "Network\Socket.hsc" #-} {-# LINE 1131 "Network\Socket.hsc" #-} {-# LINE 1132 "Network\Socket.hsc" #-} AF_NS -> 6 {-# LINE 1133 "Network\Socket.hsc" #-} {-# LINE 1134 "Network\Socket.hsc" #-} {-# LINE 1137 "Network\Socket.hsc" #-} {-# LINE 1138 "Network\Socket.hsc" #-} AF_ECMA -> 8 {-# LINE 1139 "Network\Socket.hsc" #-} {-# LINE 1140 "Network\Socket.hsc" #-} {-# LINE 1141 "Network\Socket.hsc" #-} AF_DATAKIT -> 9 {-# LINE 1142 "Network\Socket.hsc" #-} {-# LINE 1143 "Network\Socket.hsc" #-} {-# LINE 1144 "Network\Socket.hsc" #-} AF_CCITT -> 10 {-# LINE 1145 "Network\Socket.hsc" #-} {-# LINE 1146 "Network\Socket.hsc" #-} {-# LINE 1147 "Network\Socket.hsc" #-} AF_SNA -> 11 {-# LINE 1148 "Network\Socket.hsc" #-} {-# LINE 1149 "Network\Socket.hsc" #-} {-# LINE 1150 "Network\Socket.hsc" #-} AF_DECnet -> 12 {-# LINE 1151 "Network\Socket.hsc" #-} {-# LINE 1152 "Network\Socket.hsc" #-} {-# LINE 1153 "Network\Socket.hsc" #-} AF_DLI -> 13 {-# LINE 1154 "Network\Socket.hsc" #-} {-# LINE 1155 "Network\Socket.hsc" #-} {-# LINE 1156 "Network\Socket.hsc" #-} AF_LAT -> 14 {-# LINE 1157 "Network\Socket.hsc" #-} {-# LINE 1158 "Network\Socket.hsc" #-} {-# LINE 1159 "Network\Socket.hsc" #-} AF_HYLINK -> 15 {-# LINE 1160 "Network\Socket.hsc" #-} {-# LINE 1161 "Network\Socket.hsc" #-} {-# LINE 1162 "Network\Socket.hsc" #-} AF_APPLETALK -> 16 {-# LINE 1163 "Network\Socket.hsc" #-} {-# LINE 1164 "Network\Socket.hsc" #-} {-# LINE 1167 "Network\Socket.hsc" #-} {-# LINE 1168 "Network\Socket.hsc" #-} AF_NETBIOS -> 17 {-# LINE 1169 "Network\Socket.hsc" #-} {-# LINE 1170 "Network\Socket.hsc" #-} {-# LINE 1173 "Network\Socket.hsc" #-} {-# LINE 1176 "Network\Socket.hsc" #-} {-# LINE 1177 "Network\Socket.hsc" #-} AF_ISO -> 7 {-# LINE 1178 "Network\Socket.hsc" #-} {-# LINE 1179 "Network\Socket.hsc" #-} {-# LINE 1180 "Network\Socket.hsc" #-} AF_OSI -> 7 {-# LINE 1181 "Network\Socket.hsc" #-} {-# LINE 1182 "Network\Socket.hsc" #-} {-# LINE 1185 "Network\Socket.hsc" #-} {-# LINE 1188 "Network\Socket.hsc" #-} {-# LINE 1191 "Network\Socket.hsc" #-} {-# LINE 1194 "Network\Socket.hsc" #-} {-# LINE 1197 "Network\Socket.hsc" #-} {-# LINE 1198 "Network\Socket.hsc" #-} AF_IPX -> 6 {-# LINE 1199 "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 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 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 1260 "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 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" #-} --------- ---------- unpackFamily f = case f of (0) -> AF_UNSPEC {-# LINE 1310 "Network\Socket.hsc" #-} {-# LINE 1311 "Network\Socket.hsc" #-} (1) -> AF_UNIX {-# LINE 1312 "Network\Socket.hsc" #-} {-# LINE 1313 "Network\Socket.hsc" #-} {-# LINE 1314 "Network\Socket.hsc" #-} (2) -> AF_INET {-# LINE 1315 "Network\Socket.hsc" #-} {-# LINE 1316 "Network\Socket.hsc" #-} {-# LINE 1317 "Network\Socket.hsc" #-} (23) -> AF_INET6 {-# LINE 1318 "Network\Socket.hsc" #-} {-# LINE 1319 "Network\Socket.hsc" #-} {-# LINE 1320 "Network\Socket.hsc" #-} (3) -> AF_IMPLINK {-# LINE 1321 "Network\Socket.hsc" #-} {-# LINE 1322 "Network\Socket.hsc" #-} {-# LINE 1323 "Network\Socket.hsc" #-} (4) -> AF_PUP {-# LINE 1324 "Network\Socket.hsc" #-} {-# LINE 1325 "Network\Socket.hsc" #-} {-# LINE 1326 "Network\Socket.hsc" #-} (5) -> AF_CHAOS {-# LINE 1327 "Network\Socket.hsc" #-} {-# LINE 1328 "Network\Socket.hsc" #-} {-# LINE 1329 "Network\Socket.hsc" #-} (6) -> AF_NS {-# LINE 1330 "Network\Socket.hsc" #-} {-# LINE 1331 "Network\Socket.hsc" #-} {-# LINE 1334 "Network\Socket.hsc" #-} {-# LINE 1335 "Network\Socket.hsc" #-} (8) -> AF_ECMA {-# LINE 1336 "Network\Socket.hsc" #-} {-# LINE 1337 "Network\Socket.hsc" #-} {-# LINE 1338 "Network\Socket.hsc" #-} (9) -> AF_DATAKIT {-# LINE 1339 "Network\Socket.hsc" #-} {-# LINE 1340 "Network\Socket.hsc" #-} {-# LINE 1341 "Network\Socket.hsc" #-} (10) -> AF_CCITT {-# LINE 1342 "Network\Socket.hsc" #-} {-# LINE 1343 "Network\Socket.hsc" #-} {-# LINE 1344 "Network\Socket.hsc" #-} (11) -> AF_SNA {-# LINE 1345 "Network\Socket.hsc" #-} {-# LINE 1346 "Network\Socket.hsc" #-} {-# LINE 1347 "Network\Socket.hsc" #-} (12) -> AF_DECnet {-# LINE 1348 "Network\Socket.hsc" #-} {-# LINE 1349 "Network\Socket.hsc" #-} {-# LINE 1350 "Network\Socket.hsc" #-} (13) -> AF_DLI {-# LINE 1351 "Network\Socket.hsc" #-} {-# LINE 1352 "Network\Socket.hsc" #-} {-# LINE 1353 "Network\Socket.hsc" #-} (14) -> AF_LAT {-# LINE 1354 "Network\Socket.hsc" #-} {-# LINE 1355 "Network\Socket.hsc" #-} {-# LINE 1356 "Network\Socket.hsc" #-} (15) -> AF_HYLINK {-# LINE 1357 "Network\Socket.hsc" #-} {-# LINE 1358 "Network\Socket.hsc" #-} {-# LINE 1359 "Network\Socket.hsc" #-} (16) -> AF_APPLETALK {-# LINE 1360 "Network\Socket.hsc" #-} {-# LINE 1361 "Network\Socket.hsc" #-} {-# LINE 1364 "Network\Socket.hsc" #-} {-# LINE 1365 "Network\Socket.hsc" #-} (17) -> AF_NETBIOS {-# LINE 1366 "Network\Socket.hsc" #-} {-# LINE 1367 "Network\Socket.hsc" #-} {-# LINE 1370 "Network\Socket.hsc" #-} {-# LINE 1373 "Network\Socket.hsc" #-} {-# LINE 1374 "Network\Socket.hsc" #-} (7) -> AF_ISO {-# LINE 1375 "Network\Socket.hsc" #-} {-# LINE 1376 "Network\Socket.hsc" #-} {-# LINE 1377 "Network\Socket.hsc" #-} {-# LINE 1380 "Network\Socket.hsc" #-} {-# LINE 1381 "Network\Socket.hsc" #-} {-# LINE 1384 "Network\Socket.hsc" #-} {-# LINE 1387 "Network\Socket.hsc" #-} {-# LINE 1390 "Network\Socket.hsc" #-} {-# LINE 1393 "Network\Socket.hsc" #-} {-# LINE 1396 "Network\Socket.hsc" #-} {-# LINE 1399 "Network\Socket.hsc" #-} {-# LINE 1402 "Network\Socket.hsc" #-} {-# LINE 1405 "Network\Socket.hsc" #-} {-# LINE 1408 "Network\Socket.hsc" #-} {-# LINE 1411 "Network\Socket.hsc" #-} {-# LINE 1414 "Network\Socket.hsc" #-} {-# LINE 1417 "Network\Socket.hsc" #-} {-# LINE 1420 "Network\Socket.hsc" #-} {-# LINE 1423 "Network\Socket.hsc" #-} {-# LINE 1426 "Network\Socket.hsc" #-} {-# LINE 1429 "Network\Socket.hsc" #-} {-# LINE 1432 "Network\Socket.hsc" #-} {-# LINE 1435 "Network\Socket.hsc" #-} {-# LINE 1438 "Network\Socket.hsc" #-} {-# LINE 1441 "Network\Socket.hsc" #-} {-# LINE 1444 "Network\Socket.hsc" #-} {-# LINE 1447 "Network\Socket.hsc" #-} {-# LINE 1450 "Network\Socket.hsc" #-} {-# LINE 1453 "Network\Socket.hsc" #-} {-# LINE 1456 "Network\Socket.hsc" #-} {-# LINE 1459 "Network\Socket.hsc" #-} {-# LINE 1462 "Network\Socket.hsc" #-} {-# LINE 1465 "Network\Socket.hsc" #-} {-# LINE 1468 "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" #-} -- Socket Types. -- | Socket Types. -- -- This data type might have different constructors depending on what is -- supported by the operating system. data SocketType = NoSocketType {-# LINE 1514 "Network\Socket.hsc" #-} | Stream {-# LINE 1516 "Network\Socket.hsc" #-} {-# LINE 1517 "Network\Socket.hsc" #-} | Datagram {-# LINE 1519 "Network\Socket.hsc" #-} {-# LINE 1520 "Network\Socket.hsc" #-} | Raw {-# LINE 1522 "Network\Socket.hsc" #-} {-# LINE 1523 "Network\Socket.hsc" #-} | RDM {-# LINE 1525 "Network\Socket.hsc" #-} {-# LINE 1526 "Network\Socket.hsc" #-} | SeqPacket {-# LINE 1528 "Network\Socket.hsc" #-} deriving (Eq, Ord, Read, Show) INSTANCE_TYPEABLE0(SocketType,socketTypeTc,"SocketType") packSocketType stype = case stype of NoSocketType -> 0 {-# LINE 1535 "Network\Socket.hsc" #-} Stream -> 1 {-# LINE 1536 "Network\Socket.hsc" #-} {-# LINE 1537 "Network\Socket.hsc" #-} {-# LINE 1538 "Network\Socket.hsc" #-} Datagram -> 2 {-# LINE 1539 "Network\Socket.hsc" #-} {-# LINE 1540 "Network\Socket.hsc" #-} {-# LINE 1541 "Network\Socket.hsc" #-} Raw -> 3 {-# LINE 1542 "Network\Socket.hsc" #-} {-# LINE 1543 "Network\Socket.hsc" #-} {-# LINE 1544 "Network\Socket.hsc" #-} RDM -> 4 {-# LINE 1545 "Network\Socket.hsc" #-} {-# LINE 1546 "Network\Socket.hsc" #-} {-# LINE 1547 "Network\Socket.hsc" #-} SeqPacket -> 5 {-# LINE 1548 "Network\Socket.hsc" #-} {-# LINE 1549 "Network\Socket.hsc" #-} unpackSocketType t = case t of 0 -> NoSocketType {-# LINE 1553 "Network\Socket.hsc" #-} (1) -> Stream {-# LINE 1554 "Network\Socket.hsc" #-} {-# LINE 1555 "Network\Socket.hsc" #-} {-# LINE 1556 "Network\Socket.hsc" #-} (2) -> Datagram {-# LINE 1557 "Network\Socket.hsc" #-} {-# LINE 1558 "Network\Socket.hsc" #-} {-# LINE 1559 "Network\Socket.hsc" #-} (3) -> Raw {-# LINE 1560 "Network\Socket.hsc" #-} {-# LINE 1561 "Network\Socket.hsc" #-} {-# LINE 1562 "Network\Socket.hsc" #-} (4) -> RDM {-# LINE 1563 "Network\Socket.hsc" #-} {-# LINE 1564 "Network\Socket.hsc" #-} {-# LINE 1565 "Network\Socket.hsc" #-} (5) -> SeqPacket {-# LINE 1566 "Network\Socket.hsc" #-} {-# LINE 1567 "Network\Socket.hsc" #-} -- --------------------------------------------------------------------------- -- Utility Functions aNY_PORT :: PortNumber aNY_PORT = 0 -- | The IPv4 wild card address. iNADDR_ANY :: HostAddress iNADDR_ANY = htonl (0) {-# LINE 1578 "Network\Socket.hsc" #-} {-# LINE 1585 "Network\Socket.hsc" #-} sOMAXCONN :: Int sOMAXCONN = 5 {-# LINE 1588 "Network\Socket.hsc" #-} sOL_SOCKET :: Int sOL_SOCKET = 65535 {-# LINE 1591 "Network\Socket.hsc" #-} {-# LINE 1596 "Network\Socket.hsc" #-} maxListenQueue :: Int maxListenQueue = sOMAXCONN -- ----------------------------------------------------------------------------- data ShutdownCmd = ShutdownReceive | ShutdownSend | ShutdownBoth INSTANCE_TYPEABLE0(ShutdownCmd,shutdownCmdTc,"ShutdownCmd") sdownCmdToInt :: ShutdownCmd -> CInt sdownCmdToInt ShutdownReceive = 0 sdownCmdToInt ShutdownSend = 1 sdownCmdToInt ShutdownBoth = 2 shutdown :: Socket -> ShutdownCmd -> IO () shutdown (MkSocket s _ _ _ _) stype = do throwSocketErrorIfMinus1Retry "shutdown" (c_shutdown s (sdownCmdToInt stype)) return () -- ----------------------------------------------------------------------------- -- | Closes a socket sClose :: Socket -> IO () sClose (MkSocket s _ _ _ socketStatus) = do withMVar socketStatus $ \ status -> if status == ConvertedToHandle then ioError (userError ("sClose: converted to a Handle, use hClose instead")) else c_close s; return () -- ----------------------------------------------------------------------------- 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 1664 "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 1694 "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 1701 "Network\Socket.hsc" #-} h <- fdToHandle' (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-} {-# LINE 1707 "Network\Socket.hsc" #-} return (ConvertedToHandle, h) {-# LINE 1712 "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] unpackBits [] 0 = [] unpackBits [] r = error ("unpackBits: unhandled bits set: " ++ show r) unpackBits ((k,v):xs) r | r .&. v /= 0 = k : unpackBits xs (r .&. complement v) | otherwise = unpackBits xs r ----------------------------------------------------------------------------- -- Address and service lookups {-# LINE 2072 "Network\Socket.hsc" #-} mkInvalidRecvArgError :: String -> IOError mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError {-# LINE 2076 "Network\Socket.hsc" #-} InvalidArgument {-# LINE 2080 "Network\Socket.hsc" #-} loc Nothing Nothing) "non-positive length" mkEOFError :: String -> IOError mkEOFError loc = ioeSetErrorString (mkIOError EOF loc Nothing Nothing) "end of file" -- --------------------------------------------------------------------------- -- WinSock support {-| On Windows operating systems, the networking subsystem has to be initialised using 'withSocketsDo' before any networking operations can be used. eg. > main = withSocketsDo $ do {...} Although this is only strictly necessary on Windows platforms, it is harmless on other platforms, so for portability it is good practice to use it all the time. -} withSocketsDo :: IO a -> IO a {-# LINE 2102 "Network\Socket.hsc" #-} withSocketsDo act = do x <- initWinSock if ( x /= 0 ) then ioError (userError "Failed to initialise WinSock") else do act `Control.Exception.finally` shutdownWinSock foreign import ccall unsafe "initWinSock" initWinSock :: IO Int foreign import ccall unsafe "shutdownWinSock" shutdownWinSock :: IO () {-# LINE 2113 "Network\Socket.hsc" #-} -- --------------------------------------------------------------------------- -- 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 {-# LINE 2130 "Network\Socket.hsc" #-} foreign import stdcall unsafe "closesocket" c_close :: CInt -> IO CInt {-# LINE 2133 "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 2148 "Network\Socket.hsc" #-} foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool {-# LINE 2150 "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 ----------------------------------------------------------------------------- -- Support for thread-safe blocking operations in GHC. {-# LINE 2201 "Network\Socket.hsc" #-} throwErrnoIfMinus1Retry_mayBlock name _ act = throwSocketErrorIfMinus1Retry name act throwErrnoIfMinus1Retry_repeatOnBlock name _ act = throwSocketErrorIfMinus1Retry name act throwSocketErrorIfMinus1_ :: Num a => String -> IO a -> IO () throwSocketErrorIfMinus1_ name act = do throwSocketErrorIfMinus1Retry name act return () {-# LINE 2214 "Network\Socket.hsc" #-} throwSocketErrorIfMinus1Retry name act = do r <- act if (r == -1) then do rc <- c_getLastError case rc of 10093 -> do -- WSANOTINITIALISED withSocketsDo (return ()) r <- act if (r == -1) then (c_getLastError >>= throwSocketError name) else return r _ -> throwSocketError name rc else return r throwSocketError name rc = do pstr <- c_getWSError rc str <- peekCString pstr {-# LINE 2233 "Network\Socket.hsc" #-} ioError (ioeSetErrorString (mkIOError OtherError name Nothing Nothing) str) {-# LINE 2237 "Network\Socket.hsc" #-} foreign import CALLCONV unsafe "WSAGetLastError" c_getLastError :: IO CInt foreign import ccall unsafe "getWSErrorDescr" c_getWSError :: CInt -> IO (Ptr CChar) {-# LINE 2247 "Network\Socket.hsc" #-} {-# LINE 2248 "Network\Socket.hsc" #-}