{-# LANGUAGE CPP #-} #include "HsNetDef.h" moduleNetwork.Socket.SyscallwhereimportForeign.Marshal.Utils(with)importqualifiedControl.ExceptionasE # if defined(mingw32_HOST_OS) importSystem.IO.Error(catchIOError) #endif #if defined(mingw32_HOST_OS) importForeign(FunPtr)importGHC.Conc(asyncDoProc) #else importForeign.C.Error(getErrno,eINTR,eINPROGRESS)importGHC.Conc(threadWaitWrite) #endif #ifdef HAVE_ADVANCED_SOCKET_FLAGS importNetwork.Socket.Cbits #else importNetwork.Socket.Fcntl #endif importNetwork.Socket.Imports importNetwork.Socket.Internal importNetwork.Socket.Options importNetwork.Socket.Types -- ------------------------------------------------------------------------------ On Windows, our sockets are not put in non-blocking mode (non-blocking-- is not supported for regular file descriptors on Windows, and it would-- be a pain to support it only for sockets). So there are two cases:---- - the threaded RTS uses safe calls for socket operations to get-- non-blocking I/O, just like the rest of the I/O library---- - with the non-threaded RTS, only some operations on sockets will be-- non-blocking. Reads and writes go through the normal async I/O-- system. accept() uses asyncDoProc so is non-blocking. A handful-- of others (recvFrom, sendFd, recvFd) will block all threads - if this-- is a problem, -threaded is the workaround.--------------------------------------------------------------------------------- Connection Functions-- In the following connection and binding primitives. The names of-- the equivalent C functions have been preserved where possible. It-- should be noted that some of these names used in the C library,-- \tr{bind} in particular, have a different meaning to many Haskell-- programmers and have thus been renamed by appending the prefix-- Socket.-- | Create a new socket using the given address family, socket type-- and protocol number. The address family is usually 'AF_INET',-- 'AF_INET6', or 'AF_UNIX'. The socket type is usually 'Stream' or-- 'Datagram'. The protocol number is usually 'defaultProtocol'.-- If 'AF_INET6' is used and the socket type is 'Stream' or 'Datagram',-- the 'IPv6Only' socket option is set to 0 so that both IPv4 and IPv6-- can be handled with one socket.---- >>> import Network.Socket-- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream }-- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "5000")-- >>> sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)-- >>> Network.Socket.bind sock (addrAddress addr)-- >>> getSocketName sock-- 127.0.0.1:5000socket ::Family -- Family Name (usually AF_INET)->SocketType -- Socket Type (usually Stream)->ProtocolNumber -- Protocol Number (getProtocolByName to find value)->IOSocket -- Unconnected Socketsocket :: Family -> SocketType -> ProtocolNumber -> IO Socket socket Family family SocketType stype ProtocolNumber protocol =IO ProtocolNumber -> (ProtocolNumber -> IO ProtocolNumber) -> (ProtocolNumber -> IO Socket) -> IO Socket forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c E.bracketOnErrorIO ProtocolNumber create ProtocolNumber -> IO ProtocolNumber c_close ((ProtocolNumber -> IO Socket) -> IO Socket) -> (ProtocolNumber -> IO Socket) -> IO Socket forall a b. (a -> b) -> a -> b $\ProtocolNumber fd ->do-- Let's ensure that the socket (file descriptor) is closed even on-- asynchronous exceptions.ProtocolNumber -> IO () forall (m :: * -> *) p. Monad m => p -> m () setNonBlock ProtocolNumber fd Socket s <-ProtocolNumber -> IO Socket mkSocket ProtocolNumber fd -- This socket is not managed by the IO manager yet.-- So, we don't have to call "close" which uses "closeFdWith".Socket -> IO () unsetIPv6Only Socket s Socket -> IO Socket forall (m :: * -> *) a. Monad m => a -> m a returnSocket s wherecreate :: IO ProtocolNumber create =doletc_stype :: ProtocolNumber c_stype =ProtocolNumber -> ProtocolNumber modifyFlag (ProtocolNumber -> ProtocolNumber) -> ProtocolNumber -> ProtocolNumber forall a b. (a -> b) -> a -> b $SocketType -> ProtocolNumber packSocketType SocketType stype String -> IO ProtocolNumber -> IO ProtocolNumber forall a. (Eq a, Num a) => String -> IO a -> IO a throwSocketErrorIfMinus1Retry String "Network.Socket.socket"(IO ProtocolNumber -> IO ProtocolNumber) -> IO ProtocolNumber -> IO ProtocolNumber forall a b. (a -> b) -> a -> b $ProtocolNumber -> ProtocolNumber -> ProtocolNumber -> IO ProtocolNumber c_socket (Family -> ProtocolNumber packFamily Family family )ProtocolNumber c_stype ProtocolNumber protocol #ifdef HAVE_ADVANCED_SOCKET_FLAGS modifyFlag :: ProtocolNumber -> ProtocolNumber modifyFlag ProtocolNumber c_stype =ProtocolNumber c_stype ProtocolNumber -> ProtocolNumber -> ProtocolNumber forall a. Bits a => a -> a -> a .|.ProtocolNumber sockNonBlock #else modifyFlagc_stype=c_stype #endif #ifdef HAVE_ADVANCED_SOCKET_FLAGS setNonBlock :: p -> m () setNonBlock p _=() -> m () forall (m :: * -> *) a. Monad m => a -> m a return() #else setNonBlockfd=setNonBlockIfNeededfd #endif #if HAVE_DECL_IPV6_V6ONLY unsetIPv6Only :: Socket -> IO () unsetIPv6Only Socket s =Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when(Family family Family -> Family -> Bool forall a. Eq a => a -> a -> Bool ==Family AF_INET6 Bool -> Bool -> Bool &&SocketType stype SocketType -> [SocketType] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem`[SocketType Stream ,SocketType Datagram ])(IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ # if defined(mingw32_HOST_OS) -- The IPv6Only option is only supported on Windows Vista and later,-- so trying to change it might throw an error.setSocketOptionsIPv6Only0`catchIOError`\_->return() # elif defined(openbsd_HOST_OS) -- don't change IPv6Onlyreturn() # else -- The default value of the IPv6Only option is platform specific,-- so we explicitly set it to 0 to provide a common default.Socket -> SocketOption -> Int -> IO () setSocketOption Socket s SocketOption IPv6Only Int 0 # endif #else unsetIPv6Only_=return() #endif ------------------------------------------------------------------------------- Binding a socket-- | Bind the socket to an address. The socket must not already be-- bound. The 'Family' passed to @bind@ must be the-- same as that passed to 'socket'. If the special port number-- 'defaultPort' is passed then the system assigns the next available-- use port.bind ::SocketAddress sa =>Socket ->sa ->IO()bind :: Socket -> sa -> IO () bind Socket s sa sa =sa -> (Ptr sa -> Int -> IO ()) -> IO () forall sa a. SocketAddress sa => sa -> (Ptr sa -> Int -> IO a) -> IO a withSocketAddress sa sa ((Ptr sa -> Int -> IO ()) -> IO ()) -> (Ptr sa -> Int -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $\Ptr sa p_sa Int siz ->IO ProtocolNumber -> IO () forall (f :: * -> *) a. Functor f => f a -> f () void(IO ProtocolNumber -> IO ()) -> IO ProtocolNumber -> IO () forall a b. (a -> b) -> a -> b $Socket -> (ProtocolNumber -> IO ProtocolNumber) -> IO ProtocolNumber forall r. Socket -> (ProtocolNumber -> IO r) -> IO r withFdSocket Socket s ((ProtocolNumber -> IO ProtocolNumber) -> IO ProtocolNumber) -> (ProtocolNumber -> IO ProtocolNumber) -> IO ProtocolNumber forall a b. (a -> b) -> a -> b $\ProtocolNumber fd ->doletsz :: ProtocolNumber sz =Int -> ProtocolNumber forall a b. (Integral a, Num b) => a -> b fromIntegralInt siz String -> IO ProtocolNumber -> IO ProtocolNumber forall a. (Eq a, Num a) => String -> IO a -> IO a throwSocketErrorIfMinus1Retry String "Network.Socket.bind"(IO ProtocolNumber -> IO ProtocolNumber) -> IO ProtocolNumber -> IO ProtocolNumber forall a b. (a -> b) -> a -> b $ProtocolNumber -> Ptr sa -> ProtocolNumber -> IO ProtocolNumber forall sa. ProtocolNumber -> Ptr sa -> ProtocolNumber -> IO ProtocolNumber c_bind ProtocolNumber fd Ptr sa p_sa ProtocolNumber sz ------------------------------------------------------------------------------- Connecting a socket-- | Connect to a remote socket at address.connect ::SocketAddress sa =>Socket ->sa ->IO()connect :: Socket -> sa -> IO () connect Socket s sa sa =IO () -> IO () forall a. IO a -> IO a withSocketsDo (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $sa -> (Ptr sa -> Int -> IO ()) -> IO () forall sa a. SocketAddress sa => sa -> (Ptr sa -> Int -> IO a) -> IO a withSocketAddress sa sa ((Ptr sa -> Int -> IO ()) -> IO ()) -> (Ptr sa -> Int -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $\Ptr sa p_sa Int sz ->Socket -> Ptr sa -> ProtocolNumber -> IO () forall sa. SocketAddress sa => Socket -> Ptr sa -> ProtocolNumber -> IO () connectLoop Socket s Ptr sa p_sa (Int -> ProtocolNumber forall a b. (Integral a, Num b) => a -> b fromIntegralInt sz )connectLoop ::SocketAddress sa =>Socket ->Ptrsa ->CInt->IO()connectLoop :: Socket -> Ptr sa -> ProtocolNumber -> IO () connectLoop Socket s Ptr sa p_sa ProtocolNumber sz =Socket -> (ProtocolNumber -> IO ()) -> IO () forall r. Socket -> (ProtocolNumber -> IO r) -> IO r withFdSocket Socket s ((ProtocolNumber -> IO ()) -> IO ()) -> (ProtocolNumber -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $\ProtocolNumber fd ->ProtocolNumber -> IO () loop ProtocolNumber fd whereerrLoc :: String errLoc =String "Network.Socket.connect: "String -> String -> String forall a. [a] -> [a] -> [a] ++Socket -> String forall a. Show a => a -> String showSocket s loop :: ProtocolNumber -> IO () loop ProtocolNumber fd =doProtocolNumber r <-ProtocolNumber -> Ptr sa -> ProtocolNumber -> IO ProtocolNumber forall sa. ProtocolNumber -> Ptr sa -> ProtocolNumber -> IO ProtocolNumber c_connect ProtocolNumber fd Ptr sa p_sa ProtocolNumber sz Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when(ProtocolNumber r ProtocolNumber -> ProtocolNumber -> Bool forall a. Eq a => a -> a -> Bool ==-ProtocolNumber 1)(IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $do #if defined(mingw32_HOST_OS) throwSocketErrorerrLoc #else Errno err <-IO Errno getErrnocase()of() _|Errno err Errno -> Errno -> Bool forall a. Eq a => a -> a -> Bool ==Errno eINTR->ProtocolNumber -> IO () loop ProtocolNumber fd () _|Errno err Errno -> Errno -> Bool forall a. Eq a => a -> a -> Bool ==Errno eINPROGRESS->IO () connectBlocked -- _ | err == eAGAIN -> connectBlocked() _otherwise ->String -> IO () forall a. String -> IO a throwSocketError String errLoc connectBlocked :: IO () connectBlocked =doSocket -> (ProtocolNumber -> IO ()) -> IO () forall r. Socket -> (ProtocolNumber -> IO r) -> IO r withFdSocket Socket s ((ProtocolNumber -> IO ()) -> IO ()) -> (ProtocolNumber -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $Fd -> IO () threadWaitWrite(Fd -> IO ()) -> (ProtocolNumber -> Fd) -> ProtocolNumber -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c .ProtocolNumber -> Fd forall a b. (Integral a, Num b) => a -> b fromIntegralInt err <-Socket -> SocketOption -> IO Int getSocketOption Socket s SocketOption SoError Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when(Int err Int -> Int -> Bool forall a. Eq a => a -> a -> Bool /=Int 0)(IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $String -> ProtocolNumber -> IO () forall a. String -> ProtocolNumber -> IO a throwSocketErrorCode String errLoc (Int -> ProtocolNumber forall a b. (Integral a, Num b) => a -> b fromIntegralInt err ) #endif ------------------------------------------------------------------------------- Listen-- | Listen for connections made to the socket. The second argument-- specifies the maximum number of queued connections and should be at-- least 1; the maximum value is system-dependent (usually 5).listen ::Socket ->Int->IO()listen :: Socket -> Int -> IO () listen Socket s Int backlog =Socket -> (ProtocolNumber -> IO ()) -> IO () forall r. Socket -> (ProtocolNumber -> IO r) -> IO r withFdSocket Socket s ((ProtocolNumber -> IO ()) -> IO ()) -> (ProtocolNumber -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $\ProtocolNumber fd ->doString -> IO ProtocolNumber -> IO () forall a. (Eq a, Num a) => String -> IO a -> IO () throwSocketErrorIfMinus1Retry_ String "Network.Socket.listen"(IO ProtocolNumber -> IO ()) -> IO ProtocolNumber -> IO () forall a b. (a -> b) -> a -> b $ProtocolNumber -> ProtocolNumber -> IO ProtocolNumber c_listen ProtocolNumber fd (ProtocolNumber -> IO ProtocolNumber) -> ProtocolNumber -> IO ProtocolNumber forall a b. (a -> b) -> a -> b $Int -> ProtocolNumber forall a b. (Integral a, Num b) => a -> b fromIntegralInt backlog ------------------------------------------------------------------------------- Accept---- A call to `accept' only returns when data is available on the given-- socket, unless the socket has been set to non-blocking. It will-- return a new socket which should be used to read the incoming data and-- should then be closed. Using the socket returned by `accept' allows-- incoming requests to be queued on the original socket.-- | Accept a connection. The socket must be bound to an address and-- listening for connections. The return value is a pair @(conn,-- address)@ where @conn@ is a new socket object usable to send and-- receive data on the connection, and @address@ is the address bound-- to the socket on the other end of the connection.-- On Unix, FD_CLOEXEC is set to the new 'Socket'.accept ::SocketAddress sa =>Socket ->IO(Socket ,sa )accept :: Socket -> IO (Socket, sa) accept Socket listing_sock =(Ptr sa -> Int -> IO (Socket, sa)) -> IO (Socket, sa) forall sa a. SocketAddress sa => (Ptr sa -> Int -> IO a) -> IO a withNewSocketAddress ((Ptr sa -> Int -> IO (Socket, sa)) -> IO (Socket, sa)) -> (Ptr sa -> Int -> IO (Socket, sa)) -> IO (Socket, sa) forall a b. (a -> b) -> a -> b $\Ptr sa new_sa Int sz ->Socket -> (ProtocolNumber -> IO (Socket, sa)) -> IO (Socket, sa) forall r. Socket -> (ProtocolNumber -> IO r) -> IO r withFdSocket Socket listing_sock ((ProtocolNumber -> IO (Socket, sa)) -> IO (Socket, sa)) -> (ProtocolNumber -> IO (Socket, sa)) -> IO (Socket, sa) forall a b. (a -> b) -> a -> b $\ProtocolNumber listing_fd ->doSocket new_sock <-ProtocolNumber -> Ptr sa -> Int -> IO ProtocolNumber forall a sa. Integral a => ProtocolNumber -> Ptr sa -> a -> IO ProtocolNumber callAccept ProtocolNumber listing_fd Ptr sa new_sa Int sz IO ProtocolNumber -> (ProtocolNumber -> IO Socket) -> IO Socket forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>=ProtocolNumber -> IO Socket mkSocket sa new_addr <-Ptr sa -> IO sa forall sa. SocketAddress sa => Ptr sa -> IO sa peekSocketAddress Ptr sa new_sa (Socket, sa) -> IO (Socket, sa) forall (m :: * -> *) a. Monad m => a -> m a return(Socket new_sock ,sa new_addr )where #if defined(mingw32_HOST_OS) callAcceptfdsasz|threaded=with(fromIntegralsz)$\ptr_len->throwSocketErrorIfMinus1Retry"Network.Socket.accept"$c_accept_safefdsaptr_len|otherwise=doparamData<-c_newAcceptParamsfd(fromIntegralsz)sarc<-asyncDoProcc_acceptDoProcparamDatanew_fd<-c_acceptNewSockparamDatac_freeparamDatawhen(rc/=0)$throwSocketErrorCode"Network.Socket.accept"(fromIntegralrc)returnnew_fd #else callAccept :: ProtocolNumber -> Ptr sa -> a -> IO ProtocolNumber callAccept ProtocolNumber fd Ptr sa sa a sz =ProtocolNumber -> (Ptr ProtocolNumber -> IO ProtocolNumber) -> IO ProtocolNumber forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b with(a -> ProtocolNumber forall a b. (Integral a, Num b) => a -> b fromIntegrala sz )((Ptr ProtocolNumber -> IO ProtocolNumber) -> IO ProtocolNumber) -> (Ptr ProtocolNumber -> IO ProtocolNumber) -> IO ProtocolNumber forall a b. (a -> b) -> a -> b $\Ptr ProtocolNumber ptr_len ->do # ifdef HAVE_ADVANCED_SOCKET_FLAGS Socket -> String -> IO ProtocolNumber -> IO ProtocolNumber forall a. (Eq a, Num a) => Socket -> String -> IO a -> IO a throwSocketErrorWaitRead Socket listing_sock String "Network.Socket.accept"(ProtocolNumber -> Ptr sa -> Ptr ProtocolNumber -> ProtocolNumber -> IO ProtocolNumber forall sa. ProtocolNumber -> Ptr sa -> Ptr ProtocolNumber -> ProtocolNumber -> IO ProtocolNumber c_accept4 ProtocolNumber fd Ptr sa sa Ptr ProtocolNumber ptr_len (ProtocolNumber sockNonBlock ProtocolNumber -> ProtocolNumber -> ProtocolNumber forall a. Bits a => a -> a -> a .|.ProtocolNumber sockCloexec )) # else new_fd<-throwSocketErrorWaitReadlisting_sock"Network.Socket.accept"(c_acceptfdsaptr_len)setNonBlockIfNeedednew_fdsetCloseOnExecIfNeedednew_fdreturnnew_fd # endif /* HAVE_ADVANCED_SOCKET_FLAGS */ #endif foreignimportCALLCONVunsafe"socket"c_socket ::CInt->CInt->CInt->IOCIntforeignimportCALLCONVunsafe"bind"c_bind ::CInt->Ptrsa ->CInt{-CSockLen???-}->IOCIntforeignimportCALLCONVSAFE_ON_WIN"connect"c_connect ::CInt->Ptrsa ->CInt{-CSockLen???-}->IOCIntforeignimportCALLCONVunsafe"listen"c_listen ::CInt->CInt->IOCInt #ifdef HAVE_ADVANCED_SOCKET_FLAGS foreignimportCALLCONVunsafe"accept4"c_accept4 ::CInt->Ptrsa ->PtrCInt{-CSockLen???-}->CInt->IOCInt #else foreignimportCALLCONVunsafe"accept"c_accept::CInt->Ptrsa->PtrCInt{-CSockLen???-}->IOCInt #endif #if defined(mingw32_HOST_OS) foreignimportCALLCONVsafe"accept"c_accept_safe::CInt->Ptrsa->PtrCInt{-CSockLen???-}->IOCIntforeignimportccallunsafe"rtsSupportsBoundThreads"threaded::Boolforeignimportccallunsafe"HsNet.h acceptNewSock"c_acceptNewSock::Ptr()->IOCIntforeignimportccallunsafe"HsNet.h newAcceptParams"c_newAcceptParams::CInt->CInt->Ptra->IO(Ptr())foreignimportccallunsafe"HsNet.h &acceptDoProc"c_acceptDoProc::FunPtr(Ptr()->IOInt)foreignimportccallunsafe"free"c_free::Ptra->IO() #endif