{-# LANGUAGE CPP #-}{-# LANGUAGE ScopedTypeVariables #-}#include "HsNetDef.h"
moduleNetwork.Socket.SyscallwhereimportForeign.Marshal.Utils(with)importqualifiedControl.ExceptionasE#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 familystype protocol =E.bracketOnErrorcreate c_close $\fd ->do-- Let's ensure that the socket (file descriptor) is closed even on-- asynchronous exceptions.setNonBlock fd s <-mkSocket fd -- This socket is not managed by the IO manager yet.-- So, we don't have to call "close" which uses "closeFdWith".unsetIPv6Only s returns wherecreate =doc_stype <-modifyFlag <$>packSocketTypeOrThrow "socket"stype throwSocketErrorIfMinus1Retry "Network.Socket.socket"$c_socket (packFamily family)c_stype protocol #ifdef HAVE_ADVANCED_SOCKET_FLAGS
modifyFlag c_stype =c_stype .|.sockNonBlock #else
modifyFlagc_stype=c_stype#endif
#ifdef HAVE_ADVANCED_SOCKET_FLAGS
setNonBlock _=return()#else
setNonBlockfd=setNonBlockIfNeededfd#endif
#if HAVE_DECL_IPV6_V6ONLY
unsetIPv6Only s =when(family==AF_INET6 &&stype `elem`[Stream ,Datagram ])$# if defined(mingw32_HOST_OS)
-- The IPv6Only option is only supported on Windows Vista and later,-- so trying to change it might throw an error.E.catch(setSocketOptionsIPv6Only0)$(\(_::E.IOException)->return())# elif defined(__OpenBSD__)
-- 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.setSocketOption s IPv6Only 0# endif
#else
unsetIPv6Only_=return()#endif
------------------------------------------------------------------------------- Binding a socket-- | Bind the socket to an address. The socket must not already be-- bound. The 'Family' passed to @bind@ must be the-- same as that passed to 'socket'. If the special port number-- 'defaultPort' is passed then the system assigns the next available-- use port.bind::SocketAddress sa =>Socket ->sa ->IO()bind s sa =withSocketAddress sa $\p_sa siz ->void$withFdSocket s $\fd ->doletsz =fromIntegralsiz throwSocketErrorIfMinus1Retry "Network.Socket.bind"$c_bind fd p_sa sz ------------------------------------------------------------------------------- Connecting a socket-- | Connect to a remote socket at address.connect::SocketAddress sa =>Socket ->sa ->IO()connect s sa =withSocketsDo $withSocketAddress sa $\p_sa sz ->connectLoop s p_sa (fromIntegralsz )connectLoop::SocketAddress sa =>Socket ->Ptrsa ->CInt->IO()connectLoop s p_sa sz =withFdSocket s $\fd ->loop fd whereerrLoc ="Network.Socket.connect: "++shows loop fd =dor <-c_connect fd p_sa sz when(r ==-1)$do#if defined(mingw32_HOST_OS)
throwSocketErrorerrLoc#else
err <-getErrnocase()of_|err ==eINTR->loop fd _|err ==eINPROGRESS->connectBlocked -- _ | err == eAGAIN -> connectBlocked_otherwise ->throwSocketError errLoc connectBlocked =dowithFdSocket s $threadWaitWrite.fromIntegralerr <-getSocketOption s SoError when(err /=0)$throwSocketErrorCode errLoc (fromIntegralerr )#endif
------------------------------------------------------------------------------- Listen-- | Listen for connections made to the socket. The second argument-- specifies the maximum number of queued connections and should be at-- least 1; the maximum value is system-dependent (usually 5).listen::Socket ->Int->IO()listen s backlog =withFdSocket s $\fd ->dothrowSocketErrorIfMinus1Retry_ "Network.Socket.listen"$c_listen fd $fromIntegralbacklog ------------------------------------------------------------------------------- Accept---- A call to `accept' only returns when data is available on the given-- socket, unless the socket has been set to non-blocking. It will-- return a new socket which should be used to read the incoming data and-- should then be closed. Using the socket returned by `accept' allows-- incoming requests to be queued on the original socket.-- | Accept a connection. The socket must be bound to an address and-- listening for connections. The return value is a pair @(conn,-- address)@ where @conn@ is a new socket object usable to send and-- receive data on the connection, and @address@ is the address bound-- to the socket on the other end of the connection.-- On Unix, FD_CLOEXEC is set to the new 'Socket'.accept::SocketAddress sa =>Socket ->IO(Socket ,sa )accept listing_sock =withNewSocketAddress $\new_sa sz ->withFdSocket listing_sock $\listing_fd ->donew_sock <-callAccept listing_fd new_sa sz >>=mkSocket new_addr <-peekSocketAddress new_sa return(new_sock ,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 fd sa sz =with(fromIntegralsz )$\ptr_len ->do# ifdef HAVE_ADVANCED_SOCKET_FLAGS
throwSocketErrorWaitRead listing_sock "Network.Socket.accept"(c_accept4 fd sa ptr_len (sockNonBlock .|.sockCloexec ))# else
new_fd<-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