/Network/Socket.hsc
Unknown | 1670 lines | 1470 code | 200 blank | 0 comment | 0 complexity | e8ea0bf263cf080ee3694f2a4d185539 MD5 | raw file
Large files files are truncated, but you can click here to view the full file
1{-# LANGUAGE CPP, ScopedTypeVariables #-} 2{-# OPTIONS_GHC -fno-warn-orphans #-} 3----------------------------------------------------------------------------- 4-- | 5-- Module : Network.Socket 6-- Copyright : (c) The University of Glasgow 2001 7-- License : BSD-style (see the file libraries/network/LICENSE) 8-- 9-- Maintainer : libraries@haskell.org 10-- Stability : provisional 11-- Portability : portable 12-- 13-- The "Network.Socket" module is for when you want full control over 14-- sockets. Essentially the entire C socket API is exposed through 15-- this module; in general the operations follow the behaviour of the C 16-- functions of the same name (consult your favourite Unix networking book). 17-- 18-- A higher level interface to networking operations is provided 19-- through the module "Network". 20-- 21----------------------------------------------------------------------------- 22 23#include "HsNet.h" 24 25-- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs. 26##include "Typeable.h" 27 28-- In order to process this file, you need to have CALLCONV defined. 29 30module Network.Socket 31 ( 32 -- * Types 33 Socket(..) 34 , Family(..) 35 , isSupportedFamily 36 , SocketType(..) 37 , isSupportedSocketType 38 , SockAddr(..) 39 , SocketStatus(..) 40 , HostAddress 41#if defined(IPV6_SOCKET_SUPPORT) 42 , HostAddress6 43 , FlowInfo 44 , ScopeID 45#endif 46 , ShutdownCmd(..) 47 , ProtocolNumber 48 , defaultProtocol 49 , PortNumber(..) 50 -- PortNumber is used non-abstractly in Network.BSD. ToDo: remove 51 -- this use and make the type abstract. 52 53 -- * Address operations 54 55 , HostName 56 , ServiceName 57 58#if defined(IPV6_SOCKET_SUPPORT) 59 , AddrInfo(..) 60 61 , AddrInfoFlag(..) 62 , addrInfoFlagImplemented 63 64 , defaultHints 65 66 , getAddrInfo 67 68 , NameInfoFlag(..) 69 70 , getNameInfo 71#endif 72 73 -- * Socket operations 74 , socket 75#if defined(DOMAIN_SOCKET_SUPPORT) 76 , socketPair 77#endif 78 , connect 79 , bind 80 , listen 81 , accept 82 , getPeerName 83 , getSocketName 84 85#ifdef HAVE_STRUCT_UCRED 86 -- get the credentials of our domain socket peer. 87 , getPeerCred 88#endif 89 90 , socketPort 91 92 , socketToHandle 93 94 -- ** Sending and receiving data 95 -- $sendrecv 96 , sendTo 97 , sendBufTo 98 99 , recvFrom 100 , recvBufFrom 101 102 , send 103 , recv 104 , recvLen 105 , sendBuf 106 , recvBuf 107 108 , inet_addr 109 , inet_ntoa 110 111 , shutdown 112 , close 113 114 -- ** Predicates on sockets 115 , isConnected 116 , isBound 117 , isListening 118 , isReadable 119 , isWritable 120 121 -- * Socket options 122 , SocketOption(..) 123 , isSupportedSocketOption 124 , getSocketOption 125 , setSocketOption 126 127 -- * File descriptor transmission 128#ifdef DOMAIN_SOCKET_SUPPORT 129 , sendFd 130 , recvFd 131 132#endif 133 134 -- * Special constants 135 , aNY_PORT 136 , iNADDR_ANY 137#if defined(IPV6_SOCKET_SUPPORT) 138 , iN6ADDR_ANY 139#endif 140 , sOMAXCONN 141 , sOL_SOCKET 142#ifdef SCM_RIGHTS 143 , sCM_RIGHTS 144#endif 145 , maxListenQueue 146 147 -- * Initialisation 148 , withSocketsDo 149 150 -- * Very low level operations 151 -- in case you ever want to get at the underlying file descriptor.. 152 , fdSocket 153 , mkSocket 154 155 -- * Deprecated aliases 156 -- $deprecated-aliases 157 , bindSocket 158 , sClose 159 , sIsConnected 160 , sIsBound 161 , sIsListening 162 , sIsReadable 163 , sIsWritable 164 165 -- * Internal 166 167 -- | The following are exported ONLY for use in the BSD module and 168 -- should not be used anywhere else. 169 170 , packFamily 171 , unpackFamily 172 , packSocketType 173 ) where 174 175import Data.Bits 176import Data.List (foldl') 177import Data.Maybe (fromMaybe, isJust) 178import Data.Word (Word8, Word16, Word32) 179import Foreign.Ptr (Ptr, castPtr, nullPtr) 180import Foreign.Storable (Storable(..)) 181import Foreign.C.Error 182import Foreign.C.String (CString, withCString, peekCString, peekCStringLen) 183import Foreign.C.Types (CUInt, CChar) 184#if __GLASGOW_HASKELL__ >= 703 185import Foreign.C.Types (CInt(..), CSize(..)) 186#else 187import Foreign.C.Types (CInt, CSize) 188#endif 189import Foreign.Marshal.Alloc ( alloca, allocaBytes ) 190import Foreign.Marshal.Array ( peekArray ) 191import Foreign.Marshal.Utils ( maybeWith, with ) 192 193import System.IO 194import Control.Monad (liftM, when) 195import Data.Ratio ((%)) 196 197import qualified Control.Exception as E 198import Control.Concurrent.MVar 199import Data.Typeable 200import System.IO.Error 201 202#ifdef __GLASGOW_HASKELL__ 203import GHC.Conc (threadWaitRead, threadWaitWrite) 204##if MIN_VERSION_base(4,3,1) 205import GHC.Conc (closeFdWith) 206##endif 207# if defined(mingw32_HOST_OS) 208import GHC.Conc (asyncDoProc) 209import Foreign (FunPtr) 210# endif 211# if __GLASGOW_HASKELL__ >= 611 212import qualified GHC.IO.Device 213import GHC.IO.Handle.FD 214import GHC.IO.Exception 215import GHC.IO 216# else 217import GHC.IOBase 218import GHC.Handle 219# endif 220import qualified System.Posix.Internals 221#else 222import System.IO.Unsafe (unsafePerformIO) 223#endif 224 225# if __GLASGOW_HASKELL__ >= 611 226import GHC.IO.FD 227#endif 228 229import Network.Socket.Internal 230import Network.Socket.Types 231 232-- | Either a host name e.g., @\"haskell.org\"@ or a numeric host 233-- address string consisting of a dotted decimal IPv4 address or an 234-- IPv6 address e.g., @\"192.168.0.1\"@. 235type HostName = String 236type ServiceName = String 237 238-- ---------------------------------------------------------------------------- 239-- On Windows, our sockets are not put in non-blocking mode (non-blocking 240-- is not supported for regular file descriptors on Windows, and it would 241-- be a pain to support it only for sockets). So there are two cases: 242-- 243-- - the threaded RTS uses safe calls for socket operations to get 244-- non-blocking I/O, just like the rest of the I/O library 245-- 246-- - with the non-threaded RTS, only some operations on sockets will be 247-- non-blocking. Reads and writes go through the normal async I/O 248-- system. accept() uses asyncDoProc so is non-blocking. A handful 249-- of others (recvFrom, sendFd, recvFd) will block all threads - if this 250-- is a problem, -threaded is the workaround. 251-- 252##if defined(mingw32_HOST_OS) 253##define SAFE_ON_WIN safe 254##else 255##define SAFE_ON_WIN unsafe 256##endif 257 258----------------------------------------------------------------------------- 259-- Socket types 260 261#if __GLASGOW_HASKELL__ >= 611 && defined(mingw32_HOST_OS) 262socket2FD (MkSocket fd _ _ _ _) = 263 -- HACK, 1 means True 264 FD{fdFD = fd,fdIsSocket_ = 1} 265#endif 266 267mkSocket :: CInt 268 -> Family 269 -> SocketType 270 -> ProtocolNumber 271 -> SocketStatus 272 -> IO Socket 273mkSocket fd fam sType pNum stat = do 274 mStat <- newMVar stat 275 return (MkSocket fd fam sType pNum mStat) 276 277 278fdSocket :: Socket -> CInt 279fdSocket (MkSocket fd _ _ _ _) = fd 280 281-- | This is the default protocol for a given service. 282defaultProtocol :: ProtocolNumber 283defaultProtocol = 0 284 285----------------------------------------------------------------------------- 286-- SockAddr 287 288instance Show SockAddr where 289#if defined(DOMAIN_SOCKET_SUPPORT) 290 showsPrec _ (SockAddrUnix str) = showString str 291#endif 292 showsPrec _ (SockAddrInet port ha) 293 = showString (unsafePerformIO (inet_ntoa ha)) 294 . showString ":" 295 . shows port 296#if defined(IPV6_SOCKET_SUPPORT) 297 showsPrec _ addr@(SockAddrInet6 port _ _ _) 298 = showChar '[' 299 . showString (unsafePerformIO $ 300 fst `liftM` getNameInfo [NI_NUMERICHOST] True False addr >>= 301 maybe (fail "showsPrec: impossible internal error") return) 302 . showString "]:" 303 . shows port 304#endif 305 306----------------------------------------------------------------------------- 307-- Connection Functions 308 309-- In the following connection and binding primitives. The names of 310-- the equivalent C functions have been preserved where possible. It 311-- should be noted that some of these names used in the C library, 312-- \tr{bind} in particular, have a different meaning to many Haskell 313-- programmers and have thus been renamed by appending the prefix 314-- Socket. 315 316-- | Create a new socket using the given address family, socket type 317-- and protocol number. The address family is usually 'AF_INET', 318-- 'AF_INET6', or 'AF_UNIX'. The socket type is usually 'Stream' or 319-- 'Datagram'. The protocol number is usually 'defaultProtocol'. 320-- If 'AF_INET6' is used, the 'IPv6Only' socket option is set to 0 321-- so that both IPv4 and IPv6 can be handled with one socket. 322socket :: Family -- Family Name (usually AF_INET) 323 -> SocketType -- Socket Type (usually Stream) 324 -> ProtocolNumber -- Protocol Number (getProtocolByName to find value) 325 -> IO Socket -- Unconnected Socket 326socket family stype protocol = do 327 c_stype <- packSocketTypeOrThrow "socket" stype 328 fd <- throwSocketErrorIfMinus1Retry "socket" $ 329 c_socket (packFamily family) c_stype protocol 330 setNonBlockIfNeeded fd 331 socket_status <- newMVar NotConnected 332 let sock = MkSocket fd family stype protocol socket_status 333#if HAVE_DECL_IPV6_V6ONLY 334# if defined(mingw32_HOST_OS) 335 -- the IPv6Only option is only supported on Windows Vista and later, 336 -- so trying to change it might throw an error 337 when (family == AF_INET6) $ 338 E.catch (setSocketOption sock IPv6Only 0) $ (\(_ :: E.IOException) -> return ()) 339# else 340 when (family == AF_INET6) $ setSocketOption sock IPv6Only 0 341# endif 342#endif 343 return sock 344 345-- | Build a pair of connected socket objects using the given address 346-- family, socket type, and protocol number. Address family, socket 347-- type, and protocol number are as for the 'socket' function above. 348-- Availability: Unix. 349#if defined(DOMAIN_SOCKET_SUPPORT) 350socketPair :: Family -- Family Name (usually AF_INET or AF_INET6) 351 -> SocketType -- Socket Type (usually Stream) 352 -> ProtocolNumber -- Protocol Number 353 -> IO (Socket, Socket) -- unnamed and connected. 354socketPair family stype protocol = do 355 allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do 356 c_stype <- packSocketTypeOrThrow "socketPair" stype 357 _rc <- throwSocketErrorIfMinus1Retry "socketpair" $ 358 c_socketpair (packFamily family) c_stype protocol fdArr 359 [fd1,fd2] <- peekArray 2 fdArr 360 s1 <- mkNonBlockingSocket fd1 361 s2 <- mkNonBlockingSocket fd2 362 return (s1,s2) 363 where 364 mkNonBlockingSocket fd = do 365 setNonBlockIfNeeded fd 366 stat <- newMVar Connected 367 return (MkSocket fd family stype protocol stat) 368 369foreign import ccall unsafe "socketpair" 370 c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt 371#endif 372 373-- | Set the socket to nonblocking, if applicable to this platform. 374setNonBlockIfNeeded :: CInt -> IO () 375setNonBlockIfNeeded fd = 376#if __GLASGOW_HASKELL__ < 611 377 System.Posix.Internals.setNonBlockingFD fd 378#else 379 System.Posix.Internals.setNonBlockingFD fd True 380#endif 381 382----------------------------------------------------------------------------- 383-- Binding a socket 384 385-- | Bind the socket to an address. The socket must not already be 386-- bound. The 'Family' passed to @bind@ must be the 387-- same as that passed to 'socket'. If the special port number 388-- 'aNY_PORT' is passed then the system assigns the next available 389-- use port. 390bind :: Socket -- Unconnected Socket 391 -> SockAddr -- Address to Bind to 392 -> IO () 393bind (MkSocket s _family _stype _protocol socketStatus) addr = do 394 modifyMVar_ socketStatus $ \ status -> do 395 if status /= NotConnected 396 then 397 ioError (userError ("bind: can't peform bind on socket in status " ++ 398 show status)) 399 else do 400 withSockAddr addr $ \p_addr sz -> do 401 _status <- throwSocketErrorIfMinus1Retry "bind" $ c_bind s p_addr (fromIntegral sz) 402 return Bound 403 404----------------------------------------------------------------------------- 405-- Connecting a socket 406 407-- | Connect to a remote socket at address. 408connect :: Socket -- Unconnected Socket 409 -> SockAddr -- Socket address stuff 410 -> IO () 411connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = do 412 modifyMVar_ socketStatus $ \currentStatus -> do 413 if currentStatus /= NotConnected && currentStatus /= Bound 414 then 415 ioError (userError ("connect: can't peform connect on socket in status " ++ 416 show currentStatus)) 417 else do 418 withSockAddr addr $ \p_addr sz -> do 419 420 let connectLoop = do 421 r <- c_connect s p_addr (fromIntegral sz) 422 if r == -1 423 then do 424#if !(defined(HAVE_WINSOCK2_H) && !defined(cygwin32_HOST_OS)) 425 err <- getErrno 426 case () of 427 _ | err == eINTR -> connectLoop 428 _ | err == eINPROGRESS -> connectBlocked 429-- _ | err == eAGAIN -> connectBlocked 430 _otherwise -> throwSocketError "connect" 431#else 432 rc <- c_getLastError 433 case rc of 434 #{const WSANOTINITIALISED} -> do 435 withSocketsDo (return ()) 436 r <- c_connect s p_addr (fromIntegral sz) 437 if r == -1 438 then throwSocketError "connect" 439 else return r 440 _ -> throwSocketError "connect" 441#endif 442 else return r 443 444 connectBlocked = do 445 threadWaitWrite (fromIntegral s) 446 err <- getSocketOption sock SoError 447 if (err == 0) 448 then return 0 449 else throwSocketErrorCode "connect" (fromIntegral err) 450 451 connectLoop 452 return Connected 453 454----------------------------------------------------------------------------- 455-- Listen 456 457-- | Listen for connections made to the socket. The second argument 458-- specifies the maximum number of queued connections and should be at 459-- least 1; the maximum value is system-dependent (usually 5). 460listen :: Socket -- Connected & Bound Socket 461 -> Int -- Queue Length 462 -> IO () 463listen (MkSocket s _family _stype _protocol socketStatus) backlog = do 464 modifyMVar_ socketStatus $ \ status -> do 465 if status /= Bound 466 then 467 ioError (userError ("listen: can't peform listen on socket in status " ++ 468 show status)) 469 else do 470 throwSocketErrorIfMinus1Retry "listen" (c_listen s (fromIntegral backlog)) 471 return Listening 472 473----------------------------------------------------------------------------- 474-- Accept 475-- 476-- A call to `accept' only returns when data is available on the given 477-- socket, unless the socket has been set to non-blocking. It will 478-- return a new socket which should be used to read the incoming data and 479-- should then be closed. Using the socket returned by `accept' allows 480-- incoming requests to be queued on the original socket. 481 482-- | Accept a connection. The socket must be bound to an address and 483-- listening for connections. The return value is a pair @(conn, 484-- address)@ where @conn@ is a new socket object usable to send and 485-- receive data on the connection, and @address@ is the address bound 486-- to the socket on the other end of the connection. 487accept :: Socket -- Queue Socket 488 -> IO (Socket, -- Readable Socket 489 SockAddr) -- Peer details 490 491accept sock@(MkSocket s family stype protocol status) = do 492 currentStatus <- readMVar status 493 okay <- isAcceptable sock 494 if not okay 495 then 496 ioError (userError ("accept: can't perform accept on socket (" ++ (show (family,stype,protocol)) ++") in status " ++ 497 show currentStatus)) 498 else do 499 let sz = sizeOfSockAddrByFamily family 500 allocaBytes sz $ \ sockaddr -> do 501#if defined(mingw32_HOST_OS) && defined(__GLASGOW_HASKELL__) 502 new_sock <- 503 if threaded 504 then with (fromIntegral sz) $ \ ptr_len -> 505 throwSocketErrorIfMinus1Retry "Network.Socket.accept" $ 506 c_accept_safe s sockaddr ptr_len 507 else do 508 paramData <- c_newAcceptParams s (fromIntegral sz) sockaddr 509 rc <- asyncDoProc c_acceptDoProc paramData 510 new_sock <- c_acceptNewSock paramData 511 c_free paramData 512 when (rc /= 0) $ 513 throwSocketErrorCode "Network.Socket.accept" (fromIntegral rc) 514 return new_sock 515#else 516 with (fromIntegral sz) $ \ ptr_len -> do 517 new_sock <- 518# ifdef HAVE_ACCEPT4 519 throwSocketErrorIfMinus1RetryMayBlock "accept" 520 (threadWaitRead (fromIntegral s)) 521 (c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK)) 522# else 523 throwSocketErrorWaitRead sock "accept" 524 (c_accept s sockaddr ptr_len) 525# endif /* HAVE_ACCEPT4 */ 526#endif 527 setNonBlockIfNeeded new_sock 528 addr <- peekSockAddr sockaddr 529 new_status <- newMVar Connected 530 return ((MkSocket new_sock family stype protocol new_status), addr) 531 532#if defined(mingw32_HOST_OS) 533foreign import ccall unsafe "HsNet.h acceptNewSock" 534 c_acceptNewSock :: Ptr () -> IO CInt 535foreign import ccall unsafe "HsNet.h newAcceptParams" 536 c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ()) 537foreign import ccall unsafe "HsNet.h &acceptDoProc" 538 c_acceptDoProc :: FunPtr (Ptr () -> IO Int) 539foreign import ccall unsafe "free" 540 c_free:: Ptr a -> IO () 541#endif 542 543----------------------------------------------------------------------------- 544-- ** Sending and reciving data 545 546-- $sendrecv 547-- 548-- Do not use the @send@ and @recv@ functions defined in this module 549-- in new code, as they incorrectly represent binary data as a Unicode 550-- string. As a result, these functions are inefficient and may lead 551-- to bugs in the program. Instead use the @send@ and @recv@ 552-- functions defined in the 'Network.Socket.ByteString' module. 553 554----------------------------------------------------------------------------- 555-- sendTo & recvFrom 556 557-- | Send data to the socket. The recipient can be specified 558-- explicitly, so the socket need not be in a connected state. 559-- Returns the number of bytes sent. Applications are responsible for 560-- ensuring that all data has been sent. 561-- 562-- NOTE: blocking on Windows unless you compile with -threaded (see 563-- GHC ticket #1129) 564sendTo :: Socket -- (possibly) bound/connected Socket 565 -> String -- Data to send 566 -> SockAddr 567 -> IO Int -- Number of Bytes sent 568sendTo sock xs addr = do 569 withCString xs $ \str -> do 570 sendBufTo sock str (length xs) addr 571 572-- | Send data to the socket. The recipient can be specified 573-- explicitly, so the socket need not be in a connected state. 574-- Returns the number of bytes sent. Applications are responsible for 575-- ensuring that all data has been sent. 576sendBufTo :: Socket -- (possibly) bound/connected Socket 577 -> Ptr a -> Int -- Data to send 578 -> SockAddr 579 -> IO Int -- Number of Bytes sent 580sendBufTo sock@(MkSocket s _family _stype _protocol _status) ptr nbytes addr = do 581 withSockAddr addr $ \p_addr sz -> do 582 liftM fromIntegral $ 583 throwSocketErrorWaitWrite sock "sendTo" $ 584 c_sendto s ptr (fromIntegral $ nbytes) 0{-flags-} 585 p_addr (fromIntegral sz) 586 587-- | Receive data from the socket. The socket need not be in a 588-- connected state. Returns @(bytes, nbytes, address)@ where @bytes@ 589-- is a @String@ of length @nbytes@ representing the data received and 590-- @address@ is a 'SockAddr' representing the address of the sending 591-- socket. 592-- 593-- NOTE: blocking on Windows unless you compile with -threaded (see 594-- GHC ticket #1129) 595recvFrom :: Socket -> Int -> IO (String, Int, SockAddr) 596recvFrom sock nbytes = 597 allocaBytes nbytes $ \ptr -> do 598 (len, sockaddr) <- recvBufFrom sock ptr nbytes 599 str <- peekCStringLen (ptr, len) 600 return (str, len, sockaddr) 601 602-- | Receive data from the socket, writing it into buffer instead of 603-- creating a new string. The socket need not be in a connected 604-- state. Returns @(nbytes, address)@ where @nbytes@ is the number of 605-- bytes received and @address@ is a 'SockAddr' representing the 606-- address of the sending socket. 607-- 608-- NOTE: blocking on Windows unless you compile with -threaded (see 609-- GHC ticket #1129) 610recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr) 611recvBufFrom sock@(MkSocket s family _stype _protocol _status) ptr nbytes 612 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvFrom") 613 | otherwise = 614 withNewSockAddr family $ \ptr_addr sz -> do 615 alloca $ \ptr_len -> do 616 poke ptr_len (fromIntegral sz) 617 len <- throwSocketErrorWaitRead sock "recvFrom" $ 618 c_recvfrom s ptr (fromIntegral nbytes) 0{-flags-} 619 ptr_addr ptr_len 620 let len' = fromIntegral len 621 if len' == 0 622 then ioError (mkEOFError "Network.Socket.recvFrom") 623 else do 624 flg <- isConnected sock 625 -- For at least one implementation (WinSock 2), recvfrom() ignores 626 -- filling in the sockaddr for connected TCP sockets. Cope with 627 -- this by using getPeerName instead. 628 sockaddr <- 629 if flg then 630 getPeerName sock 631 else 632 peekSockAddr ptr_addr 633 return (len', sockaddr) 634 635----------------------------------------------------------------------------- 636-- send & recv 637 638-- | Send data to the socket. The socket must be connected to a remote 639-- socket. Returns the number of bytes sent. Applications are 640-- responsible for ensuring that all data has been sent. 641send :: Socket -- Bound/Connected Socket 642 -> String -- Data to send 643 -> IO Int -- Number of Bytes sent 644send sock@(MkSocket s _family _stype _protocol _status) xs = do 645 let len = length xs 646 withCString xs $ \str -> do 647 liftM fromIntegral $ 648#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) 649# if __GLASGOW_HASKELL__ >= 611 650 writeRawBufferPtr 651 "Network.Socket.send" 652 (socket2FD sock) 653 (castPtr str) 654 0 655 (fromIntegral len) 656#else 657 writeRawBufferPtr 658 "Network.Socket.send" 659 (fromIntegral s) 660 True 661 str 662 0 663 (fromIntegral len) 664#endif 665 666#else 667 throwSocketErrorWaitWrite sock "send" $ 668 c_send s str (fromIntegral len) 0{-flags-} 669#endif 670 671-- | Send data to the socket. The socket must be connected to a remote 672-- socket. Returns the number of bytes sent. Applications are 673-- responsible for ensuring that all data has been sent. 674sendBuf :: Socket -- Bound/Connected Socket 675 -> Ptr Word8 -- Pointer to the data to send 676 -> Int -- Length of the buffer 677 -> IO Int -- Number of Bytes sent 678sendBuf sock@(MkSocket s _family _stype _protocol _status) str len = do 679 liftM fromIntegral $ 680#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) 681# if __GLASGOW_HASKELL__ >= 611 682 writeRawBufferPtr 683 "Network.Socket.sendBuf" 684 (socket2FD sock) 685 (castPtr str) 686 0 687 (fromIntegral len) 688# else 689 writeRawBufferPtr 690 "Network.Socket.sendBuf" 691 (fromIntegral s) 692 True 693 str 694 0 695 (fromIntegral len) 696# endif 697#else 698 throwSocketErrorWaitWrite sock "sendBuf" $ 699 c_send s str (fromIntegral len) 0{-flags-} 700#endif 701 702 703-- | Receive data from the socket. The socket must be in a connected 704-- state. This function may return fewer bytes than specified. If the 705-- message is longer than the specified length, it may be discarded 706-- depending on the type of socket. This function may block until a 707-- message arrives. 708-- 709-- Considering hardware and network realities, the maximum number of 710-- bytes to receive should be a small power of 2, e.g., 4096. 711-- 712-- For TCP sockets, a zero length return value means the peer has 713-- closed its half side of the connection. 714recv :: Socket -> Int -> IO String 715recv sock l = recvLen sock l >>= \ (s,_) -> return s 716 717recvLen :: Socket -> Int -> IO (String, Int) 718recvLen sock@(MkSocket s _family _stype _protocol _status) nbytes 719 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recv") 720 | otherwise = do 721 allocaBytes nbytes $ \ptr -> do 722 len <- 723#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) 724# if __GLASGOW_HASKELL__ >= 611 725 readRawBufferPtr "Network.Socket.recvLen" (socket2FD sock) ptr 0 726 (fromIntegral nbytes) 727#else 728 readRawBufferPtr "Network.Socket.recvLen" (fromIntegral s) True ptr 0 729 (fromIntegral nbytes) 730#endif 731#else 732 throwSocketErrorWaitRead sock "recv" $ 733 c_recv s ptr (fromIntegral nbytes) 0{-flags-} 734#endif 735 let len' = fromIntegral len 736 if len' == 0 737 then ioError (mkEOFError "Network.Socket.recv") 738 else do 739 s' <- peekCStringLen (castPtr ptr,len') 740 return (s', len') 741 742-- | Receive data from the socket. The socket must be in a connected 743-- state. This function may return fewer bytes than specified. If the 744-- message is longer than the specified length, it may be discarded 745-- depending on the type of socket. This function may block until a 746-- message arrives. 747-- 748-- Considering hardware and network realities, the maximum number of 749-- bytes to receive should be a small power of 2, e.g., 4096. 750-- 751-- For TCP sockets, a zero length return value means the peer has 752-- closed its half side of the connection. 753recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int 754recvBuf sock p l = recvLenBuf sock p l 755 756recvLenBuf :: Socket -> Ptr Word8 -> Int -> IO Int 757recvLenBuf sock@(MkSocket s _family _stype _protocol _status) ptr nbytes 758 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf") 759 | otherwise = do 760 len <- 761#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) 762# if __GLASGOW_HASKELL__ >= 611 763 readRawBufferPtr "Network.Socket.recvLenBuf" (socket2FD sock) ptr 0 764 (fromIntegral nbytes) 765#else 766 readRawBufferPtr "Network.Socket.recvLenBuf" (fromIntegral s) True ptr 0 767 (fromIntegral nbytes) 768#endif 769#else 770 throwSocketErrorWaitRead sock "recvBuf" $ 771 c_recv s (castPtr ptr) (fromIntegral nbytes) 0{-flags-} 772#endif 773 let len' = fromIntegral len 774 if len' == 0 775 then ioError (mkEOFError "Network.Socket.recvBuf") 776 else return len' 777 778 779-- --------------------------------------------------------------------------- 780-- socketPort 781-- 782-- The port number the given socket is currently connected to can be 783-- determined by calling $port$, is generally only useful when bind 784-- was given $aNY\_PORT$. 785 786socketPort :: Socket -- Connected & Bound Socket 787 -> IO PortNumber -- Port Number of Socket 788socketPort sock@(MkSocket _ AF_INET _ _ _) = do 789 (SockAddrInet port _) <- getSocketName sock 790 return port 791#if defined(IPV6_SOCKET_SUPPORT) 792socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do 793 (SockAddrInet6 port _ _ _) <- getSocketName sock 794 return port 795#endif 796socketPort (MkSocket _ family _ _ _) = 797 ioError (userError ("socketPort: not supported for Family " ++ show family)) 798 799 800-- --------------------------------------------------------------------------- 801-- getPeerName 802 803-- Calling $getPeerName$ returns the address details of the machine, 804-- other than the local one, which is connected to the socket. This is 805-- used in programs such as FTP to determine where to send the 806-- returning data. The corresponding call to get the details of the 807-- local machine is $getSocketName$. 808 809getPeerName :: Socket -> IO SockAddr 810getPeerName (MkSocket s family _ _ _) = do 811 withNewSockAddr family $ \ptr sz -> do 812 with (fromIntegral sz) $ \int_star -> do 813 throwSocketErrorIfMinus1Retry "getPeerName" $ c_getpeername s ptr int_star 814 _sz <- peek int_star 815 peekSockAddr ptr 816 817getSocketName :: Socket -> IO SockAddr 818getSocketName (MkSocket s family _ _ _) = do 819 withNewSockAddr family $ \ptr sz -> do 820 with (fromIntegral sz) $ \int_star -> do 821 throwSocketErrorIfMinus1Retry "getSocketName" $ c_getsockname s ptr int_star 822 peekSockAddr ptr 823 824----------------------------------------------------------------------------- 825-- Socket Properties 826 827-- | Socket options for use with 'setSocketOption' and 'getSocketOption'. 828-- 829-- The existence of a constructor does not imply that the relevant option 830-- is supported on your system: see 'isSupportedSocketOption' 831data SocketOption 832 = Debug -- ^ SO_DEBUG 833 | ReuseAddr -- ^ SO_REUSEADDR 834 | Type -- ^ SO_TYPE 835 | SoError -- ^ SO_ERROR 836 | DontRoute -- ^ SO_DONTROUTE 837 | Broadcast -- ^ SO_BROADCAST 838 | SendBuffer -- ^ SO_SNDBUF 839 | RecvBuffer -- ^ SO_RCVBUF 840 | KeepAlive -- ^ SO_KEEPALIVE 841 | OOBInline -- ^ SO_OOBINLINE 842 | TimeToLive -- ^ IP_TTL 843 | MaxSegment -- ^ TCP_MAXSEG 844 | NoDelay -- ^ TCP_NODELAY 845 | Cork -- ^ TCP_CORK 846 | Linger -- ^ SO_LINGER 847 | ReusePort -- ^ SO_REUSEPORT 848 | RecvLowWater -- ^ SO_RCVLOWAT 849 | SendLowWater -- ^ SO_SNDLOWAT 850 | RecvTimeOut -- ^ SO_RCVTIMEO 851 | SendTimeOut -- ^ SO_SNDTIMEO 852 | UseLoopBack -- ^ SO_USELOOPBACK 853 | IPv6Only -- ^ IPV6_V6ONLY 854 deriving (Show, Typeable) 855 856-- | Does the 'SocketOption' exist on this system? 857isSupportedSocketOption :: SocketOption -> Bool 858isSupportedSocketOption = isJust . packSocketOption 859 860-- | For a socket option, return Just (level, value) where level is the 861-- corresponding C option level constant (e.g. SOL_SOCKET) and value is 862-- the option constant itself (e.g. SO_DEBUG) 863-- If either constant does not exist, return Nothing. 864packSocketOption :: SocketOption -> Maybe (CInt, CInt) 865packSocketOption so = 866 -- The Just here is a hack to disable GHC's overlapping pattern detection: 867 -- the problem is if all constants are present, the fallback pattern is 868 -- redundant, but if they aren't then it isn't. Hence we introduce an 869 -- extra pattern (Nothing) that can't possibly happen, so that the 870 -- fallback is always (in principle) necessary. 871 -- I feel a little bad for including this, but such are the sacrifices we 872 -- make while working with CPP - excluding the fallback pattern correctly 873 -- would be a serious nuisance. 874 -- (NB: comments elsewhere in this file refer to this one) 875 case Just so of 876#ifdef SOL_SOCKET 877#ifdef SO_DEBUG 878 Just Debug -> Just ((#const SOL_SOCKET), (#const SO_DEBUG)) 879#endif 880#ifdef SO_REUSEADDR 881 Just ReuseAddr -> Just ((#const SOL_SOCKET), (#const SO_REUSEADDR)) 882#endif 883#ifdef SO_TYPE 884 Just Type -> Just ((#const SOL_SOCKET), (#const SO_TYPE)) 885#endif 886#ifdef SO_ERROR 887 Just SoError -> Just ((#const SOL_SOCKET), (#const SO_ERROR)) 888#endif 889#ifdef SO_DONTROUTE 890 Just DontRoute -> Just ((#const SOL_SOCKET), (#const SO_DONTROUTE)) 891#endif 892#ifdef SO_BROADCAST 893 Just Broadcast -> Just ((#const SOL_SOCKET), (#const SO_BROADCAST)) 894#endif 895#ifdef SO_SNDBUF 896 Just SendBuffer -> Just ((#const SOL_SOCKET), (#const SO_SNDBUF)) 897#endif 898#ifdef SO_RCVBUF 899 Just RecvBuffer -> Just ((#const SOL_SOCKET), (#const SO_RCVBUF)) 900#endif 901#ifdef SO_KEEPALIVE 902 Just KeepAlive -> Just ((#const SOL_SOCKET), (#const SO_KEEPALIVE)) 903#endif 904#ifdef SO_OOBINLINE 905 Just OOBInline -> Just ((#const SOL_SOCKET), (#const SO_OOBINLINE)) 906#endif 907#ifdef SO_LINGER 908 Just Linger -> Just ((#const SOL_SOCKET), (#const SO_LINGER)) 909#endif 910#ifdef SO_REUSEPORT 911 Just ReusePort -> Just ((#const SOL_SOCKET), (#const SO_REUSEPORT)) 912#endif 913#ifdef SO_RCVLOWAT 914 Just RecvLowWater -> Just ((#const SOL_SOCKET), (#const SO_RCVLOWAT)) 915#endif 916#ifdef SO_SNDLOWAT 917 Just SendLowWater -> Just ((#const SOL_SOCKET), (#const SO_SNDLOWAT)) 918#endif 919#ifdef SO_RCVTIMEO 920 Just RecvTimeOut -> Just ((#const SOL_SOCKET), (#const SO_RCVTIMEO)) 921#endif 922#ifdef SO_SNDTIMEO 923 Just SendTimeOut -> Just ((#const SOL_SOCKET), (#const SO_SNDTIMEO)) 924#endif 925#ifdef SO_USELOOPBACK 926 Just UseLoopBack -> Just ((#const SOL_SOCKET), (#const SO_USELOOPBACK)) 927#endif 928#endif // SOL_SOCKET 929#ifdef IPPROTO_IP 930#ifdef IP_TTL 931 Just TimeToLive -> Just ((#const IPPROTO_IP), (#const IP_TTL)) 932#endif 933#endif // IPPROTO_IP 934#ifdef IPPROTO_TCP 935#ifdef TCP_MAXSEG 936 Just MaxSegment -> Just ((#const IPPROTO_TCP), (#const TCP_MAXSEG)) 937#endif 938#ifdef TCP_NODELAY 939 Just NoDelay -> Just ((#const IPPROTO_TCP), (#const TCP_NODELAY)) 940#endif 941#ifdef TCP_CORK 942 Just Cork -> Just ((#const IPPROTO_TCP), (#const TCP_CORK)) 943#endif 944#endif // IPPROTO_TCP 945#ifdef IPPROTO_IPV6 946#if HAVE_DECL_IPV6_V6ONLY 947 Just IPv6Only -> Just ((#const IPPROTO_IPV6), (#const IPV6_V6ONLY)) 948#endif 949#endif // IPPROTO_IPV6 950 _ -> Nothing 951 952-- | Return the option level and option value if they exist, 953-- otherwise throw an error that begins "Network.Socket." ++ the String 954-- parameter 955packSocketOption' :: String -> SocketOption -> IO (CInt, CInt) 956packSocketOption' caller so = maybe err return (packSocketOption so) 957 where 958 err = ioError . userError . concat $ ["Network.Socket.", caller, 959 ": socket option ", show so, " unsupported on this system"] 960 961-- | Set a socket option that expects an Int value. 962-- There is currently no API to set e.g. the timeval socket options 963setSocketOption :: Socket 964 -> SocketOption -- Option Name 965 -> Int -- Option Value 966 -> IO () 967setSocketOption (MkSocket s _ _ _ _) so v = do 968 (level, opt) <- packSocketOption' "setSocketOption" so 969 with (fromIntegral v) $ \ptr_v -> do 970 throwSocketErrorIfMinus1_ "setSocketOption" $ 971 c_setsockopt s level opt ptr_v 972 (fromIntegral (sizeOf (undefined :: CInt))) 973 return () 974 975 976-- | Get a socket option that gives an Int value. 977-- There is currently no API to get e.g. the timeval socket options 978getSocketOption :: Socket 979 -> SocketOption -- Option Name 980 -> IO Int -- Option Value 981getSocketOption (MkSocket s _ _ _ _) so = do 982 (level, opt) <- packSocketOption' "getSocketOption" so 983 alloca $ \ptr_v -> 984 with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do 985 throwSocketErrorIfMinus1Retry "getSocketOption" $ 986 c_getsockopt s level opt ptr_v ptr_sz 987 fromIntegral `liftM` peek ptr_v 988 989 990#ifdef HAVE_STRUCT_UCRED 991-- | Returns the processID, userID and groupID of the socket's peer. 992-- 993-- Only available on platforms that support SO_PEERCRED on domain sockets. 994getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt) 995getPeerCred sock = do 996 let fd = fdSocket sock 997 let sz = (fromIntegral (#const sizeof(struct ucred))) 998 with sz $ \ ptr_cr -> 999 alloca $ \ ptr_sz -> do 1000 poke ptr_sz sz 1001 throwSocketErrorIfMinus1Retry "getPeerCred" $ 1002 c_getsockopt fd (#const SOL_SOCKET) (#const SO_PEERCRED) ptr_cr ptr_sz 1003 pid <- (#peek struct ucred, pid) ptr_cr 1004 uid <- (#peek struct ucred, uid) ptr_cr 1005 gid <- (#peek struct ucred, gid) ptr_cr 1006 return (pid, uid, gid) 1007#endif 1008 1009##if !(MIN_VERSION_base(4,3,1)) 1010closeFdWith closer fd = closer fd 1011##endif 1012 1013#if defined(DOMAIN_SOCKET_SUPPORT) 1014-- sending/receiving ancillary socket data; low-level mechanism 1015-- for transmitting file descriptors, mainly. 1016sendFd :: Socket -> CInt -> IO () 1017sendFd sock outfd = do 1018 throwSocketErrorWaitWrite sock "sendFd" $ 1019 c_sendFd (fdSocket sock) outfd 1020 -- Note: If Winsock supported FD-passing, thi would have been 1021 -- incorrect (since socket FDs need to be closed via closesocket().) 1022 closeFd outfd 1023 1024recvFd :: Socket -> IO CInt 1025recvFd sock = do 1026 theFd <- throwSocketErrorWaitRead sock "recvFd" $ 1027 c_recvFd (fdSocket sock) 1028 return theFd 1029 1030foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt 1031foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt 1032 1033#endif 1034 1035-- --------------------------------------------------------------------------- 1036-- Utility Functions 1037 1038aNY_PORT :: PortNumber 1039aNY_PORT = 0 1040 1041-- | The IPv4 wild card address. 1042 1043iNADDR_ANY :: HostAddress 1044iNADDR_ANY = htonl (#const INADDR_ANY) 1045 1046foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32 1047 1048#if defined(IPV6_SOCKET_SUPPORT) 1049-- | The IPv6 wild card address. 1050 1051iN6ADDR_ANY :: HostAddress6 1052iN6ADDR_ANY = (0, 0, 0, 0) 1053#endif 1054 1055sOMAXCONN :: Int 1056sOMAXCONN = #const SOMAXCONN 1057 1058sOL_SOCKET :: Int 1059sOL_SOCKET = #const SOL_SOCKET 1060 1061#ifdef SCM_RIGHTS 1062sCM_RIGHTS :: Int 1063sCM_RIGHTS = #const SCM_RIGHTS 1064#endif 1065 1066-- | This is the value of SOMAXCONN, typically 128. 1067-- 128 is good enough for normal network servers but 1068-- is too small for high performance servers. 1069maxListenQueue :: Int 1070maxListenQueue = sOMAXCONN 1071 1072-- ----------------------------------------------------------------------------- 1073 1074data ShutdownCmd 1075 = ShutdownReceive 1076 | ShutdownSend 1077 | ShutdownBoth 1078 deriving Typeable 1079 1080sdownCmdToInt :: ShutdownCmd -> CInt 1081sdownCmdToInt ShutdownReceive = 0 1082sdownCmdToInt ShutdownSend = 1 1083sdownCmdToInt ShutdownBoth = 2 1084 1085-- | Shut down one or both halves of the connection, depending on the 1086-- second argument to the function. If the second argument is 1087-- 'ShutdownReceive', further receives are disallowed. If it is 1088-- 'ShutdownSend', further sends are disallowed. If it is 1089-- 'ShutdownBoth', further sends and receives are disallowed. 1090shutdown :: Socket -> ShutdownCmd -> IO () 1091shutdown (MkSocket s _ _ _ _) stype = do 1092 throwSocketErrorIfMinus1Retry "shutdown" (c_shutdown s (sdownCmdToInt stype)) 1093 return () 1094 1095-- ----------------------------------------------------------------------------- 1096 1097-- | Close the socket. All future operations on the socket object 1098-- will fail. The remote end will receive no more data (after queued 1099-- data is flushed). 1100close :: Socket -> IO () 1101close (MkSocket s _ _ _ socketStatus) = do 1102 modifyMVar_ socketStatus $ \ status -> 1103 case status of 1104 ConvertedToHandle -> 1105 ioError (userError ("close: converted to a Handle, use hClose instead")) 1106 Closed -> 1107 return status 1108 _ -> closeFdWith (closeFd . fromIntegral) (fromIntegral s) >> return Closed 1109 1110-- ----------------------------------------------------------------------------- 1111 1112isConnected :: Socket -> IO Bool 1113isConnected (MkSocket _ _ _ _ status) = do 1114 value <- readMVar status 1115 return (value == Connected) 1116 1117-- ----------------------------------------------------------------------------- 1118-- Socket Predicates 1119 1120isBound :: Socket -> IO Bool 1121isBound (MkSocket _ _ _ _ status) = do 1122 value <- readMVar status 1123 return (value == Bound) 1124 1125isListening :: Socket -> IO Bool 1126isListening (MkSocket _ _ _ _ status) = do 1127 value <- readMVar status 1128 return (value == Listening) 1129 1130isReadable :: Socket -> IO Bool 1131isReadable (MkSocket _ _ _ _ status) = do 1132 value <- readMVar status 1133 return (value == Listening || value == Connected) 1134 1135isWritable :: Socket -> IO Bool 1136isWritable = isReadable -- sort of. 1137 1138isAcceptable :: Socket -> IO Bool 1139#if defined(DOMAIN_SOCKET_SUPPORT) 1140isAcceptable (MkSocket _ AF_UNIX x _ status) 1141 | x == Stream || x == SeqPacket = do 1142 value <- readMVar status 1143 return (value == Connected || value == Bound || value == Listening) 1144isAcceptable (MkSocket _ AF_UNIX _ _ _) = return False 1145#endif 1146isAcceptable (MkSocket _ _ _ _ status) = do 1147 value <- readMVar status 1148 return (value == Connected || value == Listening) 1149 1150-- ----------------------------------------------------------------------------- 1151-- Internet address manipulation routines: 1152 1153inet_addr :: String -> IO HostAddress 1154inet_addr ipstr = do 1155 withCString ipstr $ \str -> do 1156 had <- c_inet_addr str 1157 if had == -1 1158 then ioError (userError ("inet_addr: Malformed address: " ++ ipstr)) 1159 else return had -- network byte order 1160 1161inet_ntoa :: HostAddress -> IO String 1162inet_ntoa haddr = do 1163 pstr <- c_inet_ntoa haddr 1164 peekCString pstr 1165 1166-- | Turns a Socket into an 'Handle'. By default, the new handle is 1167-- unbuffered. Use 'System.IO.hSetBuffering' to change the buffering. 1168-- 1169-- Note that since a 'Handle' is automatically closed by a finalizer 1170-- when it is no longer referenced, you should avoid doing any more 1171-- operations on the 'Socket' after calling 'socketToHandle'. To 1172-- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose' 1173-- on the 'Handle'. 1174 1175#ifndef __PARALLEL_HASKELL__ 1176socketToHandle :: Socket -> IOMode -> IO Handle 1177socketToHandle s@(MkSocket fd _ _ _ socketStatus) mode = do 1178 modifyMVar socketStatus $ \ status -> 1179 if status == ConvertedToHandle 1180 then ioError (userError ("socketToHandle: already a Handle")) 1181 else do 1182# if __GLASGOW_HASKELL__ >= 611 1183 h <- fdToHandle' (fromIntegral fd) (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-} 1184# elif __GLASGOW_HASKELL__ >= 608 1185 h <- fdToHandle' (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-} 1186# elif __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 608 1187 h <- openFd (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-} 1188# endif 1189 hSetBuffering h NoBuffering 1190 return (ConvertedToHandle, h) 1191#else 1192socketToHandle (MkSocket s family stype protocol status) m = 1193 error "socketToHandle not implemented in a parallel setup" 1194#endif 1195 1196-- | Pack a list of values into a bitmask. The possible mappings from 1197-- value to bit-to-set are given as the first argument. We assume 1198-- that each value can cause exactly one bit to be set; unpackBits will 1199-- break if this property is not true. 1200 1201packBits :: (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b 1202 1203packBits mapping xs = foldl' pack 0 mapping 1204 where pack acc (k, v) | k `elem` xs = acc .|. v 1205 | otherwise = acc 1206 1207-- | Unpack a bitmask into a list of values. 1208 1209unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a] 1210 1211-- Be permissive and ignore unknown bit values. At least on OS X, 1212-- getaddrinfo returns an ai_flags field with bits set that have no 1213-- entry in <netdb.h>. 1214unpackBits [] _ = [] 1215unpackBits ((k,v):xs) r 1216 | r .&. v /= 0 = k : unpackBits xs (r .&. complement v) 1217 | otherwise = unpackBits xs r 1218 1219----------------------------------------------------------------------------- 1220-- Address and service lookups 1221 1222#if defined(IPV6_SOCKET_SUPPORT) 1223 1224-- | Flags that control the querying behaviour of 'getAddrInfo'. 1225data AddrInfoFlag 1226 = AI_ADDRCONFIG 1227 | AI_ALL 1228 | AI_CANONNAME 1229 | AI_NUMERICHOST 1230 | AI_NUMERICSERV 1231 | AI_PASSIVE 1232 | AI_V4MAPPED 1233 deriving (Eq, Read, Show, Typeable) 1234 1235aiFlagMapping :: [(AddrInfoFlag, CInt)] 1236 1237aiFlagMapping = 1238 [ 1239#if HAVE_DECL_AI_ADDRCONFIG 1240 (AI_ADDRCONFIG, #const AI_ADDRCONFIG), 1241#else 1242 (AI_ADDRCONFIG, 0), 1243#endif 1244#if HAVE_DECL_AI_ALL 1245 (AI_ALL, #const AI_ALL), 1246#else 1247 (AI_ALL, 0), 1248#endif 1249 (AI_CANONNAME, #const AI_CANONNAME), 1250 (AI_NUMERICHOST, #const AI_NUMERICHOST), 1251#if HAVE_DECL_AI_NUMERICSERV 1252 (AI_NUMERICSERV, #const AI_NUMERICSERV), 1253#else 1254 (AI_NUMERICSERV, 0), 1255#endif 1256 (AI_PASSIVE, #const AI_PASSIVE), 1257#if HAVE_DECL_AI_V4MAPPED 1258 (AI_V4MAPPED, #const AI_V4MAPPED) 1259#else 1260 (AI_V4MAPPED, 0) 1261#endif 1262 ] 1263 1264-- | Indicate whether the given 'AddrInfoFlag' will have any effect on 1265-- this system. 1266addrInfoFlagImplemented :: AddrInfoFlag -> Bool 1267addrInfoFlagImplemented f = packBits aiFlagMapping [f] /= 0 1268 1269data AddrInfo = 1270 AddrInfo { 1271 addrFlags :: [AddrInfoFlag], 1272 addrFamily :: Family, 1273 addrSocketType :: SocketType, 1274 addrProtocol :: ProtocolNumber, 1275 addrAddress :: SockAddr, 1276 addrCanonName :: Maybe String 1277 } 1278 deriving (Eq, Show, Typeable) 1279 1280instance Storable AddrInfo where 1281 sizeOf _ = #const sizeof(struct addrinfo) 1282 alignment _ = alignment (undefined :: CInt) 1283 1284 peek p = do 1285 ai_flags <- (#peek struct addrinfo, ai_flags) p 1286 ai_family <- (#peek struct addrinfo, ai_family) p 1287 ai_socktype <- (#peek struct addrinfo, ai_socktype) p 1288 ai_protocol <- (#peek struct addrinfo, ai_protocol) p 1289 ai_addr <- (#peek struct addrinfo, ai_addr) p >>= peekSockAddr 1290 ai_canonname_ptr <- (#peek struct addrinfo, ai_canonname) p 1291 1292 ai_canonname <- if ai_canonname_ptr == nullPtr 1293 then return Nothing 1294 else liftM Just $ peekCString ai_canonname_ptr 1295 1296 socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype 1297 return (AddrInfo 1298 { 1299 addrFlags = unpackBits aiFlagMapping ai_flags, 1300 addrFamily = unpackFamily ai_family, 1301 addrSocketType = socktype, 1302 addrProtocol = ai_protocol, 1303 addrAddress = ai_addr, 1304 addrCanonName = ai_canonname 1305 }) 1306 1307 poke p (AddrInfo flags family socketType protocol _ _) = do 1308 c_stype <- packSocketTypeOrThrow "AddrInfo.poke" socketType 1309 1310 (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags) 1311 (#poke struct addrinfo, ai_family) p (packFamily family) 1312 (#poke struct addrinfo, ai_socktype) p c_stype 1313 (#poke struct addrinfo, ai_protocol) p protocol 1314 1315 -- stuff below is probably not needed, but let's zero it for safety 1316 1317 (#poke struct addrinfo, ai_addrlen) p (0::CSize) 1318 (#poke struct addrinfo, ai_addr) p nullPtr 1319 (#poke struct addrinfo, ai_canonname) p nullPtr 1320 (#poke struct addrinfo, ai_next) p nullPtr 1321 1322data NameInfoFlag 1323 = NI_DGRAM 1324 | NI_NAMEREQD 1325 | NI_NOFQDN 1326 | NI_NUMERICHOST 1327 | NI_NUMERICSERV 1328 deriving (Eq, Read, Show, Typeable) 1329 1330niFlagMapping :: [(NameInfoFlag, CInt)] 1331 1332niFlagMapping = [(NI_DGRAM, #const NI_DGRAM), 1333 (NI_NAMEREQD, #const NI_NAMEREQD), 1334 (NI_NOFQDN, #const NI_NOFQDN), 1335 (NI_NUMERICHOST, #const NI_NUMERICHOST), 1336 (NI_NUMERICSERV, #const NI_NUMERICSERV)] 1337 1338-- | Default hints for address lookup with 'getAddrInfo'. The values 1339-- of the 'addrAddress' and 'addrCanonName' fields are 'undefined', 1340-- and are never inspected by 'getAddrInfo'. 1341 1342defaultHints :: AddrInfo 1343 1344defaultHints = AddrInfo { 1345 addrFlags = [], 1346 addrFamily = AF_UNSPEC, 1347 addrSocketType = NoSocketType, 1348 addrProtocol = defaultProtocol, 1349 addrAddress = undefined, 1350 addrCanonName = undefined 1351 } 1352 1353-- | Resolve a host or service name to one or more addresses. 1354-- The 'AddrInfo' values that this function returns contain 'SockAddr' 1355-- values that you can pass directly to 'connect' or 1356-- 'bind'. 1357-- 1358-- This function is protocol independent. It can return both IPv4 and 1359-- IPv6 address information. 1360-- 1361-- The 'AddrInfo' argument specifies the preferred query behaviour, 1362-- socket options, or protocol. You can override these conveniently 1363-- using Haskell's record update syntax on 'defaultHints', for example 1364-- as follows: 1365-- 1366-- @ 1367-- myHints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] } 1368-- @ 1369-- 1370-- Values for 'addrFlags' control query behaviour. The supported 1371-- flags are as follows: 1372-- 1373-- [@AI_PASSIVE@] If no 'HostName' value is provided, the network 1374-- address in each 'SockAddr' 1375-- will be left as a "wild card", i.e. as either 'iNADDR_ANY' 1376-- or 'iN6ADDR_ANY'. This is useful for server applications that 1377-- will accept connections from any client. 1378-- 1379-- [@AI_CANONNAME@] The 'addrCanonName' field of the first returned 1380-- 'AddrInfo' will contain the "canonical name" of the host. 1381-- 1382-- [@AI_NUMERICHOST@] The 'HostName' argument /must/ be a numeric 1383-- address in string form, and network name lookups will not be 1384-- attempted. 1385-- 1386-- /Note/: Although the following flags are required by RFC 3493, they 1387-- may not have an effect on all platforms, because the underlying 1388-- network stack may not support them. To see whether a flag from the 1389-- list below will have any effect, call 'addrInfoFlagImplemented'. 1390-- 1391-- [@AI_NUMERICSERV@] The 'ServiceName' argument /must/ be a port 1392-- number in string form, and service name lookups will not be 1393-- attempted. 1394-- 1395-- [@AI_ADDRCONFIG@] The list of returned 'AddrInfo' values will 1396-- only contain IPv4 addresses if the local system has at least 1397-- one IPv4 interface configured, and likewise for IPv6. 1398-- 1399-- [@AI_V4MAPPED@] If an IPv6 lookup is performed, and no IPv6 1400-- addresses are found, IPv6-mapped IPv4 addresses will be 1401-- returned. 1402-- 1403-- [@AI_ALL@] If 'AI_ALL' is specified, return all matching IPv6 and 1404-- IPv4 addresses. Otherwise, this flag has no effect. 1405-- 1406-- You must provide a 'Just' value for at least one of the 'HostName' 1407-- or 'ServiceName' arguments. 'HostName' can be either a numeric 1408-- network address (dotted quad for IPv4, colon-separated hex for 1409-- IPv6) or a hostname. In the latter case, its addresses will be 1410-- looked up unless 'AI_NUMERICHOST' is specified as a hint. If you 1411-- do not provide a 'HostName' value /and/ do not set 'AI_PASSIVE' as 1412-- a hint, network addresses in the result will contain the address of 1413-- the loopback interface. 1414-- 1415-- If the query fails, this function throws an IO exception instead of 1416-- returning an empty list. Otherwise, it returns a non-empty list 1417-- of 'AddrInfo' values. 1418-- 1419-- There are several reasons why a query might result in several 1420-- values. For example, the queried-for host could be multihomed, or 1421-- the service might be available via several protocols. 1422-- 1423-- Note: the order of arguments is slightly different to that defined 1424-- for @getaddrinfo@ in RFC 2553. The 'AddrInfo' parameter comes first 1425-- to make partial application easier. 1426-- 1427-- Example: 1428-- @ 1429-- let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] } 1430-- addrs <- getAddrInfo (Just hints) (Just "www.haskell.org") (Just "http") 1431-- let addr = head addrs 1432-- sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) 1433-- connect sock (addrAddress addr) 1434-- @ 1435 1436getAddrInfo :: Maybe AddrInfo -- ^ preferred socket type or protocol 1437 -> Maybe HostName -- ^ host name to look up 1438 -> Maybe ServiceName -- ^ service name to look up 1439 -> IO [AddrInfo] -- ^ resolved address…
Large files files are truncated, but you can click here to view the full file