1{-# LANGUAGE CPP, ScopedTypeVariables, RecordWildCards #-} 2{-# OPTIONS_GHC -fno-warn-orphans #-} 3{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 4----------------------------------------------------------------------------- 5-- | 6-- Module : Network.Socket 7-- Copyright : (c) The University of Glasgow 2001 8-- License : BSD-style (see the file libraries/network/LICENSE) 9-- 10-- Maintainer : libraries@haskell.org 11-- Stability : provisional 12-- Portability : portable 13-- 14-- This is the main module of the network package supposed to be 15-- used with either "Network.Socket.ByteString" or 16-- "Network.Socket.ByteString.Lazy" for sending/receiving. 17-- 18-- Here are two minimal example programs using the TCP/IP protocol: a 19-- server that echoes all data that it receives back (servicing only 20-- one client) and a client using it. 21-- 22-- > -- Echo server program 23-- > module Main (main) where 24-- > 25-- > import Control.Concurrent (forkFinally) 26-- > import qualified Control.Exception as E 27-- > import Control.Monad (unless, forever, void) 28-- > import qualified Data.ByteString as S 29-- > import Network.Socket hiding (recv) 30-- > import Network.Socket.ByteString (recv, sendAll) 31-- > 32-- > main :: IO () 33-- > main = withSocketsDo $ do 34-- > addr <- resolve "3000" 35-- > E.bracket (open addr) close loop 36-- > where 37-- > resolve port = do 38-- > let hints = defaultHints { 39-- > addrFlags = [AI_PASSIVE] 40-- > , addrSocketType = Stream 41-- > } 42-- > addr:_ <- getAddrInfo (Just hints) Nothing (Just port) 43-- > return addr 44-- > open addr = do 45-- > sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) 46-- > setSocketOption sock ReuseAddr 1 47-- > bind sock (addrAddress addr) 48-- > -- If the prefork technique is not used, 49-- > -- set CloseOnExec for the security reasons. 50-- > let fd = fdSocket sock 51-- > setCloseOnExecIfNeeded fd 52-- > listen sock 10 53-- > return sock 54-- > loop sock = forever $ do 55-- > (conn, peer) <- accept sock 56-- > putStrLn $ "Connection from " ++ show peer 57-- > void $ forkFinally (talk conn) (\_ -> close conn) 58-- > talk conn = do 59-- > msg <- recv conn 1024 60-- > unless (S.null msg) $ do 61-- > sendAll conn msg 62-- > talk conn 63-- 64-- > {-# LANGUAGE OverloadedStrings #-} 65-- > -- Echo client program 66-- > module Main (main) where 67-- > 68-- > import qualified Control.Exception as E 69-- > import qualified Data.ByteString.Char8 as C 70-- > import Network.Socket hiding (recv) 71-- > import Network.Socket.ByteString (recv, sendAll) 72-- > 73-- > main :: IO () 74-- > main = withSocketsDo $ do 75-- > addr <- resolve "127.0.0.1" "3000" 76-- > E.bracket (open addr) close talk 77-- > where 78-- > resolve host port = do 79-- > let hints = defaultHints { addrSocketType = Stream } 80-- > addr:_ <- getAddrInfo (Just hints) (Just host) (Just port) 81-- > return addr 82-- > open addr = do 83-- > sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) 84-- > connect sock $ addrAddress addr 85-- > return sock 86-- > talk sock = do 87-- > sendAll sock "Hello, world!" 88-- > msg <- recv sock 1024 89-- > putStr "Received: " 90-- > C.putStrLn msg 91-- 92-- The proper programming model is that one 'Socket' is handled by 93-- a single thread. If multiple threads use one 'Socket' concurrently, 94-- unexpected things would happen. There is one exception for multiple 95-- threads vs a single 'Socket': one thread reads data from a 'Socket' 96-- only and the other thread writes data to the 'Socket' only. 97----------------------------------------------------------------------------- 98 99#include "HsNet.h" 100##include "HsNetDef.h" 101 102module Network.Socket 103 ( 104 -- * Initialisation 105 withSocketsDo 106 -- * Address information 107 , getAddrInfo 108 -- ** Types 109 , HostName 110 , ServiceName 111 , AddrInfo(..) 112 , defaultHints 113 -- ** Flags 114 , AddrInfoFlag(..) 115 , addrInfoFlagImplemented 116 -- * Socket operations 117 , connect 118 , bind 119 , listen 120 , accept 121 -- ** Closing 122 , close 123 , close' 124 , shutdown 125 , ShutdownCmd(..) 126 -- * Socket options 127 , SocketOption(..) 128 , isSupportedSocketOption 129 , getSocketOption 130 , setSocketOption 131 -- * Socket 132 , Socket(..) 133 , socket 134 , fdSocket 135 , mkSocket 136 , socketToHandle 137 -- ** Types of Socket 138 , SocketType(..) 139 , isSupportedSocketType 140 -- ** Family 141 , Family(..) 142 , isSupportedFamily 143 -- ** Protocol number 144 , ProtocolNumber 145 , defaultProtocol 146 -- * Socket address 147 , SockAddr(..) 148 , isSupportedSockAddr 149 , getPeerName 150 , getSocketName 151 -- ** Host address 152 , HostAddress 153 , hostAddressToTuple 154 , tupleToHostAddress 155#if defined(IPV6_SOCKET_SUPPORT) 156 -- ** Host address6 157 , HostAddress6 158 , hostAddress6ToTuple 159 , tupleToHostAddress6 160 -- ** Flow Info 161 , FlowInfo 162 -- ** Scope ID 163 , ScopeID 164# if defined(HAVE_IF_NAMETOINDEX) 165 , ifNameToIndex 166 , ifIndexToName 167# endif 168#endif 169 -- ** Port number 170 , PortNumber 171 , defaultPort 172 , socketPortSafe 173 , socketPort 174 -- * UNIX-domain socket 175 , isUnixDomainSocketAvailable 176 , socketPair 177 , sendFd 178 , recvFd 179 , getPeerCredential 180#if defined(IPV6_SOCKET_SUPPORT) 181 -- * Name information 182 , NameInfoFlag(..) 183 , getNameInfo 184#endif 185 -- * Low level operations 186 , setCloseOnExecIfNeeded 187 , getCloseOnExec 188 , setNonBlockIfNeeded 189 , getNonBlock 190 -- * Sending and receiving data 191 , sendBuf 192 , recvBuf 193 , sendBufTo 194 , recvBufFrom 195 -- * Special constants 196 , maxListenQueue 197 -- * Deprecated 198 -- ** Deprecated sending and receiving 199 , send 200 , sendTo 201 , recv 202 , recvFrom 203 , recvLen 204 -- ** Deprecated address functions 205 , htonl 206 , ntohl 207 , inet_addr 208 , inet_ntoa 209 -- ** Deprecated socket operations 210 , bindSocket 211 , sClose 212 -- ** Deprecated socket status 213 , SocketStatus(..) -- fixme 214 , isConnected 215 , isBound 216 , isListening 217 , isReadable 218 , isWritable 219 , sIsConnected 220 , sIsBound 221 , sIsListening 222 , sIsReadable 223 , sIsWritable 224 -- ** Deprecated special constants 225 , aNY_PORT 226 , iNADDR_ANY 227#if defined(IPV6_SOCKET_SUPPORT) 228 , iN6ADDR_ANY 229#endif 230 , sOMAXCONN 231 , sOL_SOCKET 232#ifdef SCM_RIGHTS 233 , sCM_RIGHTS 234#endif 235 -- ** Decrecated internal functions 236 , packFamily 237 , unpackFamily 238 , packSocketType 239 -- ** Decrecated UNIX-domain functions 240#if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID) 241 -- get the credentials of our domain socket peer. 242 , getPeerCred 243#if defined(HAVE_GETPEEREID) 244 , getPeerEid 245#endif 246#endif 247 ) where 248 249import Data.Bits 250import Data.Functor 251import Data.List (foldl') 252import Data.Maybe (isJust) 253import Data.Word (Word8, Word32) 254import Foreign.Ptr (Ptr, castPtr, nullPtr) 255import Foreign.Storable (Storable(..)) 256import Foreign.C.Error 257import Foreign.C.String (CString, withCString, withCStringLen, peekCString, peekCStringLen) 258import Foreign.C.Types (CUInt(..), CChar) 259import Foreign.C.Types (CInt(..), CSize(..)) 260import Foreign.Marshal.Alloc ( alloca, allocaBytes ) 261import Foreign.Marshal.Array ( peekArray ) 262import Foreign.Marshal.Utils ( maybeWith, with ) 263 264import System.IO 265import Control.Monad (liftM, when, void) 266 267import qualified Control.Exception as E 268import Control.Concurrent.MVar 269import Data.Typeable 270import System.IO.Error 271 272import GHC.Conc (threadWaitWrite) 273# ifdef HAVE_ACCEPT4 274import GHC.Conc (threadWaitRead) 275# endif 276##if MIN_VERSION_base(4,3,1) 277import GHC.Conc (closeFdWith) 278##endif 279# if defined(mingw32_HOST_OS) 280import GHC.Conc (asyncDoProc) 281import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr) 282import Foreign (FunPtr) 283# endif 284# if defined(darwin_HOST_OS) 285import Data.List (delete) 286# endif 287import qualified GHC.IO.Device 288import GHC.IO.Handle.FD 289import GHC.IO.Exception 290import GHC.IO 291import qualified System.Posix.Internals 292 293import Network.Socket.Internal 294import Network.Socket.Types 295 296import Prelude -- Silence AMP warnings 297 298-- | Either a host name e.g., @\"haskell.org\"@ or a numeric host 299-- address string consisting of a dotted decimal IPv4 address or an 300-- IPv6 address e.g., @\"192.168.0.1\"@. 301type HostName = String 302type ServiceName = String 303 304-- ---------------------------------------------------------------------------- 305-- On Windows, our sockets are not put in non-blocking mode (non-blocking 306-- is not supported for regular file descriptors on Windows, and it would 307-- be a pain to support it only for sockets). So there are two cases: 308-- 309-- - the threaded RTS uses safe calls for socket operations to get 310-- non-blocking I/O, just like the rest of the I/O library 311-- 312-- - with the non-threaded RTS, only some operations on sockets will be 313-- non-blocking. Reads and writes go through the normal async I/O 314-- system. accept() uses asyncDoProc so is non-blocking. A handful 315-- of others (recvFrom, sendFd, recvFd) will block all threads - if this 316-- is a problem, -threaded is the workaround. 317-- 318##if defined(mingw32_HOST_OS) 319##define SAFE_ON_WIN safe 320##else 321##define SAFE_ON_WIN unsafe 322##endif 323 324----------------------------------------------------------------------------- 325-- Socket types 326 327#if defined(mingw32_HOST_OS) 328socket2FD (MkSocket fd _ _ _ _) = 329 -- HACK, 1 means True 330 FD{fdFD = fd,fdIsSocket_ = 1} 331#endif 332 333-- | Smart constructor for constructing a 'Socket'. It should only be 334-- called once for every new file descriptor. The caller must make 335-- sure that the socket is in non-blocking mode. See 336-- 'setNonBlockIfNeeded'. 337mkSocket :: CInt 338 -> Family 339 -> SocketType 340 -> ProtocolNumber 341 -> SocketStatus 342 -> IO Socket 343mkSocket fd fam sType pNum stat = do 344 mStat <- newMVar stat 345 withSocketsDo $ return () 346 return $ MkSocket fd fam sType pNum mStat 347 348-- | This is the default protocol for a given service. 349defaultProtocol :: ProtocolNumber 350defaultProtocol = 0 351 352----------------------------------------------------------------------------- 353-- SockAddr 354 355instance Show SockAddr where 356#if defined(DOMAIN_SOCKET_SUPPORT) 357 showsPrec _ (SockAddrUnix str) = showString str 358#endif 359 showsPrec _ (SockAddrInet port ha) 360 = showString (unsafePerformIO (inet_ntoa ha)) 361 . showString ":" 362 . shows port 363#if defined(IPV6_SOCKET_SUPPORT) 364 showsPrec _ addr@(SockAddrInet6 port _ _ _) 365 = showChar '[' 366 . showString (unsafePerformIO $ 367 fst `liftM` getNameInfo [NI_NUMERICHOST] True False addr >>= 368 maybe (fail "showsPrec: impossible internal error") return) 369 . showString "]:" 370 . shows port 371#endif 372#if defined(CAN_SOCKET_SUPPORT) 373 showsPrec _ (SockAddrCan ifidx) = shows ifidx 374#endif 375#if !(defined(IPV6_SOCKET_SUPPORT) \ 376 && defined(DOMAIN_SOCKET_SUPPORT) && defined(CAN_SOCKET_SUPPORT)) 377 showsPrec _ _ = error "showsPrec: not supported" 378#endif 379 380----------------------------------------------------------------------------- 381-- Connection Functions 382 383-- In the following connection and binding primitives. The names of 384-- the equivalent C functions have been preserved where possible. It 385-- should be noted that some of these names used in the C library, 386-- \tr{bind} in particular, have a different meaning to many Haskell 387-- programmers and have thus been renamed by appending the prefix 388-- Socket. 389 390-- | Create a new socket using the given address family, socket type 391-- and protocol number. The address family is usually 'AF_INET', 392-- 'AF_INET6', or 'AF_UNIX'. The socket type is usually 'Stream' or 393-- 'Datagram'. The protocol number is usually 'defaultProtocol'. 394-- If 'AF_INET6' is used and the socket type is 'Stream' or 'Datagram', 395-- the 'IPv6Only' socket option is set to 0 so that both IPv4 and IPv6 396-- can be handled with one socket. 397-- 398-- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrSocketType = Stream } 399-- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "5000") 400-- >>> sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) 401-- >>> bind sock (addrAddress addr) 402-- >>> getSocketName sock 403-- 127.0.0.1:5000 404socket :: Family -- Family Name (usually AF_INET) 405 -> SocketType -- Socket Type (usually Stream) 406 -> ProtocolNumber -- Protocol Number (getProtocolByName to find value) 407 -> IO Socket -- Unconnected Socket 408socket family stype protocol = do 409 c_stype <- packSocketTypeOrThrow "socket" stype 410 fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $ 411 c_socket (packFamily family) c_stype protocol 412 setNonBlockIfNeeded fd 413 sock <- mkSocket fd family stype protocol NotConnected 414#if HAVE_DECL_IPV6_V6ONLY 415 -- The default value of the IPv6Only option is platform specific, 416 -- so we explicitly set it to 0 to provide a common default. 417# if defined(mingw32_HOST_OS) 418 -- The IPv6Only option is only supported on Windows Vista and later, 419 -- so trying to change it might throw an error. 420 when (family == AF_INET6 && (stype == Stream || stype == Datagram)) $ 421 E.catch (setSocketOption sock IPv6Only 0) $ (\(_ :: E.IOException) -> return ()) 422# elif !defined(__OpenBSD__) 423 when (family == AF_INET6 && (stype == Stream || stype == Datagram)) $ 424 setSocketOption sock IPv6Only 0 `onException` close sock 425# endif 426#endif 427 return sock 428 429-- | Build a pair of connected socket objects using the given address 430-- family, socket type, and protocol number. Address family, socket 431-- type, and protocol number are as for the 'socket' function above. 432-- Availability: Unix. 433socketPair :: Family -- Family Name (usually AF_INET or AF_INET6) 434 -> SocketType -- Socket Type (usually Stream) 435 -> ProtocolNumber -- Protocol Number 436 -> IO (Socket, Socket) -- unnamed and connected. 437#if defined(DOMAIN_SOCKET_SUPPORT) 438socketPair family stype protocol = do 439 allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do 440 c_stype <- packSocketTypeOrThrow "socketPair" stype 441 _rc <- throwSocketErrorIfMinus1Retry "Network.Socket.socketpair" $ 442 c_socketpair (packFamily family) c_stype protocol fdArr 443 [fd1,fd2] <- peekArray 2 fdArr 444 s1 <- mkNonBlockingSocket fd1 445 s2 <- mkNonBlockingSocket fd2 446 return (s1,s2) 447 where 448 mkNonBlockingSocket fd = do 449 setNonBlockIfNeeded fd 450 mkSocket fd family stype protocol Connected 451 452foreign import ccall unsafe "socketpair" 453 c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt 454#else 455socketPair _ _ _ = error "Network.Socket.socketPair" 456#endif 457 458----------------------------------------------------------------------------- 459 460#if defined(mingw32_HOST_OS) 461#else 462fGetFd :: CInt 463fGetFd = #const F_GETFD 464fGetFl :: CInt 465fGetFl = #const F_GETFL 466fdCloexec :: CInt 467fdCloexec = #const FD_CLOEXEC 468oNonBlock :: CInt 469oNonBlock = #const O_NONBLOCK 470# if defined(HAVE_ACCEPT4) 471sockNonBlock :: CInt 472sockNonBlock = #const SOCK_NONBLOCK 473sockCloexec :: CInt 474sockCloexec = #const SOCK_CLOEXEC 475# endif 476#endif 477 478-- | Set the nonblocking flag on Unix. 479-- On Windows, nothing is done. 480setNonBlockIfNeeded :: CInt -> IO () 481setNonBlockIfNeeded fd = 482 System.Posix.Internals.setNonBlockingFD fd True 483 484-- | Set the close_on_exec flag on Unix. 485-- On Windows, nothing is done. 486-- 487-- Since 2.7.0.0. 488setCloseOnExecIfNeeded :: CInt -> IO () 489#if defined(mingw32_HOST_OS) 490setCloseOnExecIfNeeded _ = return () 491#else 492setCloseOnExecIfNeeded fd = System.Posix.Internals.setCloseOnExec fd 493#endif 494 495#if !defined(mingw32_HOST_OS) 496foreign import ccall unsafe "fcntl" 497 c_fcntl_read :: CInt -> CInt -> CInt -> IO CInt 498#endif 499 500-- | Get the nonblocking flag. 501-- On Windows, this function always returns 'False'. 502-- 503-- Since 2.7.0.0. 504getCloseOnExec :: CInt -> IO Bool 505#if defined(mingw32_HOST_OS) 506getCloseOnExec _ = return False 507#else 508getCloseOnExec fd = do 509 flags <- c_fcntl_read fd fGetFd 0 510 let ret = flags .&. fdCloexec 511 return (ret /= 0) 512#endif 513 514-- | Get the close_on_exec flag. 515-- On Windows, this function always returns 'False'. 516-- 517-- Since 2.7.0.0. 518getNonBlock :: CInt -> IO Bool 519#if defined(mingw32_HOST_OS) 520getNonBlock _ = return False 521#else 522getNonBlock fd = do 523 flags <- c_fcntl_read fd fGetFl 0 524 let ret = flags .&. oNonBlock 525 return (ret /= 0) 526#endif 527 528----------------------------------------------------------------------------- 529-- Binding a socket 530 531-- | Bind the socket to an address. The socket must not already be 532-- bound. The 'Family' passed to @bind@ must be the 533-- same as that passed to 'socket'. If the special port number 534-- 'defaultPort' is passed then the system assigns the next available 535-- use port. 536bind :: Socket -- Unconnected Socket 537 -> SockAddr -- Address to Bind to 538 -> IO () 539bind (MkSocket s _family _stype _protocol socketStatus) addr = do 540 modifyMVar_ socketStatus $ \ status -> do 541 if status /= NotConnected 542 then 543 ioError $ userError $ 544 "Network.Socket.bind: can't bind to socket with status " ++ show status 545 else do 546 withSockAddr addr $ \p_addr sz -> do 547 _status <- throwSocketErrorIfMinus1Retry "Network.Socket.bind" $ 548 c_bind s p_addr (fromIntegral sz) 549 return Bound 550 551----------------------------------------------------------------------------- 552-- Connecting a socket 553 554-- | Connect to a remote socket at address. 555connect :: Socket -- Unconnected Socket 556 -> SockAddr -- Socket address stuff 557 -> IO () 558connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = withSocketsDo $ do 559 modifyMVar_ socketStatus $ \currentStatus -> do 560 if currentStatus /= NotConnected && currentStatus /= Bound 561 then 562 ioError $ userError $ 563 errLoc ++ ": can't connect to socket with status " ++ show currentStatus 564 else do 565 withSockAddr addr $ \p_addr sz -> do 566 567 let connectLoop = do 568 r <- c_connect s p_addr (fromIntegral sz) 569 if r == -1 570 then do 571#if !(defined(HAVE_WINSOCK2_H)) 572 err <- getErrno 573 case () of 574 _ | err == eINTR -> connectLoop 575 _ | err == eINPROGRESS -> connectBlocked 576-- _ | err == eAGAIN -> connectBlocked 577 _otherwise -> throwSocketError errLoc 578#else 579 throwSocketError errLoc 580#endif 581 else return () 582 583 connectBlocked = do 584 threadWaitWrite (fromIntegral s) 585 err <- getSocketOption sock SoError 586 if (err == 0) 587 then return () 588 else throwSocketErrorCode errLoc (fromIntegral err) 589 590 connectLoop 591 return Connected 592 where 593 errLoc = "Network.Socket.connect: " ++ show sock 594 595----------------------------------------------------------------------------- 596-- Listen 597 598-- | Listen for connections made to the socket. The second argument 599-- specifies the maximum number of queued connections and should be at 600-- least 1; the maximum value is system-dependent (usually 5). 601listen :: Socket -- Connected & Bound Socket 602 -> Int -- Queue Length 603 -> IO () 604listen (MkSocket s _family _stype _protocol socketStatus) backlog = do 605 modifyMVar_ socketStatus $ \ status -> do 606 if status /= Bound 607 then 608 ioError $ userError $ 609 "Network.Socket.listen: can't listen on socket with status " ++ show status 610 else do 611 throwSocketErrorIfMinus1Retry_ "Network.Socket.listen" $ 612 c_listen s (fromIntegral backlog) 613 return Listening 614 615----------------------------------------------------------------------------- 616-- Accept 617-- 618-- A call to `accept' only returns when data is available on the given 619-- socket, unless the socket has been set to non-blocking. It will 620-- return a new socket which should be used to read the incoming data and 621-- should then be closed. Using the socket returned by `accept' allows 622-- incoming requests to be queued on the original socket. 623 624-- | Accept a connection. The socket must be bound to an address and 625-- listening for connections. The return value is a pair @(conn, 626-- address)@ where @conn@ is a new socket object usable to send and 627-- receive data on the connection, and @address@ is the address bound 628-- to the socket on the other end of the connection. 629accept :: Socket -- Queue Socket 630 -> IO (Socket, -- Readable Socket 631 SockAddr) -- Peer details 632 633accept sock@(MkSocket s family stype protocol status) = do 634 currentStatus <- readMVar status 635 if not $ isAcceptable family stype currentStatus 636 then 637 ioError $ userError $ 638 "Network.Socket.accept: can't accept socket (" ++ 639 show (family, stype, protocol) ++ ") with status " ++ 640 show currentStatus 641 else do 642 let sz = sizeOfSockAddrByFamily family 643 allocaBytes sz $ \ sockaddr -> do 644 zeroMemory sockaddr $ fromIntegral sz 645#if defined(mingw32_HOST_OS) 646 new_sock <- 647 if threaded 648 then with (fromIntegral sz) $ \ ptr_len -> 649 throwSocketErrorIfMinus1Retry "Network.Socket.accept" $ 650 c_accept_safe s sockaddr ptr_len 651 else do 652 paramData <- c_newAcceptParams s (fromIntegral sz) sockaddr 653 rc <- asyncDoProc c_acceptDoProc paramData 654 new_sock <- c_acceptNewSock paramData 655 c_free paramData 656 when (rc /= 0) $ 657 throwSocketErrorCode "Network.Socket.accept" (fromIntegral rc) 658 return new_sock 659#else 660 with (fromIntegral sz) $ \ ptr_len -> do 661# ifdef HAVE_ACCEPT4 662 new_sock <- throwSocketErrorIfMinus1RetryMayBlock "Network.Socket.accept" 663 (threadWaitRead (fromIntegral s)) 664 (c_accept4 s sockaddr ptr_len (sockNonBlock .|. sockCloexec)) 665# else 666 new_sock <- throwSocketErrorWaitRead sock "Network.Socket.accept" 667 (c_accept s sockaddr ptr_len) 668 setNonBlockIfNeeded new_sock 669 setCloseOnExecIfNeeded new_sock 670# endif /* HAVE_ACCEPT4 */ 671#endif 672 addr <- peekSockAddr sockaddr 673 sock' <- mkSocket new_sock family stype protocol Connected 674 return (sock', addr) 675 676#if defined(mingw32_HOST_OS) 677foreign import ccall unsafe "HsNet.h acceptNewSock" 678 c_acceptNewSock :: Ptr () -> IO CInt 679foreign import ccall unsafe "HsNet.h newAcceptParams" 680 c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ()) 681foreign import ccall unsafe "HsNet.h &acceptDoProc" 682 c_acceptDoProc :: FunPtr (Ptr () -> IO Int) 683foreign import ccall unsafe "free" 684 c_free:: Ptr a -> IO () 685#endif 686 687----------------------------------------------------------------------------- 688-- ** Sending and receiving data 689 690-- $sendrecv 691-- 692-- Do not use the @send@ and @recv@ functions defined in this section 693-- in new code, as they incorrectly represent binary data as a Unicode 694-- string. As a result, these functions are inefficient and may lead 695-- to bugs in the program. Instead use the @send@ and @recv@ 696-- functions defined in the "Network.Socket.ByteString" module. 697 698----------------------------------------------------------------------------- 699-- sendTo & recvFrom 700 701-- | Send data to the socket. The recipient can be specified 702-- explicitly, so the socket need not be in a connected state. 703-- Returns the number of bytes sent. Applications are responsible for 704-- ensuring that all data has been sent. 705-- 706-- NOTE: blocking on Windows unless you compile with -threaded (see 707-- GHC ticket #1129) 708{-# DEPRECATED sendTo "Use sendTo defined in \"Network.Socket.ByteString\"" #-} 709sendTo :: Socket -- (possibly) bound/connected Socket 710 -> String -- Data to send 711 -> SockAddr 712 -> IO Int -- Number of Bytes sent 713sendTo sock xs addr = do 714 withCStringLen xs $ \(str, len) -> do 715 sendBufTo sock str len addr 716 717-- | Send data to the socket. The recipient can be specified 718-- explicitly, so the socket need not be in a connected state. 719-- Returns the number of bytes sent. Applications are responsible for 720-- ensuring that all data has been sent. 721sendBufTo :: Socket -- (possibly) bound/connected Socket 722 -> Ptr a -> Int -- Data to send 723 -> SockAddr 724 -> IO Int -- Number of Bytes sent 725sendBufTo sock@(MkSocket s _family _stype _protocol _status) ptr nbytes addr = do 726 withSockAddr addr $ \p_addr sz -> do 727 liftM fromIntegral $ 728 throwSocketErrorWaitWrite sock "Network.Socket.sendBufTo" $ 729 c_sendto s ptr (fromIntegral $ nbytes) 0{-flags-} 730 p_addr (fromIntegral sz) 731 732-- | Receive data from the socket. The socket need not be in a 733-- connected state. Returns @(bytes, nbytes, address)@ where @bytes@ 734-- is a @String@ of length @nbytes@ representing the data received and 735-- @address@ is a 'SockAddr' representing the address of the sending 736-- socket. 737-- 738-- NOTE: blocking on Windows unless you compile with -threaded (see 739-- GHC ticket #1129) 740{-# DEPRECATED recvFrom "Use recvFrom defined in \"Network.Socket.ByteString\"" #-} 741recvFrom :: Socket -> Int -> IO (String, Int, SockAddr) 742recvFrom sock nbytes = 743 allocaBytes nbytes $ \ptr -> do 744 (len, sockaddr) <- recvBufFrom sock ptr nbytes 745 str <- peekCStringLen (ptr, len) 746 return (str, len, sockaddr) 747 748-- | Receive data from the socket, writing it into buffer instead of 749-- creating a new string. The socket need not be in a connected 750-- state. Returns @(nbytes, address)@ where @nbytes@ is the number of 751-- bytes received and @address@ is a 'SockAddr' representing the 752-- address of the sending socket. 753-- 754-- NOTE: blocking on Windows unless you compile with -threaded (see 755-- GHC ticket #1129) 756recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr) 757recvBufFrom sock@(MkSocket s family _stype _protocol _status) ptr nbytes 758 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBufFrom") 759 | otherwise = 760 withNewSockAddr family $ \ptr_addr sz -> do 761 alloca $ \ptr_len -> do 762 poke ptr_len (fromIntegral sz) 763 len <- throwSocketErrorWaitRead sock "Network.Socket.recvBufFrom" $ 764 c_recvfrom s ptr (fromIntegral nbytes) 0{-flags-} 765 ptr_addr ptr_len 766 let len' = fromIntegral len 767 if len' == 0 768 then ioError (mkEOFError "Network.Socket.recvFrom") 769 else do 770 flg <- isConnected sock 771 -- For at least one implementation (WinSock 2), recvfrom() ignores 772 -- filling in the sockaddr for connected TCP sockets. Cope with 773 -- this by using getPeerName instead. 774 sockaddr <- 775 if flg then 776 getPeerName sock 777 else 778 peekSockAddr ptr_addr 779 return (len', sockaddr) 780 781----------------------------------------------------------------------------- 782-- send & recv 783 784-- | Send data to the socket. The socket must be connected to a remote 785-- socket. Returns the number of bytes sent. Applications are 786-- responsible for ensuring that all data has been sent. 787-- 788-- Sending data to closed socket may lead to undefined behaviour. 789{-# DEPRECATED send "Use send defined in \"Network.Socket.ByteString\"" #-} 790send :: Socket -- Bound/Connected Socket 791 -> String -- Data to send 792 -> IO Int -- Number of Bytes sent 793send sock xs = withCStringLen xs $ \(str, len) -> 794 sendBuf sock (castPtr str) len 795 796-- | Send data to the socket. The socket must be connected to a remote 797-- socket. Returns the number of bytes sent. Applications are 798-- responsible for ensuring that all data has been sent. 799-- 800-- Sending data to closed socket may lead to undefined behaviour. 801sendBuf :: Socket -- Bound/Connected Socket 802 -> Ptr Word8 -- Pointer to the data to send 803 -> Int -- Length of the buffer 804 -> IO Int -- Number of Bytes sent 805sendBuf sock@(MkSocket s _family _stype _protocol _status) str len = do 806 liftM fromIntegral $ 807#if defined(mingw32_HOST_OS) 808-- writeRawBufferPtr is supposed to handle checking for errors, but it's broken 809-- on x86_64 because of GHC bug #12010 so we duplicate the check here. The call 810-- to throwSocketErrorIfMinus1Retry can be removed when no GHC version with the 811-- bug is supported. 812 throwSocketErrorIfMinus1Retry "Network.Socket.sendBuf" $ writeRawBufferPtr 813 "Network.Socket.sendBuf" 814 (socket2FD sock) 815 (castPtr str) 816 0 817 (fromIntegral len) 818#else 819 throwSocketErrorWaitWrite sock "Network.Socket.sendBuf" $ 820 c_send s str (fromIntegral len) 0{-flags-} 821#endif 822 823 824-- | Receive data from the socket. The socket must be in a connected 825-- state. This function may return fewer bytes than specified. If the 826-- message is longer than the specified length, it may be discarded 827-- depending on the type of socket. This function may block until a 828-- message arrives. 829-- 830-- Considering hardware and network realities, the maximum number of 831-- bytes to receive should be a small power of 2, e.g., 4096. 832-- 833-- For TCP sockets, a zero length return value means the peer has 834-- closed its half side of the connection. 835-- 836-- Receiving data from closed socket may lead to undefined behaviour. 837{-# DEPRECATED recv "Use recv defined in \"Network.Socket.ByteString\"" #-} 838recv :: Socket -> Int -> IO String 839recv sock l = fst <$> recvLen sock l 840 841{-# DEPRECATED recvLen "Use recv defined in \"Network.Socket.ByteString\" with \"Data.Bytestring.length\"" #-} 842recvLen :: Socket -> Int -> IO (String, Int) 843recvLen sock nbytes = 844 allocaBytes nbytes $ \ptr -> do 845 len <- recvBuf sock ptr nbytes 846 s <- peekCStringLen (castPtr ptr,len) 847 return (s, len) 848 849-- | Receive data from the socket. The socket must be in a connected 850-- state. This function may return fewer bytes than specified. If the 851-- message is longer than the specified length, it may be discarded 852-- depending on the type of socket. This function may block until a 853-- message arrives. 854-- 855-- Considering hardware and network realities, the maximum number of 856-- bytes to receive should be a small power of 2, e.g., 4096. 857-- 858-- For TCP sockets, a zero length return value means the peer has 859-- closed its half side of the connection. 860-- 861-- Receiving data from closed socket may lead to undefined behaviour. 862recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int 863recvBuf sock@(MkSocket s _family _stype _protocol _status) ptr nbytes 864 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf") 865 | otherwise = do 866 len <- 867#if defined(mingw32_HOST_OS) 868-- see comment in sendBuf above. 869 throwSocketErrorIfMinus1Retry "Network.Socket.recvBuf" $ 870 readRawBufferPtr "Network.Socket.recvBuf" 871 (socket2FD sock) ptr 0 (fromIntegral nbytes) 872#else 873 throwSocketErrorWaitRead sock "Network.Socket.recvBuf" $ 874 c_recv s (castPtr ptr) (fromIntegral nbytes) 0{-flags-} 875#endif 876 let len' = fromIntegral len 877 if len' == 0 878 then ioError (mkEOFError "Network.Socket.recvBuf") 879 else return len' 880 881 882-- --------------------------------------------------------------------------- 883-- socketPort 884-- 885-- The port number the given socket is currently connected to can be 886-- determined by calling $port$, is generally only useful when bind 887-- was given $aNY\_PORT$. 888 889-- | Getting the port of socket. 890-- `IOError` is thrown if a port is not available. 891socketPort :: Socket -- Connected & Bound Socket 892 -> IO PortNumber -- Port Number of Socket 893socketPort sock@(MkSocket _ AF_INET _ _ _) = do 894 (SockAddrInet port _) <- getSocketName sock 895 return port 896#if defined(IPV6_SOCKET_SUPPORT) 897socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do 898 (SockAddrInet6 port _ _ _) <- getSocketName sock 899 return port 900#endif 901socketPort (MkSocket _ family _ _ _) = 902 ioError $ userError $ 903 "Network.Socket.socketPort: address family '" ++ show family ++ 904 "' not supported." 905 906 907-- --------------------------------------------------------------------------- 908-- socketPortSafe 909-- | Getting the port of socket. 910socketPortSafe :: Socket -- Connected & Bound Socket 911 -> IO (Maybe PortNumber) -- Port Number of Socket 912socketPortSafe s = do 913 sa <- getSocketName s 914 return $ case sa of 915 SockAddrInet port _ -> Just port 916#if defined(IPV6_SOCKET_SUPPORT) 917 SockAddrInet6 port _ _ _ -> Just port 918#endif 919 _ -> Nothing 920 921-- --------------------------------------------------------------------------- 922-- getPeerName 923 924-- Calling $getPeerName$ returns the address details of the machine, 925-- other than the local one, which is connected to the socket. This is 926-- used in programs such as FTP to determine where to send the 927-- returning data. The corresponding call to get the details of the 928-- local machine is $getSocketName$. 929 930getPeerName :: Socket -> IO SockAddr 931getPeerName (MkSocket s family _ _ _) = do 932 withNewSockAddr family $ \ptr sz -> do 933 with (fromIntegral sz) $ \int_star -> do 934 throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerName" $ 935 c_getpeername s ptr int_star 936 _sz <- peek int_star 937 peekSockAddr ptr 938 939getSocketName :: Socket -> IO SockAddr 940getSocketName (MkSocket s family _ _ _) = do 941 withNewSockAddr family $ \ptr sz -> do 942 with (fromIntegral sz) $ \int_star -> do 943 throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketName" $ 944 c_getsockname s ptr int_star 945 peekSockAddr ptr 946 947----------------------------------------------------------------------------- 948-- Socket Properties 949 950-- | Socket options for use with 'setSocketOption' and 'getSocketOption'. 951-- 952-- The existence of a constructor does not imply that the relevant option 953-- is supported on your system: see 'isSupportedSocketOption' 954data SocketOption 955 = Debug -- ^ SO_DEBUG 956 | ReuseAddr -- ^ SO_REUSEADDR 957 | Type -- ^ SO_TYPE 958 | SoError -- ^ SO_ERROR 959 | DontRoute -- ^ SO_DONTROUTE 960 | Broadcast -- ^ SO_BROADCAST 961 | SendBuffer -- ^ SO_SNDBUF 962 | RecvBuffer -- ^ SO_RCVBUF 963 | KeepAlive -- ^ SO_KEEPALIVE 964 | OOBInline -- ^ SO_OOBINLINE 965 | TimeToLive -- ^ IP_TTL 966 | MaxSegment -- ^ TCP_MAXSEG 967 | NoDelay -- ^ TCP_NODELAY 968 | Cork -- ^ TCP_CORK 969 | Linger -- ^ SO_LINGER 970 | ReusePort -- ^ SO_REUSEPORT 971 | RecvLowWater -- ^ SO_RCVLOWAT 972 | SendLowWater -- ^ SO_SNDLOWAT 973 | RecvTimeOut -- ^ SO_RCVTIMEO 974 | SendTimeOut -- ^ SO_SNDTIMEO 975 | UseLoopBack -- ^ SO_USELOOPBACK 976 | UserTimeout -- ^ TCP_USER_TIMEOUT 977 | IPv6Only -- ^ IPV6_V6ONLY 978 | CustomSockOpt (CInt, CInt) 979 deriving (Show, Typeable) 980 981-- | Does the 'SocketOption' exist on this system? 982isSupportedSocketOption :: SocketOption -> Bool 983isSupportedSocketOption = isJust . packSocketOption 984 985-- | For a socket option, return Just (level, value) where level is the 986-- corresponding C option level constant (e.g. SOL_SOCKET) and value is 987-- the option constant itself (e.g. SO_DEBUG) 988-- If either constant does not exist, return Nothing. 989packSocketOption :: SocketOption -> Maybe (CInt, CInt) 990packSocketOption so = 991 -- The Just here is a hack to disable GHC's overlapping pattern detection: 992 -- the problem is if all constants are present, the fallback pattern is 993 -- redundant, but if they aren't then it isn't. Hence we introduce an 994 -- extra pattern (Nothing) that can't possibly happen, so that the 995 -- fallback is always (in principle) necessary. 996 -- I feel a little bad for including this, but such are the sacrifices we 997 -- make while working with CPP - excluding the fallback pattern correctly 998 -- would be a serious nuisance. 999 -- (NB: comments elsewhere in this file refer to this one) 1000 case Just so of 1001#ifdef SOL_SOCKET 1002#ifdef SO_DEBUG 1003 Just Debug -> Just ((#const SOL_SOCKET), (#const SO_DEBUG)) 1004#endif 1005#ifdef SO_REUSEADDR 1006 Just ReuseAddr -> Just ((#const SOL_SOCKET), (#const SO_REUSEADDR)) 1007#endif 1008#ifdef SO_TYPE 1009 Just Type -> Just ((#const SOL_SOCKET), (#const SO_TYPE)) 1010#endif 1011#ifdef SO_ERROR 1012 Just SoError -> Just ((#const SOL_SOCKET), (#const SO_ERROR)) 1013#endif 1014#ifdef SO_DONTROUTE 1015 Just DontRoute -> Just ((#const SOL_SOCKET), (#const SO_DONTROUTE)) 1016#endif 1017#ifdef SO_BROADCAST 1018 Just Broadcast -> Just ((#const SOL_SOCKET), (#const SO_BROADCAST)) 1019#endif 1020#ifdef SO_SNDBUF 1021 Just SendBuffer -> Just ((#const SOL_SOCKET), (#const SO_SNDBUF)) 1022#endif 1023#ifdef SO_RCVBUF 1024 Just RecvBuffer -> Just ((#const SOL_SOCKET), (#const SO_RCVBUF)) 1025#endif 1026#ifdef SO_KEEPALIVE 1027 Just KeepAlive -> Just ((#const SOL_SOCKET), (#const SO_KEEPALIVE)) 1028#endif 1029#ifdef SO_OOBINLINE 1030 Just OOBInline -> Just ((#const SOL_SOCKET), (#const SO_OOBINLINE)) 1031#endif 1032#ifdef SO_LINGER 1033 Just Linger -> Just ((#const SOL_SOCKET), (#const SO_LINGER)) 1034#endif 1035#ifdef SO_REUSEPORT 1036 Just ReusePort -> Just ((#const SOL_SOCKET), (#const SO_REUSEPORT)) 1037#endif 1038#ifdef SO_RCVLOWAT 1039 Just RecvLowWater -> Just ((#const SOL_SOCKET), (#const SO_RCVLOWAT)) 1040#endif 1041#ifdef SO_SNDLOWAT 1042 Just SendLowWater -> Just ((#const SOL_SOCKET), (#const SO_SNDLOWAT)) 1043#endif 1044#ifdef SO_RCVTIMEO 1045 Just RecvTimeOut -> Just ((#const SOL_SOCKET), (#const SO_RCVTIMEO)) 1046#endif 1047#ifdef SO_SNDTIMEO 1048 Just SendTimeOut -> Just ((#const SOL_SOCKET), (#const SO_SNDTIMEO)) 1049#endif 1050#ifdef SO_USELOOPBACK 1051 Just UseLoopBack -> Just ((#const SOL_SOCKET), (#const SO_USELOOPBACK)) 1052#endif 1053#endif // SOL_SOCKET 1054#if HAVE_DECL_IPPROTO_IP 1055#ifdef IP_TTL 1056 Just TimeToLive -> Just ((#const IPPROTO_IP), (#const IP_TTL)) 1057#endif 1058#endif // HAVE_DECL_IPPROTO_IP 1059#if HAVE_DECL_IPPROTO_TCP 1060#ifdef TCP_MAXSEG 1061 Just MaxSegment -> Just ((#const IPPROTO_TCP), (#const TCP_MAXSEG)) 1062#endif 1063#ifdef TCP_NODELAY 1064 Just NoDelay -> Just ((#const IPPROTO_TCP), (#const TCP_NODELAY)) 1065#endif 1066#ifdef TCP_USER_TIMEOUT 1067 Just UserTimeout -> Just ((#const IPPROTO_TCP), (#const TCP_USER_TIMEOUT)) 1068#endif 1069#ifdef TCP_CORK 1070 Just Cork -> Just ((#const IPPROTO_TCP), (#const TCP_CORK)) 1071#endif 1072#endif // HAVE_DECL_IPPROTO_TCP 1073#if HAVE_DECL_IPPROTO_IPV6 1074#if HAVE_DECL_IPV6_V6ONLY 1075 Just IPv6Only -> Just ((#const IPPROTO_IPV6), (#const IPV6_V6ONLY)) 1076#endif 1077#endif // HAVE_DECL_IPPROTO_IPV6 1078 Just (CustomSockOpt opt) -> Just opt 1079 _ -> Nothing 1080 1081-- | Return the option level and option value if they exist, 1082-- otherwise throw an error that begins "Network.Socket." ++ the String 1083-- parameter 1084packSocketOption' :: String -> SocketOption -> IO (CInt, CInt) 1085packSocketOption' caller so = maybe err return (packSocketOption so) 1086 where 1087 err = ioError . userError . concat $ ["Network.Socket.", caller, 1088 ": socket option ", show so, " unsupported on this system"] 1089 1090-- | Set a socket option that expects an Int value. 1091-- There is currently no API to set e.g. the timeval socket options 1092setSocketOption :: Socket 1093 -> SocketOption -- Option Name 1094 -> Int -- Option Value 1095 -> IO () 1096setSocketOption (MkSocket s _ _ _ _) so v = do 1097 (level, opt) <- packSocketOption' "setSocketOption" so 1098 with (fromIntegral v) $ \ptr_v -> do 1099 throwSocketErrorIfMinus1_ "Network.Socket.setSocketOption" $ 1100 c_setsockopt s level opt ptr_v 1101 (fromIntegral (sizeOf (undefined :: CInt))) 1102 return () 1103 1104 1105-- | Get a socket option that gives an Int value. 1106-- There is currently no API to get e.g. the timeval socket options 1107getSocketOption :: Socket 1108 -> SocketOption -- Option Name 1109 -> IO Int -- Option Value 1110getSocketOption (MkSocket s _ _ _ _) so = do 1111 (level, opt) <- packSocketOption' "getSocketOption" so 1112 alloca $ \ptr_v -> 1113 with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do 1114 throwSocketErrorIfMinus1Retry_ "Network.Socket.getSocketOption" $ 1115 c_getsockopt s level opt ptr_v ptr_sz 1116 fromIntegral `liftM` peek ptr_v 1117 1118 1119-- | Getting process ID, user ID and group ID for UNIX-domain sockets. 1120-- 1121-- This is implemented with SO_PEERCRED on Linux and getpeereid() 1122-- on BSD variants. Unfortunately, on some BSD variants 1123-- getpeereid() returns unexpected results, rather than an error, 1124-- for AF_INET sockets. It is the user's responsibility to make sure 1125-- that the socket is a UNIX-domain socket. 1126-- Also, on some BSD variants, getpeereid() does not return credentials 1127-- for sockets created via 'socketPair', only separately created and then 1128-- explicitly connected UNIX-domain sockets work on such systems. 1129-- 1130-- Since 2.7.0.0. 1131getPeerCredential :: Socket -> IO (Maybe CUInt, Maybe CUInt, Maybe CUInt) 1132#ifdef HAVE_STRUCT_UCRED 1133getPeerCredential sock = do 1134 (pid, uid, gid) <- getPeerCred sock 1135 if uid == maxBound then 1136 return (Nothing, Nothing, Nothing) 1137 else 1138 return (Just pid, Just uid, Just gid) 1139#elif defined(HAVE_GETPEEREID) 1140getPeerCredential sock = E.handle (\(E.SomeException _) -> return (Nothing,Nothing,Nothing)) $ do 1141 (uid, gid) <- getPeerEid sock 1142 return (Nothing, Just uid, Just gid) 1143#else 1144getPeerCredential _ = return (Nothing, Nothing, Nothing) 1145#endif 1146 1147#if defined(HAVE_STRUCT_UCRED) || defined(HAVE_GETPEEREID) 1148{-# DEPRECATED getPeerCred "Use getPeerCredential instead" #-} 1149-- | Returns the processID, userID and groupID of the socket's peer. 1150-- 1151-- Only available on platforms that support SO_PEERCRED or GETPEEREID(3) 1152-- on domain sockets. 1153-- GETPEEREID(3) returns userID and groupID. processID is always 0. 1154getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt) 1155getPeerCred sock = do 1156#ifdef HAVE_STRUCT_UCRED 1157 let fd = fdSocket sock 1158 let sz = (#const sizeof(struct ucred)) 1159 allocaBytes sz $ \ ptr_cr -> 1160 with (fromIntegral sz) $ \ ptr_sz -> do 1161 _ <- ($) throwSocketErrorIfMinus1Retry "Network.Socket.getPeerCred" $ 1162 c_getsockopt fd (#const SOL_SOCKET) (#const SO_PEERCRED) ptr_cr ptr_sz 1163 pid <- (#peek struct ucred, pid) ptr_cr 1164 uid <- (#peek struct ucred, uid) ptr_cr 1165 gid <- (#peek struct ucred, gid) ptr_cr 1166 return (pid, uid, gid) 1167#else 1168 (uid,gid) <- getPeerEid sock 1169 return (0,uid,gid) 1170#endif 1171 1172#ifdef HAVE_GETPEEREID 1173{-# DEPRECATED getPeerEid "Use getPeerCredential instead" #-} 1174-- | The getpeereid() function returns the effective user and group IDs of the 1175-- peer connected to a UNIX-domain socket 1176getPeerEid :: Socket -> IO (CUInt, CUInt) 1177getPeerEid sock = do 1178 let fd = fdSocket sock 1179 alloca $ \ ptr_uid -> 1180 alloca $ \ ptr_gid -> do 1181 throwSocketErrorIfMinus1Retry_ "Network.Socket.getPeerEid" $ 1182 c_getpeereid fd ptr_uid ptr_gid 1183 uid <- peek ptr_uid 1184 gid <- peek ptr_gid 1185 return (uid, gid) 1186#endif 1187#endif 1188 1189-- | Whether or not UNIX-domain sockets are available. 1190-- 1191-- Since 3.0.0.0. 1192isUnixDomainSocketAvailable :: Bool 1193#if defined(DOMAIN_SOCKET_SUPPORT) 1194isUnixDomainSocketAvailable = True 1195#else 1196isUnixDomainSocketAvailable = False 1197#endif 1198 1199##if !(MIN_VERSION_base(4,3,1)) 1200closeFdWith closer fd = closer fd 1201##endif 1202 1203-- sending/receiving ancillary socket data; low-level mechanism 1204-- for transmitting file descriptors, mainly. 1205sendFd :: Socket -> CInt -> IO () 1206#if defined(DOMAIN_SOCKET_SUPPORT) 1207sendFd sock outfd = do 1208 _ <- throwSocketErrorWaitWrite sock "Network.Socket.sendFd" $ c_sendFd (fdSocket sock) outfd 1209 return () 1210foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt 1211#else 1212sendFd _ _ = error "Network.Socket.sendFd" 1213#endif 1214 1215-- | Receive a file descriptor over a domain socket. Note that the resulting 1216-- file descriptor may have to be put into non-blocking mode in order to be 1217-- used safely. See 'setNonBlockIfNeeded'. 1218recvFd :: Socket -> IO CInt 1219#if defined(DOMAIN_SOCKET_SUPPORT) 1220recvFd sock = do 1221 theFd <- throwSocketErrorWaitRead sock "Network.Socket.recvFd" $ 1222 c_recvFd (fdSocket sock) 1223 return theFd 1224foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt 1225#else 1226recvFd _ = error "Network.Socket.recvFd" 1227#endif 1228 1229-- --------------------------------------------------------------------------- 1230-- Utility Functions 1231 1232{-# DEPRECATED aNY_PORT "Use defaultPort instead" #-} 1233aNY_PORT :: PortNumber 1234aNY_PORT = 0 1235 1236defaultPort :: PortNumber 1237defaultPort = 0 1238 1239-- | The IPv4 wild card address. 1240 1241{-# DEPRECATED iNADDR_ANY "Use getAddrInfo instead" #-} 1242iNADDR_ANY :: HostAddress 1243iNADDR_ANY = htonl (#const INADDR_ANY) 1244 1245-- | Converts the from host byte order to network byte order. 1246foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32 1247-- | Converts the from network byte order to host byte order. 1248foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32 1249 1250{-# DEPRECATED htonl "Use getAddrInfo instead" #-} 1251{-# DEPRECATED ntohl "Use getAddrInfo instead" #-} 1252 1253#if defined(IPV6_SOCKET_SUPPORT) 1254-- | The IPv6 wild card address. 1255 1256{-# DEPRECATED iN6ADDR_ANY "Use getAddrInfo instead" #-} 1257iN6ADDR_ANY :: HostAddress6 1258iN6ADDR_ANY = (0, 0, 0, 0) 1259#endif 1260 1261{-# DEPRECATED sOMAXCONN "Use maxListenQueue instead" #-} 1262sOMAXCONN :: Int 1263sOMAXCONN = #const SOMAXCONN 1264 1265{-# DEPRECATED sOL_SOCKET "This is not necessary anymore" #-} 1266sOL_SOCKET :: Int 1267sOL_SOCKET = #const SOL_SOCKET 1268 1269#ifdef SCM_RIGHTS 1270{-# DEPRECATED sCM_RIGHTS "This is not necessary anymore" #-} 1271sCM_RIGHTS :: Int 1272sCM_RIGHTS = #const SCM_RIGHTS 1273#endif 1274 1275-- | This is the value of SOMAXCONN, typically 128. 1276-- 128 is good enough for normal network servers but 1277-- is too small for high performance servers. 1278maxListenQueue :: Int 1279maxListenQueue = sOMAXCONN 1280 1281-- ----------------------------------------------------------------------------- 1282 1283data ShutdownCmd 1284 = ShutdownReceive 1285 | ShutdownSend 1286 | ShutdownBoth 1287 deriving Typeable 1288 1289sdownCmdToInt :: ShutdownCmd -> CInt 1290sdownCmdToInt ShutdownReceive = 0 1291sdownCmdToInt ShutdownSend = 1 1292sdownCmdToInt ShutdownBoth = 2 1293 1294-- | Shut down one or both halves of the connection, depending on the 1295-- second argument to the function. If the second argument is 1296-- 'ShutdownReceive', further receives are disallowed. If it is 1297-- 'ShutdownSend', further sends are disallowed. If it is 1298-- 'ShutdownBoth', further sends and receives are disallowed. 1299shutdown :: Socket -> ShutdownCmd -> IO () 1300shutdown (MkSocket s _ _ _ _) stype = do 1301 throwSocketErrorIfMinus1Retry_ "Network.Socket.shutdown" $ 1302 c_shutdown s (sdownCmdToInt stype) 1303 return () 1304 1305-- ----------------------------------------------------------------------------- 1306 1307-- | Close the socket. This function does not throw exceptions even if 1308-- the underlying system call returns errors. 1309-- 1310-- Sending data to or receiving data from closed socket 1311-- may lead to undefined behaviour. 1312-- 1313-- If multiple threads use the same socket and one uses 'fdSocket' and 1314-- the other use 'close', unexpected behavior may happen. 1315-- For more information, please refer to the documentation of 'fdSocket'. 1316close :: Socket -> IO () 1317close (MkSocket s _ _ _ socketStatus) = modifyMVar_ socketStatus $ \ status -> 1318 case status of 1319 ConvertedToHandle -> return ConvertedToHandle 1320 Closed -> return Closed 1321 _ -> do 1322 -- closeFdWith avoids the deadlock of IO manager. 1323 closeFdWith (void . c_close . fromIntegral) (fromIntegral s) 1324 return Closed 1325 1326-- | Close the socket. This function throws exceptions if 1327-- the underlying system call returns errors. 1328-- 1329-- Sending data to or receiving data from closed socket 1330-- may lead to undefined behaviour. 1331close' :: Socket -> IO () 1332close' (MkSocket s _ _ _ socketStatus) = modifyMVar_ socketStatus $ \ status -> 1333 case status of 1334 ConvertedToHandle -> ioError (userError ("close: converted to a Handle, use hClose instead")) 1335 Closed -> return Closed 1336 _ -> do 1337 -- closeFdWith avoids the deadlock of IO manager. 1338 -- closeFd throws exceptions. 1339 closeFdWith (closeFd . fromIntegral) (fromIntegral s) 1340 return Closed 1341 1342-- ----------------------------------------------------------------------------- 1343 1344-- | Determines whether 'close' has been used on the 'Socket'. This 1345-- does /not/ indicate any status about the socket beyond this. If the 1346-- socket has been closed remotely, this function can still return 1347-- 'True'. 1348isConnected :: Socket -> IO Bool 1349isConnected (MkSocket _ _ _ _ status) = do 1350 value <- readMVar status 1351 return (value == Connected) 1352{-# DEPRECATED isConnected "SocketStatus will be removed" #-} 1353 1354-- ----------------------------------------------------------------------------- 1355-- Socket Predicates 1356 1357isBound :: Socket -> IO Bool 1358isBound (MkSocket _ _ _ _ status) = do 1359 value <- readMVar status 1360 return (value == Bound) 1361{-# DEPRECATED isBound "SocketStatus will be removed" #-} 1362 1363isListening :: Socket -> IO Bool 1364isListening (MkSocket _ _ _ _ status) = do 1365 value <- readMVar status 1366 return (value == Listening) 1367{-# DEPRECATED isListening "SocketStatus will be removed" #-} 1368 1369isReadable :: Socket -> IO Bool 1370isReadable (MkSocket _ _ _ _ status) = do 1371 value <- readMVar status 1372 return (value == Listening || value == Connected) 1373{-# DEPRECATED isReadable "SocketStatus will be removed" #-} 1374 1375isWritable :: Socket -> IO Bool 1376isWritable = isReadable -- sort of. 1377{-# DEPRECATED isWritable "SocketStatus will be removed" #-} 1378 1379isAcceptable :: Family -> SocketType -> SocketStatus -> Bool 1380#if defined(DOMAIN_SOCKET_SUPPORT) 1381isAcceptable AF_UNIX sockTyp status 1382 | sockTyp == Stream || sockTyp == SeqPacket = 1383 status == Connected || status == Bound || status == Listening 1384isAcceptable AF_UNIX _ _ = False 1385#endif 1386isAcceptable _ _ status = status == Connected || status == Listening 1387{-# DEPRECATED isAcceptable "SocketStatus will be removed" #-} 1388 1389-- ----------------------------------------------------------------------------- 1390-- Internet address manipulation routines: 1391 1392{-# DEPRECATED inet_addr "Use \"getAddrInfo\" instead" #-} 1393inet_addr :: String -> IO HostAddress 1394inet_addr ipstr = withSocketsDo $ do 1395 withCString ipstr $ \str -> do 1396 had <- c_inet_addr str 1397 if had == maxBound 1398 then ioError $ userError $ 1399 "Network.Socket.inet_addr: Malformed address: " ++ ipstr 1400 else return had -- network byte order 1401 1402{-# DEPRECATED inet_ntoa "Use \"getNameInfo\" instead" #-} 1403inet_ntoa :: HostAddress -> IO String 1404inet_ntoa haddr = withSocketsDo $ do 1405 pstr <- c_inet_ntoa haddr 1406 peekCString pstr 1407 1408-- | Turns a Socket into an 'Handle'. By default, the new handle is 1409-- unbuffered. Use 'System.IO.hSetBuffering' to change the buffering. 1410-- 1411-- Note that since a 'Handle' is automatically closed by a finalizer 1412-- when it is no longer referenced, you should avoid doing any more 1413-- operations on the 'Socket' after calling 'socketToHandle'. To 1414-- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose' 1415-- on the 'Handle'. 1416 1417socketToHandle :: Socket -> IOMode -> IO Handle 1418socketToHandle s@(MkSocket fd _ _ _ socketStatus) mode = do 1419 modifyMVar socketStatus $ \ status -> 1420 if status == ConvertedToHandle 1421 then ioError (userError ("socketToHandle: already a Handle")) 1422 else do 1423 h <- fdToHandle' (fromIntegral fd) (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-} 1424 hSetBuffering h NoBuffering 1425 return (ConvertedToHandle, h) 1426 1427-- | Pack a list of values into a bitmask. The possible mappings from 1428-- value to bit-to-set are given as the first argument. We assume 1429-- that each value can cause exactly one bit to be set; unpackBits will 1430-- break if this property is not true. 1431 1432packBits :: (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b 1433 1434packBits mapping xs = foldl' pack 0 mapping 1435 where pack acc (k, v) | k `elem` xs = acc .|. v 1436 | otherwise = acc 1437 1438-- | Unpack a bitmask into a list of values. 1439 1440unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a] 1441 1442-- Be permissive and ignore unknown bit values. At least on OS X, 1443-- getaddrinfo returns an ai_flags field with bits set that have no 1444-- entry in <netdb.h>. 1445unpackBits [] _ = [] 1446unpackBits ((k,v):xs) r 1447 | r .&. v /= 0 = k : unpackBits xs (r .&. complement v) 1448 | otherwise = unpackBits xs r 1449 1450----------------------------------------------------------------------------- 1451-- Address and service lookups 1452 1453#if defined(IPV6_SOCKET_SUPPORT) 1454 1455-- | Flags that control the querying behaviour of 'getAddrInfo'. 1456-- For more information, see <https://tools.ietf.org/html/rfc3493#page-25> 1457data AddrInfoFlag = 1458 -- | The list of returned 'AddrInfo' values will 1459 -- only contain IPv4 addresses if the local system has at least 1460 -- one IPv4 interface configured, and likewise for IPv6. 1461 -- (Only some platforms support this.) 1462 AI_ADDRCONFIG 1463 -- | If 'AI_ALL' is specified, return all matching IPv6 and 1464 -- IPv4 addresses. Otherwise, this flag has no effect. 1465 -- (Only some platforms support this.) 1466 | AI_ALL 1467 -- | The 'addrCanonName' field of the first returned 1468 -- 'AddrInfo' will contain the "canonical name" of the host. 1469 | AI_CANONNAME 1470 -- | The 'HostName' argument /must/ be a numeric 1471 -- address in string form, and network name lookups will not be 1472 -- attempted. 1473 | AI_NUMERICHOST 1474 -- | The 'ServiceName' argument /must/ be a port 1475 -- number in string form, and service name lookups will not be 1476 -- attempted. (Only some platforms support this.) 1477 | AI_NUMERICSERV 1478 -- | If no 'HostName' value is provided, the network 1479 -- address in each 'SockAddr' 1480 -- will be left as a "wild card". 1481 -- This is useful for server applications that 1482 -- will accept connections from any client. 1483 | AI_PASSIVE 1484 -- | If an IPv6 lookup is performed, and no IPv6 1485 -- addresses are found, IPv6-mapped IPv4 addresses will be 1486 -- returned. (Only some platforms support this.) 1487 | AI_V4MAPPED 1488 deriving (Eq, Read, Show, Typeable) 1489 1490aiFlagMapping :: [(AddrInfoFlag, CInt)] 1491 1492aiFlagMapping = 1493 [ 1494#if HAVE_DECL_AI_ADDRCONFIG 1495 (AI_ADDRCONFIG, #const AI_ADDRCONFIG), 1496#else 1497 (AI_ADDRCONFIG, 0), 1498#endif 1499#if HAVE_DECL_AI_ALL 1500 (AI_ALL, #const AI_ALL), 1501#else 1502 (AI_ALL, 0), 1503#endif 1504 (AI_CANONNAME, #const AI_CANONNAME), 1505 (AI_NUMERICHOST, #const AI_NUMERICHOST), 1506#if HAVE_DECL_AI_NUMERICSERV 1507 (AI_NUMERICSERV, #const AI_NUMERICSERV), 1508#else 1509 (AI_NUMERICSERV, 0), 1510#endif 1511 (AI_PASSIVE, #const AI_PASSIVE), 1512#if HAVE_DECL_AI_V4MAPPED 1513 (AI_V4MAPPED, #const AI_V4MAPPED) 1514#else 1515 (AI_V4MAPPED, 0) 1516#endif 1517 ] 1518 1519-- | Indicate whether the given 'AddrInfoFlag' will have any effect on 1520-- this system. 1521addrInfoFlagImplemented :: AddrInfoFlag -> Bool 1522addrInfoFlagImplemented f = packBits aiFlagMapping [f] /= 0 1523 1524data AddrInfo = 1525 AddrInfo { 1526 addrFlags :: [AddrInfoFlag], 1527 addrFamily :: Family, 1528 addrSocketType :: SocketType, 1529 addrProtocol :: ProtocolNumber, 1530 addrAddress :: SockAddr, 1531 addrCanonName :: Maybe String 1532 } 1533 deriving (Eq, Show, Typeable) 1534 1535instance Storable AddrInfo where 1536 sizeOf _ = #const sizeof(struct addrinfo) 1537 alignment _ = alignment (undefined :: CInt) 1538 1539 peek p = do 1540 ai_flags <- (#peek struct addrinfo, ai_flags) p 1541 ai_family <- (#peek struct addrinfo, ai_family) p 1542 ai_socktype <- (#peek struct addrinfo, ai_socktype) p 1543 ai_protocol <- (#peek struct addrinfo, ai_protocol) p 1544 ai_addr <- (#peek struct addrinfo, ai_addr) p >>= peekSockAddr 1545 ai_canonname_ptr <- (#peek struct addrinfo, ai_canonname) p 1546 1547 ai_canonname <- if ai_canonname_ptr == nullPtr 1548 then return Nothing 1549 else liftM Just $ peekCString ai_canonname_ptr 1550 1551 socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype 1552 return (AddrInfo 1553 { 1554 addrFlags = unpackBits aiFlagMapping ai_flags, 1555 addrFamily = unpackFamily ai_family, 1556 addrSocketType = socktype, 1557 addrProtocol = ai_protocol, 1558 addrAddress = ai_addr, 1559 addrCanonName = ai_canonname 1560 }) 1561 1562 poke p (AddrInfo flags family socketType protocol _ _) = do 1563 c_stype <- packSocketTypeOrThrow "AddrInfo.poke" socketType 1564 1565 (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags) 1566 (#poke struct addrinfo, ai_family) p (packFamily family) 1567 (#poke struct addrinfo, ai_socktype) p c_stype 1568 (#poke struct addrinfo, ai_protocol) p protocol 1569 1570 -- stuff below is probably not needed, but let's zero it for safety 1571 1572 (#poke struct addrinfo, ai_addrlen) p (0::CSize) 1573 (#poke struct addrinfo, ai_addr) p nullPtr 1574 (#poke struct addrinfo, ai_canonname) p nullPtr 1575 (#poke struct addrinfo, ai_next) p nullPtr 1576 1577-- | Flags that control the querying behaviour of 'getNameInfo'. 1578-- For more information, see <https://tools.ietf.org/html/rfc3493#page-30> 1579data NameInfoFlag = 1580 -- | Resolve a datagram-based service name. This is 1581 -- required only for the few protocols that have different port 1582 -- numbers for their datagram-based versions than for their 1583 -- stream-based versions. 1584 NI_DGRAM 1585 -- | If the hostname cannot be looked up, an IO error is thrown. 1586 | NI_NAMEREQD 1587 -- | If a host is local, return only the hostname part of the FQDN. 1588 | NI_NOFQDN 1589 -- | The name of the host is not looked up. 1590 -- Instead, a numeric representation of the host's 1591 -- address is returned. For an IPv4 address, this will be a 1592 -- dotted-quad string. For IPv6, it will be colon-separated 1593 -- hexadecimal. 1594 | NI_NUMERICHOST 1595 -- | The name of the service is not 1596 -- looked up. Instead, a numeric representation of the 1597 -- service is returned. 1598 | NI_NUMERICSERV 1599 deriving (Eq, Read, Show, Typeable) 1600 1601niFlagMapping :: [(NameInfoFlag, CInt)] 1602 1603niFlagMapping = [(NI_DGRAM, #const NI_DGRAM), 1604 (NI_NAMEREQD, #const NI_NAMEREQD), 1605 (NI_NOFQDN, #const NI_NOFQDN), 1606 (NI_NUMERICHOST, #const NI_NUMERICHOST), 1607 (NI_NUMERICSERV, #const NI_NUMERICSERV)] 1608 1609-- | Default hints for address lookup with 'getAddrInfo'. The values 1610-- of the 'addrAddress' and 'addrCanonName' fields are 'undefined', 1611-- and are never inspected by 'getAddrInfo'. 1612-- 1613-- >>> addrFlags defaultHints 1614-- [] 1615-- >>> addrFamily defaultHints 1616-- AF_UNSPEC 1617-- >>> addrSocketType defaultHints 1618-- NoSocketType 1619-- >>> addrProtocol defaultHints 1620-- 0 1621 1622defaultHints :: AddrInfo 1623defaultHints = AddrInfo { 1624 addrFlags = [], 1625 addrFamily = AF_UNSPEC, 1626 addrSocketType = NoSocketType, 1627 addrProtocol = defaultProtocol, 1628 addrAddress = undefined, 1629 addrCanonName = undefined 1630 } 1631 1632-- | Shows the fields of 'defaultHints', without inspecting the by-default undefined fields 'addrAddress' and 'addrCanonName'. 1633showDefaultHints :: AddrInfo -> String 1634showDefaultHints AddrInfo{..} = concat 1635 [ "AddrInfo {" 1636 , "addrFlags = " 1637 , show addrFlags 1638 , ", addrFamily = " 1639 , show addrFamily 1640 , ", addrSocketType = " 1641 , show addrSocketType 1642 , ", addrProtocol = " 1643 , show addrProtocol 1644 , ", addrAddress = " 1645 , "<assumed to be undefined>" 1646 , ", addrCanonName = " 1647 , "<assumed to be undefined>" 1648 , "}" 1649 ] 1650 1651-- | Resolve a host or service name to one or more addresses. 1652-- The 'AddrInfo' values that this function returns contain 'SockAddr' 1653-- values that you can pass directly to 'connect' or 1654-- 'bind'. 1655-- 1656-- This function is protocol independent. It can return both IPv4 and 1657-- IPv6 address information. 1658-- 1659-- The 'AddrInfo' argument specifies the preferred query behaviour, 1660-- socket options, or protocol. You can override these conveniently 1661-- using Haskell's record update syntax on 'defaultHints', for example 1662-- as follows: 1663-- 1664-- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Stream } 1665-- 1666-- You must provide a 'Just' value for at least one of the 'HostName' 1667-- or 'ServiceName' arguments. 'HostName' can be either a numeric 1668-- network address (dotted quad for IPv4, colon-separated hex for 1669-- IPv6) or a hostname. In the latter case, its addresses will be 1670-- looked up unless 'AI_NUMERICHOST' is specified as a hint. If you 1671-- do not provide a 'HostName' value /and/ do not set 'AI_PASSIVE' as 1672-- a hint, network addresses in the result will contain the address of 1673-- the loopback interface. 1674-- 1675-- If the query fails, this function throws an IO exception instead of 1676-- returning an empty list. Otherwise, it returns a non-empty list 1677-- of 'AddrInfo' values. 1678-- 1679-- There are several reasons why a query might result in several 1680-- values. For example, the queried-for host could be multihomed, or 1681-- the service might be available via several protocols. 1682-- 1683-- Note: the order of arguments is slightly different to that defined 1684-- for @getaddrinfo@ in RFC 2553. The 'AddrInfo' parameter comes first 1685-- to make partial application easier. 1686-- 1687-- >>> addr:_ <- getAddrInfo (Just hints) (Just "127.0.0.1") (Just "http") 1688-- >>> addrAddress addr 1689-- 127.0.0.1:80 1690 1691getAddrInfo :: Maybe AddrInfo -- ^ preferred socket type or protocol 1692 -> Maybe HostName -- ^ host name to look up 1693 -> Maybe ServiceName -- ^ service name to look up 1694 -> IO [AddrInfo] -- ^ resolved addresses, with "best" first 1695 1696getAddrInfo hints node service = withSocketsDo $ 1697 maybeWith withCString node $ \c_node -> 1698 maybeWith withCString service $ \c_service -> 1699 maybeWith with filteredHints $ \c_hints -> 1700 alloca $ \ptr_ptr_addrs -> do 1701 ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs 1702 case ret of 1703 0 -> do ptr_addrs <- peek ptr_ptr_addrs 1704 ais <- followAddrInfo ptr_addrs 1705 c_freeaddrinfo ptr_addrs 1706 return ais 1707 _ -> do err <- gai_strerror ret 1708 let message = concat 1709 [ "Network.Socket.getAddrInfo (called with preferred socket type/protocol: " 1710 , maybe (show hints) showDefaultHints hints 1711 , ", host name: " 1712 , show node 1713 , ", service name: " 1714 , show service 1715 , ")" 1716 ] 1717 ioError (ioeSetErrorString 1718 (mkIOError NoSuchThing message Nothing 1719 Nothing) err) 1720 -- Leaving out the service and using AI_NUMERICSERV causes a 1721 -- segfault on OS X 10.8.2. This code removes AI_NUMERICSERV 1722 -- (which has no effect) in that case. 1723 where 1724#if defined(darwin_HOST_OS) 1725 filteredHints = case service of 1726 Nothing -> fmap (\ h -> h { addrFlags = delete AI_NUMERICSERV (addrFlags h) }) hints 1727 _ -> hints 1728#else 1729 filteredHints = hints 1730#endif 1731 1732followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo] 1733 1734followAddrInfo ptr_ai | ptr_ai == nullPtr = return [] 1735 | otherwise = do 1736 a <- peek ptr_ai 1737 as <- (#peek struct addrinfo, ai_next) ptr_ai >>= followAddrInfo 1738 return (a:as) 1739 1740foreign import ccall safe "hsnet_getaddrinfo" 1741 c_getaddrinfo :: CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo) 1742 -> IO CInt 1743 1744foreign import ccall safe "hsnet_freeaddrinfo" 1745 c_freeaddrinfo :: Ptr AddrInfo -> IO () 1746 1747gai_strerror :: CInt -> IO String 1748 1749#ifdef HAVE_GAI_STRERROR 1750gai_strerror n = c_gai_strerror n >>= peekCString 1751 1752foreign import ccall safe "gai_strerror" 1753 c_gai_strerror :: CInt -> IO CString 1754#else 1755gai_strerror n = ioError $ userError $ "Network.Socket.gai_strerror not supported: " ++ show n 1756#endif 1757 1758withCStringIf :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a 1759withCStringIf False _ f = f 0 nullPtr 1760withCStringIf True n f = allocaBytes n (f (fromIntegral n)) 1761 1762-- | Resolve an address to a host or service name. 1763-- This function is protocol independent. 1764-- The list of 'NameInfoFlag' values controls query behaviour. 1765-- 1766-- If a host or service's name cannot be looked up, then the numeric 1767-- form of the address or service will be returned. 1768-- 1769-- If the query fails, this function throws an IO exception. 1770-- 1771-- Example: 1772-- @ 1773-- (hostName, _) <- getNameInfo [] True False myAddress 1774-- @ 1775 1776getNameInfo :: [NameInfoFlag] -- ^ flags to control lookup behaviour 1777 -> Bool -- ^ whether to look up a hostname 1778 -> Bool -- ^ whether to look up a service name 1779 -> SockAddr -- ^ the address to look up 1780 -> IO (Maybe HostName, Maybe ServiceName) 1781 1782getNameInfo flags doHost doService addr = withSocketsDo $ 1783 withCStringIf doHost (#const NI_MAXHOST) $ \c_hostlen c_host -> 1784 withCStringIf doService (#const NI_MAXSERV) $ \c_servlen c_serv -> do 1785 withSockAddr addr $ \ptr_addr sz -> do 1786 ret <- c_getnameinfo ptr_addr (fromIntegral sz) c_host c_hostlen 1787 c_serv c_servlen (packBits niFlagMapping flags) 1788 case ret of 1789 0 -> do 1790 let peekIf doIf c_val = if doIf 1791 then liftM Just $ peekCString c_val 1792 else return Nothing 1793 host <- peekIf doHost c_host 1794 serv <- peekIf doService c_serv 1795 return (host, serv) 1796 _ -> do err <- gai_strerror ret 1797 let message = concat 1798 [ "Network.Socket.getNameInfo (called with flags: " 1799 , show flags 1800 , ", hostname lookup: " 1801 , show doHost 1802 , ", service name lookup: " 1803 , show doService 1804 , ", socket address: " 1805 , show addr 1806 , ")" 1807 ] 1808 ioError (ioeSetErrorString 1809 (mkIOError NoSuchThing message Nothing 1810 Nothing) err) 1811 1812foreign import ccall safe "hsnet_getnameinfo" 1813 c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString 1814 -> CSize -> CInt -> IO CInt 1815#endif 1816 1817mkInvalidRecvArgError :: String -> IOError 1818mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError 1819 InvalidArgument 1820 loc Nothing Nothing) "non-positive length" 1821 1822mkEOFError :: String -> IOError 1823mkEOFError loc = ioeSetErrorString (mkIOError EOF loc Nothing Nothing) "end of file" 1824 1825-- --------------------------------------------------------------------------- 1826-- foreign imports from the C library 1827 1828foreign import ccall unsafe "hsnet_inet_ntoa" 1829 c_inet_ntoa :: HostAddress -> IO (Ptr CChar) 1830 1831foreign import CALLCONV unsafe "inet_addr" 1832 c_inet_addr :: Ptr CChar -> IO HostAddress 1833 1834foreign import CALLCONV unsafe "shutdown" 1835 c_shutdown :: CInt -> CInt -> IO CInt 1836 1837closeFd :: CInt -> IO () 1838closeFd fd = throwSocketErrorIfMinus1_ "Network.Socket.close" $ c_close fd 1839 1840#if !defined(WITH_WINSOCK) 1841foreign import ccall unsafe "close" 1842 c_close :: CInt -> IO CInt 1843#else 1844foreign import stdcall unsafe "closesocket" 1845 c_close :: CInt -> IO CInt 1846#endif 1847 1848foreign import CALLCONV unsafe "socket" 1849 c_socket :: CInt -> CInt -> CInt -> IO CInt 1850foreign import CALLCONV unsafe "bind" 1851 c_bind :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt 1852foreign import CALLCONV SAFE_ON_WIN "connect" 1853 c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt 1854#ifdef HAVE_ACCEPT4 1855foreign import CALLCONV unsafe "accept4" 1856 c_accept4 :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt 1857#else 1858foreign import CALLCONV unsafe "accept" 1859 c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt 1860#endif 1861foreign import CALLCONV unsafe "listen" 1862 c_listen :: CInt -> CInt -> IO CInt 1863 1864#if defined(mingw32_HOST_OS) 1865foreign import CALLCONV safe "accept" 1866 c_accept_safe :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt 1867 1868foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool 1869#endif 1870 1871foreign import CALLCONV unsafe "send" 1872 c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt 1873foreign import CALLCONV SAFE_ON_WIN "sendto" 1874 c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> CInt -> IO CInt 1875foreign import CALLCONV unsafe "recv" 1876 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt 1877foreign import CALLCONV SAFE_ON_WIN "recvfrom" 1878 c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt 1879foreign import CALLCONV unsafe "getpeername" 1880 c_getpeername :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt 1881foreign import CALLCONV unsafe "getsockname" 1882 c_getsockname :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt 1883 1884foreign import CALLCONV unsafe "getsockopt" 1885 c_getsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt 1886foreign import CALLCONV unsafe "setsockopt" 1887 c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt 1888 1889#if defined(HAVE_GETPEEREID) 1890foreign import CALLCONV unsafe "getpeereid" 1891 c_getpeereid :: CInt -> Ptr CUInt -> Ptr CUInt -> IO CInt 1892#endif 1893-- --------------------------------------------------------------------------- 1894-- * Deprecated aliases 1895 1896-- $deprecated-aliases 1897-- 1898-- These aliases are deprecated and should not be used in new code. 1899-- They will be removed in some future version of the package. 1900 1901{-# DEPRECATED bindSocket "use 'bind'" #-} 1902 1903-- | Deprecated alias for 'bind'. 1904bindSocket :: Socket -- Unconnected Socket 1905 -> SockAddr -- Address to Bind to 1906 -> IO () 1907bindSocket = bind 1908 1909{-# DEPRECATED sClose "use 'close'" #-} 1910 1911-- | Deprecated alias for 'close'. 1912sClose :: Socket -> IO () 1913sClose = close 1914 1915{-# DEPRECATED sIsConnected "SocketStatus will be removed" #-} 1916 1917sIsConnected :: Socket -> IO Bool 1918sIsConnected = isConnected 1919 1920{-# DEPRECATED sIsBound "SocketStatus will be removed" #-} 1921 1922sIsBound :: Socket -> IO Bool 1923sIsBound = isBound 1924 1925{-# DEPRECATED sIsListening "SocketStatus will be removed" #-} 1926 1927sIsListening :: Socket -> IO Bool 1928sIsListening = isListening 1929 1930{-# DEPRECATED sIsReadable "SocketStatus will be removed" #-} 1931 1932sIsReadable :: Socket -> IO Bool 1933sIsReadable = isReadable 1934 1935{-# DEPRECATED sIsWritable "SocketStatus will be removed" #-} 1936 1937sIsWritable :: Socket -> IO Bool 1938sIsWritable = isWritable 1939 1940#if defined(HAVE_IF_NAMETOINDEX) 1941-- | Returns the index corresponding to the interface name. 1942-- 1943-- Since 2.7.0.0. 1944ifNameToIndex :: String -> IO (Maybe Int) 1945ifNameToIndex ifname = do 1946 index <- withCString ifname c_if_nametoindex 1947 -- On failure zero is returned. We'll return Nothing. 1948 return $ if index == 0 then Nothing else Just $ fromIntegral index 1949 1950-- | Returns the interface name corresponding to the index. 1951-- 1952-- Since 2.7.0.0. 1953ifIndexToName :: Int -> IO (Maybe String) 1954ifIndexToName ifn = allocaBytes 16 $ \ptr -> do -- 16 == IFNAMSIZ 1955 r <- c_if_indextoname (fromIntegral ifn) ptr 1956 if r == nullPtr then 1957 return Nothing 1958 else 1959 Just <$> peekCString ptr 1960 1961foreign import CALLCONV safe "if_nametoindex" 1962 c_if_nametoindex :: CString -> IO CUInt 1963 1964foreign import CALLCONV safe "if_indextoname" 1965 c_if_indextoname :: CUInt -> CString -> IO CString 1966#endif 1967