/Network/Socket.hsc
Unknown | 1673 lines | 1473 code | 200 blank | 0 comment | 0 complexity | d77799559c5a2ac36d3568829dc4138c MD5 | raw 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 (delete, 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 202import GHC.Conc (threadWaitRead, threadWaitWrite) 203##if MIN_VERSION_base(4,3,1) 204import GHC.Conc (closeFdWith) 205##endif 206# if defined(mingw32_HOST_OS) 207import GHC.Conc (asyncDoProc) 208import Foreign (FunPtr) 209# endif 210# if __GLASGOW_HASKELL__ >= 611 211import qualified GHC.IO.Device 212import GHC.IO.Handle.FD 213import GHC.IO.Exception 214import GHC.IO 215# else 216import GHC.IOBase 217import GHC.Handle 218# endif 219import qualified System.Posix.Internals 220 221# if __GLASGOW_HASKELL__ >= 611 222import GHC.IO.FD 223#endif 224 225import Network.Socket.Internal 226import Network.Socket.Types 227 228-- | Either a host name e.g., @\"haskell.org\"@ or a numeric host 229-- address string consisting of a dotted decimal IPv4 address or an 230-- IPv6 address e.g., @\"192.168.0.1\"@. 231type HostName = String 232type ServiceName = String 233 234-- ---------------------------------------------------------------------------- 235-- On Windows, our sockets are not put in non-blocking mode (non-blocking 236-- is not supported for regular file descriptors on Windows, and it would 237-- be a pain to support it only for sockets). So there are two cases: 238-- 239-- - the threaded RTS uses safe calls for socket operations to get 240-- non-blocking I/O, just like the rest of the I/O library 241-- 242-- - with the non-threaded RTS, only some operations on sockets will be 243-- non-blocking. Reads and writes go through the normal async I/O 244-- system. accept() uses asyncDoProc so is non-blocking. A handful 245-- of others (recvFrom, sendFd, recvFd) will block all threads - if this 246-- is a problem, -threaded is the workaround. 247-- 248##if defined(mingw32_HOST_OS) 249##define SAFE_ON_WIN safe 250##else 251##define SAFE_ON_WIN unsafe 252##endif 253 254----------------------------------------------------------------------------- 255-- Socket types 256 257#if __GLASGOW_HASKELL__ >= 611 && defined(mingw32_HOST_OS) 258socket2FD (MkSocket fd _ _ _ _) = 259 -- HACK, 1 means True 260 FD{fdFD = fd,fdIsSocket_ = 1} 261#endif 262 263mkSocket :: CInt 264 -> Family 265 -> SocketType 266 -> ProtocolNumber 267 -> SocketStatus 268 -> IO Socket 269mkSocket fd fam sType pNum stat = do 270 mStat <- newMVar stat 271 return (MkSocket fd fam sType pNum mStat) 272 273 274fdSocket :: Socket -> CInt 275fdSocket (MkSocket fd _ _ _ _) = fd 276 277-- | This is the default protocol for a given service. 278defaultProtocol :: ProtocolNumber 279defaultProtocol = 0 280 281----------------------------------------------------------------------------- 282-- SockAddr 283 284instance Show SockAddr where 285#if defined(DOMAIN_SOCKET_SUPPORT) 286 showsPrec _ (SockAddrUnix str) = showString str 287#endif 288 showsPrec _ (SockAddrInet port ha) 289 = showString (unsafePerformIO (inet_ntoa ha)) 290 . showString ":" 291 . shows port 292#if defined(IPV6_SOCKET_SUPPORT) 293 showsPrec _ addr@(SockAddrInet6 port _ _ _) 294 = showChar '[' 295 . showString (unsafePerformIO $ 296 fst `liftM` getNameInfo [NI_NUMERICHOST] True False addr >>= 297 maybe (fail "showsPrec: impossible internal error") return) 298 . showString "]:" 299 . shows port 300#endif 301 302----------------------------------------------------------------------------- 303-- Connection Functions 304 305-- In the following connection and binding primitives. The names of 306-- the equivalent C functions have been preserved where possible. It 307-- should be noted that some of these names used in the C library, 308-- \tr{bind} in particular, have a different meaning to many Haskell 309-- programmers and have thus been renamed by appending the prefix 310-- Socket. 311 312-- | Create a new socket using the given address family, socket type 313-- and protocol number. The address family is usually 'AF_INET', 314-- 'AF_INET6', or 'AF_UNIX'. The socket type is usually 'Stream' or 315-- 'Datagram'. The protocol number is usually 'defaultProtocol'. 316-- If 'AF_INET6' is used, the 'IPv6Only' socket option is set to 0 317-- so that both IPv4 and IPv6 can be handled with one socket. 318socket :: Family -- Family Name (usually AF_INET) 319 -> SocketType -- Socket Type (usually Stream) 320 -> ProtocolNumber -- Protocol Number (getProtocolByName to find value) 321 -> IO Socket -- Unconnected Socket 322socket family stype protocol = do 323 c_stype <- packSocketTypeOrThrow "socket" stype 324 fd <- throwSocketErrorIfMinus1Retry "socket" $ 325 c_socket (packFamily family) c_stype protocol 326 setNonBlockIfNeeded fd 327 socket_status <- newMVar NotConnected 328 let sock = MkSocket fd family stype protocol socket_status 329#if HAVE_DECL_IPV6_V6ONLY 330# if defined(mingw32_HOST_OS) 331 -- the IPv6Only option is only supported on Windows Vista and later, 332 -- so trying to change it might throw an error 333 when (family == AF_INET6) $ 334 E.catch (setSocketOption sock IPv6Only 0) $ (\(_ :: E.IOException) -> return ()) 335# else 336 when (family == AF_INET6) $ setSocketOption sock IPv6Only 0 337# endif 338#endif 339 return sock 340 341-- | Build a pair of connected socket objects using the given address 342-- family, socket type, and protocol number. Address family, socket 343-- type, and protocol number are as for the 'socket' function above. 344-- Availability: Unix. 345#if defined(DOMAIN_SOCKET_SUPPORT) 346socketPair :: Family -- Family Name (usually AF_INET or AF_INET6) 347 -> SocketType -- Socket Type (usually Stream) 348 -> ProtocolNumber -- Protocol Number 349 -> IO (Socket, Socket) -- unnamed and connected. 350socketPair family stype protocol = do 351 allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do 352 c_stype <- packSocketTypeOrThrow "socketPair" stype 353 _rc <- throwSocketErrorIfMinus1Retry "socketpair" $ 354 c_socketpair (packFamily family) c_stype protocol fdArr 355 [fd1,fd2] <- peekArray 2 fdArr 356 s1 <- mkNonBlockingSocket fd1 357 s2 <- mkNonBlockingSocket fd2 358 return (s1,s2) 359 where 360 mkNonBlockingSocket fd = do 361 setNonBlockIfNeeded fd 362 stat <- newMVar Connected 363 return (MkSocket fd family stype protocol stat) 364 365foreign import ccall unsafe "socketpair" 366 c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt 367#endif 368 369-- | Set the socket to nonblocking, if applicable to this platform. 370setNonBlockIfNeeded :: CInt -> IO () 371setNonBlockIfNeeded fd = 372#if __GLASGOW_HASKELL__ < 611 373 System.Posix.Internals.setNonBlockingFD fd 374#else 375 System.Posix.Internals.setNonBlockingFD fd True 376#endif 377 378----------------------------------------------------------------------------- 379-- Binding a socket 380 381-- | Bind the socket to an address. The socket must not already be 382-- bound. The 'Family' passed to @bind@ must be the 383-- same as that passed to 'socket'. If the special port number 384-- 'aNY_PORT' is passed then the system assigns the next available 385-- use port. 386bind :: Socket -- Unconnected Socket 387 -> SockAddr -- Address to Bind to 388 -> IO () 389bind (MkSocket s _family _stype _protocol socketStatus) addr = do 390 modifyMVar_ socketStatus $ \ status -> do 391 if status /= NotConnected 392 then 393 ioError (userError ("bind: can't peform bind on socket in status " ++ 394 show status)) 395 else do 396 withSockAddr addr $ \p_addr sz -> do 397 _status <- throwSocketErrorIfMinus1Retry "bind" $ c_bind s p_addr (fromIntegral sz) 398 return Bound 399 400----------------------------------------------------------------------------- 401-- Connecting a socket 402 403-- | Connect to a remote socket at address. 404connect :: Socket -- Unconnected Socket 405 -> SockAddr -- Socket address stuff 406 -> IO () 407connect sock@(MkSocket s _family _stype _protocol socketStatus) addr = do 408 modifyMVar_ socketStatus $ \currentStatus -> do 409 if currentStatus /= NotConnected && currentStatus /= Bound 410 then 411 ioError (userError ("connect: can't peform connect on socket in status " ++ 412 show currentStatus)) 413 else do 414 withSockAddr addr $ \p_addr sz -> do 415 416 let connectLoop = do 417 r <- c_connect s p_addr (fromIntegral sz) 418 if r == -1 419 then do 420#if !(defined(HAVE_WINSOCK2_H) && !defined(cygwin32_HOST_OS)) 421 err <- getErrno 422 case () of 423 _ | err == eINTR -> connectLoop 424 _ | err == eINPROGRESS -> connectBlocked 425-- _ | err == eAGAIN -> connectBlocked 426 _otherwise -> throwSocketError "connect" 427#else 428 rc <- c_getLastError 429 case rc of 430 #{const WSANOTINITIALISED} -> do 431 withSocketsDo (return ()) 432 r <- c_connect s p_addr (fromIntegral sz) 433 if r == -1 434 then throwSocketError "connect" 435 else return r 436 _ -> throwSocketError "connect" 437#endif 438 else return r 439 440 connectBlocked = do 441 threadWaitWrite (fromIntegral s) 442 err <- getSocketOption sock SoError 443 if (err == 0) 444 then return 0 445 else throwSocketErrorCode "connect" (fromIntegral err) 446 447 connectLoop 448 return Connected 449 450----------------------------------------------------------------------------- 451-- Listen 452 453-- | Listen for connections made to the socket. The second argument 454-- specifies the maximum number of queued connections and should be at 455-- least 1; the maximum value is system-dependent (usually 5). 456listen :: Socket -- Connected & Bound Socket 457 -> Int -- Queue Length 458 -> IO () 459listen (MkSocket s _family _stype _protocol socketStatus) backlog = do 460 modifyMVar_ socketStatus $ \ status -> do 461 if status /= Bound 462 then 463 ioError (userError ("listen: can't peform listen on socket in status " ++ 464 show status)) 465 else do 466 throwSocketErrorIfMinus1Retry "listen" (c_listen s (fromIntegral backlog)) 467 return Listening 468 469----------------------------------------------------------------------------- 470-- Accept 471-- 472-- A call to `accept' only returns when data is available on the given 473-- socket, unless the socket has been set to non-blocking. It will 474-- return a new socket which should be used to read the incoming data and 475-- should then be closed. Using the socket returned by `accept' allows 476-- incoming requests to be queued on the original socket. 477 478-- | Accept a connection. The socket must be bound to an address and 479-- listening for connections. The return value is a pair @(conn, 480-- address)@ where @conn@ is a new socket object usable to send and 481-- receive data on the connection, and @address@ is the address bound 482-- to the socket on the other end of the connection. 483accept :: Socket -- Queue Socket 484 -> IO (Socket, -- Readable Socket 485 SockAddr) -- Peer details 486 487accept sock@(MkSocket s family stype protocol status) = do 488 currentStatus <- readMVar status 489 okay <- isAcceptable sock 490 if not okay 491 then 492 ioError (userError ("accept: can't perform accept on socket (" ++ (show (family,stype,protocol)) ++") in status " ++ 493 show currentStatus)) 494 else do 495 let sz = sizeOfSockAddrByFamily family 496 allocaBytes sz $ \ sockaddr -> do 497#if defined(mingw32_HOST_OS) 498 new_sock <- 499 if threaded 500 then with (fromIntegral sz) $ \ ptr_len -> 501 throwSocketErrorIfMinus1Retry "Network.Socket.accept" $ 502 c_accept_safe s sockaddr ptr_len 503 else do 504 paramData <- c_newAcceptParams s (fromIntegral sz) sockaddr 505 rc <- asyncDoProc c_acceptDoProc paramData 506 new_sock <- c_acceptNewSock paramData 507 c_free paramData 508 when (rc /= 0) $ 509 throwSocketErrorCode "Network.Socket.accept" (fromIntegral rc) 510 return new_sock 511#else 512 with (fromIntegral sz) $ \ ptr_len -> do 513 new_sock <- 514# ifdef HAVE_ACCEPT4 515 throwSocketErrorIfMinus1RetryMayBlock "accept" 516 (threadWaitRead (fromIntegral s)) 517 (c_accept4 s sockaddr ptr_len (#const SOCK_NONBLOCK)) 518# else 519 throwSocketErrorWaitRead sock "accept" 520 (c_accept s sockaddr ptr_len) 521# endif /* HAVE_ACCEPT4 */ 522#endif 523 setNonBlockIfNeeded new_sock 524 addr <- peekSockAddr sockaddr 525 new_status <- newMVar Connected 526 return ((MkSocket new_sock family stype protocol new_status), addr) 527 528#if defined(mingw32_HOST_OS) 529foreign import ccall unsafe "HsNet.h acceptNewSock" 530 c_acceptNewSock :: Ptr () -> IO CInt 531foreign import ccall unsafe "HsNet.h newAcceptParams" 532 c_newAcceptParams :: CInt -> CInt -> Ptr a -> IO (Ptr ()) 533foreign import ccall unsafe "HsNet.h &acceptDoProc" 534 c_acceptDoProc :: FunPtr (Ptr () -> IO Int) 535foreign import ccall unsafe "free" 536 c_free:: Ptr a -> IO () 537#endif 538 539----------------------------------------------------------------------------- 540-- ** Sending and reciving data 541 542-- $sendrecv 543-- 544-- Do not use the @send@ and @recv@ functions defined in this module 545-- in new code, as they incorrectly represent binary data as a Unicode 546-- string. As a result, these functions are inefficient and may lead 547-- to bugs in the program. Instead use the @send@ and @recv@ 548-- functions defined in the 'Network.Socket.ByteString' module. 549 550----------------------------------------------------------------------------- 551-- sendTo & recvFrom 552 553-- | Send data to the socket. The recipient can be specified 554-- explicitly, so the socket need not be in a connected state. 555-- Returns the number of bytes sent. Applications are responsible for 556-- ensuring that all data has been sent. 557-- 558-- NOTE: blocking on Windows unless you compile with -threaded (see 559-- GHC ticket #1129) 560sendTo :: Socket -- (possibly) bound/connected Socket 561 -> String -- Data to send 562 -> SockAddr 563 -> IO Int -- Number of Bytes sent 564sendTo sock xs addr = do 565 withCString xs $ \str -> do 566 sendBufTo sock str (length xs) addr 567 568-- | Send data to the socket. The recipient can be specified 569-- explicitly, so the socket need not be in a connected state. 570-- Returns the number of bytes sent. Applications are responsible for 571-- ensuring that all data has been sent. 572sendBufTo :: Socket -- (possibly) bound/connected Socket 573 -> Ptr a -> Int -- Data to send 574 -> SockAddr 575 -> IO Int -- Number of Bytes sent 576sendBufTo sock@(MkSocket s _family _stype _protocol _status) ptr nbytes addr = do 577 withSockAddr addr $ \p_addr sz -> do 578 liftM fromIntegral $ 579 throwSocketErrorWaitWrite sock "sendTo" $ 580 c_sendto s ptr (fromIntegral $ nbytes) 0{-flags-} 581 p_addr (fromIntegral sz) 582 583-- | Receive data from the socket. The socket need not be in a 584-- connected state. Returns @(bytes, nbytes, address)@ where @bytes@ 585-- is a @String@ of length @nbytes@ representing the data received and 586-- @address@ is a 'SockAddr' representing the address of the sending 587-- socket. 588-- 589-- NOTE: blocking on Windows unless you compile with -threaded (see 590-- GHC ticket #1129) 591recvFrom :: Socket -> Int -> IO (String, Int, SockAddr) 592recvFrom sock nbytes = 593 allocaBytes nbytes $ \ptr -> do 594 (len, sockaddr) <- recvBufFrom sock ptr nbytes 595 str <- peekCStringLen (ptr, len) 596 return (str, len, sockaddr) 597 598-- | Receive data from the socket, writing it into buffer instead of 599-- creating a new string. The socket need not be in a connected 600-- state. Returns @(nbytes, address)@ where @nbytes@ is the number of 601-- bytes received and @address@ is a 'SockAddr' representing the 602-- address of the sending socket. 603-- 604-- NOTE: blocking on Windows unless you compile with -threaded (see 605-- GHC ticket #1129) 606recvBufFrom :: Socket -> Ptr a -> Int -> IO (Int, SockAddr) 607recvBufFrom sock@(MkSocket s family _stype _protocol _status) ptr nbytes 608 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvFrom") 609 | otherwise = 610 withNewSockAddr family $ \ptr_addr sz -> do 611 alloca $ \ptr_len -> do 612 poke ptr_len (fromIntegral sz) 613 len <- throwSocketErrorWaitRead sock "recvFrom" $ 614 c_recvfrom s ptr (fromIntegral nbytes) 0{-flags-} 615 ptr_addr ptr_len 616 let len' = fromIntegral len 617 if len' == 0 618 then ioError (mkEOFError "Network.Socket.recvFrom") 619 else do 620 flg <- isConnected sock 621 -- For at least one implementation (WinSock 2), recvfrom() ignores 622 -- filling in the sockaddr for connected TCP sockets. Cope with 623 -- this by using getPeerName instead. 624 sockaddr <- 625 if flg then 626 getPeerName sock 627 else 628 peekSockAddr ptr_addr 629 return (len', sockaddr) 630 631----------------------------------------------------------------------------- 632-- send & recv 633 634-- | Send data to the socket. The socket must be connected to a remote 635-- socket. Returns the number of bytes sent. Applications are 636-- responsible for ensuring that all data has been sent. 637send :: Socket -- Bound/Connected Socket 638 -> String -- Data to send 639 -> IO Int -- Number of Bytes sent 640send sock@(MkSocket s _family _stype _protocol _status) xs = do 641 let len = length xs 642 withCString xs $ \str -> do 643 liftM fromIntegral $ 644#if defined(mingw32_HOST_OS) 645# if __GLASGOW_HASKELL__ >= 611 646 writeRawBufferPtr 647 "Network.Socket.send" 648 (socket2FD sock) 649 (castPtr str) 650 0 651 (fromIntegral len) 652#else 653 writeRawBufferPtr 654 "Network.Socket.send" 655 (fromIntegral s) 656 True 657 str 658 0 659 (fromIntegral len) 660#endif 661 662#else 663 throwSocketErrorWaitWrite sock "send" $ 664 c_send s str (fromIntegral len) 0{-flags-} 665#endif 666 667-- | Send data to the socket. The socket must be connected to a remote 668-- socket. Returns the number of bytes sent. Applications are 669-- responsible for ensuring that all data has been sent. 670sendBuf :: Socket -- Bound/Connected Socket 671 -> Ptr Word8 -- Pointer to the data to send 672 -> Int -- Length of the buffer 673 -> IO Int -- Number of Bytes sent 674sendBuf sock@(MkSocket s _family _stype _protocol _status) str len = do 675 liftM fromIntegral $ 676#if defined(mingw32_HOST_OS) 677# if __GLASGOW_HASKELL__ >= 611 678 writeRawBufferPtr 679 "Network.Socket.sendBuf" 680 (socket2FD sock) 681 (castPtr str) 682 0 683 (fromIntegral len) 684# else 685 writeRawBufferPtr 686 "Network.Socket.sendBuf" 687 (fromIntegral s) 688 True 689 str 690 0 691 (fromIntegral len) 692# endif 693#else 694 throwSocketErrorWaitWrite sock "sendBuf" $ 695 c_send s str (fromIntegral len) 0{-flags-} 696#endif 697 698 699-- | Receive data from the socket. The socket must be in a connected 700-- state. This function may return fewer bytes than specified. If the 701-- message is longer than the specified length, it may be discarded 702-- depending on the type of socket. This function may block until a 703-- message arrives. 704-- 705-- Considering hardware and network realities, the maximum number of 706-- bytes to receive should be a small power of 2, e.g., 4096. 707-- 708-- For TCP sockets, a zero length return value means the peer has 709-- closed its half side of the connection. 710recv :: Socket -> Int -> IO String 711recv sock l = recvLen sock l >>= \ (s,_) -> return s 712 713recvLen :: Socket -> Int -> IO (String, Int) 714recvLen sock@(MkSocket s _family _stype _protocol _status) nbytes 715 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recv") 716 | otherwise = do 717 allocaBytes nbytes $ \ptr -> do 718 len <- 719#if defined(mingw32_HOST_OS) 720# if __GLASGOW_HASKELL__ >= 611 721 readRawBufferPtr "Network.Socket.recvLen" (socket2FD sock) ptr 0 722 (fromIntegral nbytes) 723#else 724 readRawBufferPtr "Network.Socket.recvLen" (fromIntegral s) True ptr 0 725 (fromIntegral nbytes) 726#endif 727#else 728 throwSocketErrorWaitRead sock "recv" $ 729 c_recv s ptr (fromIntegral nbytes) 0{-flags-} 730#endif 731 let len' = fromIntegral len 732 if len' == 0 733 then ioError (mkEOFError "Network.Socket.recv") 734 else do 735 s' <- peekCStringLen (castPtr ptr,len') 736 return (s', len') 737 738-- | Receive data from the socket. The socket must be in a connected 739-- state. This function may return fewer bytes than specified. If the 740-- message is longer than the specified length, it may be discarded 741-- depending on the type of socket. This function may block until a 742-- message arrives. 743-- 744-- Considering hardware and network realities, the maximum number of 745-- bytes to receive should be a small power of 2, e.g., 4096. 746-- 747-- For TCP sockets, a zero length return value means the peer has 748-- closed its half side of the connection. 749recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int 750recvBuf sock p l = recvLenBuf sock p l 751 752recvLenBuf :: Socket -> Ptr Word8 -> Int -> IO Int 753recvLenBuf sock@(MkSocket s _family _stype _protocol _status) ptr nbytes 754 | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf") 755 | otherwise = do 756 len <- 757#if defined(mingw32_HOST_OS) 758# if __GLASGOW_HASKELL__ >= 611 759 readRawBufferPtr "Network.Socket.recvLenBuf" (socket2FD sock) ptr 0 760 (fromIntegral nbytes) 761#else 762 readRawBufferPtr "Network.Socket.recvLenBuf" (fromIntegral s) True ptr 0 763 (fromIntegral nbytes) 764#endif 765#else 766 throwSocketErrorWaitRead sock "recvBuf" $ 767 c_recv s (castPtr ptr) (fromIntegral nbytes) 0{-flags-} 768#endif 769 let len' = fromIntegral len 770 if len' == 0 771 then ioError (mkEOFError "Network.Socket.recvBuf") 772 else return len' 773 774 775-- --------------------------------------------------------------------------- 776-- socketPort 777-- 778-- The port number the given socket is currently connected to can be 779-- determined by calling $port$, is generally only useful when bind 780-- was given $aNY\_PORT$. 781 782socketPort :: Socket -- Connected & Bound Socket 783 -> IO PortNumber -- Port Number of Socket 784socketPort sock@(MkSocket _ AF_INET _ _ _) = do 785 (SockAddrInet port _) <- getSocketName sock 786 return port 787#if defined(IPV6_SOCKET_SUPPORT) 788socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do 789 (SockAddrInet6 port _ _ _) <- getSocketName sock 790 return port 791#endif 792socketPort (MkSocket _ family _ _ _) = 793 ioError (userError ("socketPort: not supported for Family " ++ show family)) 794 795 796-- --------------------------------------------------------------------------- 797-- getPeerName 798 799-- Calling $getPeerName$ returns the address details of the machine, 800-- other than the local one, which is connected to the socket. This is 801-- used in programs such as FTP to determine where to send the 802-- returning data. The corresponding call to get the details of the 803-- local machine is $getSocketName$. 804 805getPeerName :: Socket -> IO SockAddr 806getPeerName (MkSocket s family _ _ _) = do 807 withNewSockAddr family $ \ptr sz -> do 808 with (fromIntegral sz) $ \int_star -> do 809 throwSocketErrorIfMinus1Retry "getPeerName" $ c_getpeername s ptr int_star 810 _sz <- peek int_star 811 peekSockAddr ptr 812 813getSocketName :: Socket -> IO SockAddr 814getSocketName (MkSocket s family _ _ _) = do 815 withNewSockAddr family $ \ptr sz -> do 816 with (fromIntegral sz) $ \int_star -> do 817 throwSocketErrorIfMinus1Retry "getSocketName" $ c_getsockname s ptr int_star 818 peekSockAddr ptr 819 820----------------------------------------------------------------------------- 821-- Socket Properties 822 823-- | Socket options for use with 'setSocketOption' and 'getSocketOption'. 824-- 825-- The existence of a constructor does not imply that the relevant option 826-- is supported on your system: see 'isSupportedSocketOption' 827data SocketOption 828 = Debug -- ^ SO_DEBUG 829 | ReuseAddr -- ^ SO_REUSEADDR 830 | Type -- ^ SO_TYPE 831 | SoError -- ^ SO_ERROR 832 | DontRoute -- ^ SO_DONTROUTE 833 | Broadcast -- ^ SO_BROADCAST 834 | SendBuffer -- ^ SO_SNDBUF 835 | RecvBuffer -- ^ SO_RCVBUF 836 | KeepAlive -- ^ SO_KEEPALIVE 837 | OOBInline -- ^ SO_OOBINLINE 838 | TimeToLive -- ^ IP_TTL 839 | MaxSegment -- ^ TCP_MAXSEG 840 | NoDelay -- ^ TCP_NODELAY 841 | Cork -- ^ TCP_CORK 842 | Linger -- ^ SO_LINGER 843 | ReusePort -- ^ SO_REUSEPORT 844 | RecvLowWater -- ^ SO_RCVLOWAT 845 | SendLowWater -- ^ SO_SNDLOWAT 846 | RecvTimeOut -- ^ SO_RCVTIMEO 847 | SendTimeOut -- ^ SO_SNDTIMEO 848 | UseLoopBack -- ^ SO_USELOOPBACK 849 | IPv6Only -- ^ IPV6_V6ONLY 850 deriving (Show, Typeable) 851 852-- | Does the 'SocketOption' exist on this system? 853isSupportedSocketOption :: SocketOption -> Bool 854isSupportedSocketOption = isJust . packSocketOption 855 856-- | For a socket option, return Just (level, value) where level is the 857-- corresponding C option level constant (e.g. SOL_SOCKET) and value is 858-- the option constant itself (e.g. SO_DEBUG) 859-- If either constant does not exist, return Nothing. 860packSocketOption :: SocketOption -> Maybe (CInt, CInt) 861packSocketOption so = 862 -- The Just here is a hack to disable GHC's overlapping pattern detection: 863 -- the problem is if all constants are present, the fallback pattern is 864 -- redundant, but if they aren't then it isn't. Hence we introduce an 865 -- extra pattern (Nothing) that can't possibly happen, so that the 866 -- fallback is always (in principle) necessary. 867 -- I feel a little bad for including this, but such are the sacrifices we 868 -- make while working with CPP - excluding the fallback pattern correctly 869 -- would be a serious nuisance. 870 -- (NB: comments elsewhere in this file refer to this one) 871 case Just so of 872#ifdef SOL_SOCKET 873#ifdef SO_DEBUG 874 Just Debug -> Just ((#const SOL_SOCKET), (#const SO_DEBUG)) 875#endif 876#ifdef SO_REUSEADDR 877 Just ReuseAddr -> Just ((#const SOL_SOCKET), (#const SO_REUSEADDR)) 878#endif 879#ifdef SO_TYPE 880 Just Type -> Just ((#const SOL_SOCKET), (#const SO_TYPE)) 881#endif 882#ifdef SO_ERROR 883 Just SoError -> Just ((#const SOL_SOCKET), (#const SO_ERROR)) 884#endif 885#ifdef SO_DONTROUTE 886 Just DontRoute -> Just ((#const SOL_SOCKET), (#const SO_DONTROUTE)) 887#endif 888#ifdef SO_BROADCAST 889 Just Broadcast -> Just ((#const SOL_SOCKET), (#const SO_BROADCAST)) 890#endif 891#ifdef SO_SNDBUF 892 Just SendBuffer -> Just ((#const SOL_SOCKET), (#const SO_SNDBUF)) 893#endif 894#ifdef SO_RCVBUF 895 Just RecvBuffer -> Just ((#const SOL_SOCKET), (#const SO_RCVBUF)) 896#endif 897#ifdef SO_KEEPALIVE 898 Just KeepAlive -> Just ((#const SOL_SOCKET), (#const SO_KEEPALIVE)) 899#endif 900#ifdef SO_OOBINLINE 901 Just OOBInline -> Just ((#const SOL_SOCKET), (#const SO_OOBINLINE)) 902#endif 903#ifdef SO_LINGER 904 Just Linger -> Just ((#const SOL_SOCKET), (#const SO_LINGER)) 905#endif 906#ifdef SO_REUSEPORT 907 Just ReusePort -> Just ((#const SOL_SOCKET), (#const SO_REUSEPORT)) 908#endif 909#ifdef SO_RCVLOWAT 910 Just RecvLowWater -> Just ((#const SOL_SOCKET), (#const SO_RCVLOWAT)) 911#endif 912#ifdef SO_SNDLOWAT 913 Just SendLowWater -> Just ((#const SOL_SOCKET), (#const SO_SNDLOWAT)) 914#endif 915#ifdef SO_RCVTIMEO 916 Just RecvTimeOut -> Just ((#const SOL_SOCKET), (#const SO_RCVTIMEO)) 917#endif 918#ifdef SO_SNDTIMEO 919 Just SendTimeOut -> Just ((#const SOL_SOCKET), (#const SO_SNDTIMEO)) 920#endif 921#ifdef SO_USELOOPBACK 922 Just UseLoopBack -> Just ((#const SOL_SOCKET), (#const SO_USELOOPBACK)) 923#endif 924#endif // SOL_SOCKET 925#ifdef IPPROTO_IP 926#ifdef IP_TTL 927 Just TimeToLive -> Just ((#const IPPROTO_IP), (#const IP_TTL)) 928#endif 929#endif // IPPROTO_IP 930#ifdef IPPROTO_TCP 931#ifdef TCP_MAXSEG 932 Just MaxSegment -> Just ((#const IPPROTO_TCP), (#const TCP_MAXSEG)) 933#endif 934#ifdef TCP_NODELAY 935 Just NoDelay -> Just ((#const IPPROTO_TCP), (#const TCP_NODELAY)) 936#endif 937#ifdef TCP_CORK 938 Just Cork -> Just ((#const IPPROTO_TCP), (#const TCP_CORK)) 939#endif 940#endif // IPPROTO_TCP 941#ifdef IPPROTO_IPV6 942#if HAVE_DECL_IPV6_V6ONLY 943 Just IPv6Only -> Just ((#const IPPROTO_IPV6), (#const IPV6_V6ONLY)) 944#endif 945#endif // IPPROTO_IPV6 946 _ -> Nothing 947 948-- | Return the option level and option value if they exist, 949-- otherwise throw an error that begins "Network.Socket." ++ the String 950-- parameter 951packSocketOption' :: String -> SocketOption -> IO (CInt, CInt) 952packSocketOption' caller so = maybe err return (packSocketOption so) 953 where 954 err = ioError . userError . concat $ ["Network.Socket.", caller, 955 ": socket option ", show so, " unsupported on this system"] 956 957-- | Set a socket option that expects an Int value. 958-- There is currently no API to set e.g. the timeval socket options 959setSocketOption :: Socket 960 -> SocketOption -- Option Name 961 -> Int -- Option Value 962 -> IO () 963setSocketOption (MkSocket s _ _ _ _) so v = do 964 (level, opt) <- packSocketOption' "setSocketOption" so 965 with (fromIntegral v) $ \ptr_v -> do 966 throwSocketErrorIfMinus1_ "setSocketOption" $ 967 c_setsockopt s level opt ptr_v 968 (fromIntegral (sizeOf (undefined :: CInt))) 969 return () 970 971 972-- | Get a socket option that gives an Int value. 973-- There is currently no API to get e.g. the timeval socket options 974getSocketOption :: Socket 975 -> SocketOption -- Option Name 976 -> IO Int -- Option Value 977getSocketOption (MkSocket s _ _ _ _) so = do 978 (level, opt) <- packSocketOption' "getSocketOption" so 979 alloca $ \ptr_v -> 980 with (fromIntegral (sizeOf (undefined :: CInt))) $ \ptr_sz -> do 981 throwSocketErrorIfMinus1Retry "getSocketOption" $ 982 c_getsockopt s level opt ptr_v ptr_sz 983 fromIntegral `liftM` peek ptr_v 984 985 986#ifdef HAVE_STRUCT_UCRED 987-- | Returns the processID, userID and groupID of the socket's peer. 988-- 989-- Only available on platforms that support SO_PEERCRED on domain sockets. 990getPeerCred :: Socket -> IO (CUInt, CUInt, CUInt) 991getPeerCred sock = do 992 let fd = fdSocket sock 993 let sz = (fromIntegral (#const sizeof(struct ucred))) 994 with sz $ \ ptr_cr -> 995 alloca $ \ ptr_sz -> do 996 poke ptr_sz sz 997 throwSocketErrorIfMinus1Retry "getPeerCred" $ 998 c_getsockopt fd (#const SOL_SOCKET) (#const SO_PEERCRED) ptr_cr ptr_sz 999 pid <- (#peek struct ucred, pid) ptr_cr 1000 uid <- (#peek struct ucred, uid) ptr_cr 1001 gid <- (#peek struct ucred, gid) ptr_cr 1002 return (pid, uid, gid) 1003#endif 1004 1005##if !(MIN_VERSION_base(4,3,1)) 1006closeFdWith closer fd = closer fd 1007##endif 1008 1009#if defined(DOMAIN_SOCKET_SUPPORT) 1010-- sending/receiving ancillary socket data; low-level mechanism 1011-- for transmitting file descriptors, mainly. 1012sendFd :: Socket -> CInt -> IO () 1013sendFd sock outfd = do 1014 throwSocketErrorWaitWrite sock "sendFd" $ 1015 c_sendFd (fdSocket sock) outfd 1016 -- Note: If Winsock supported FD-passing, thi would have been 1017 -- incorrect (since socket FDs need to be closed via closesocket().) 1018 closeFd outfd 1019 1020recvFd :: Socket -> IO CInt 1021recvFd sock = do 1022 theFd <- throwSocketErrorWaitRead sock "recvFd" $ 1023 c_recvFd (fdSocket sock) 1024 return theFd 1025 1026foreign import ccall SAFE_ON_WIN "sendFd" c_sendFd :: CInt -> CInt -> IO CInt 1027foreign import ccall SAFE_ON_WIN "recvFd" c_recvFd :: CInt -> IO CInt 1028 1029#endif 1030 1031-- --------------------------------------------------------------------------- 1032-- Utility Functions 1033 1034aNY_PORT :: PortNumber 1035aNY_PORT = 0 1036 1037-- | The IPv4 wild card address. 1038 1039iNADDR_ANY :: HostAddress 1040iNADDR_ANY = htonl (#const INADDR_ANY) 1041 1042foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32 1043 1044#if defined(IPV6_SOCKET_SUPPORT) 1045-- | The IPv6 wild card address. 1046 1047iN6ADDR_ANY :: HostAddress6 1048iN6ADDR_ANY = (0, 0, 0, 0) 1049#endif 1050 1051sOMAXCONN :: Int 1052sOMAXCONN = #const SOMAXCONN 1053 1054sOL_SOCKET :: Int 1055sOL_SOCKET = #const SOL_SOCKET 1056 1057#ifdef SCM_RIGHTS 1058sCM_RIGHTS :: Int 1059sCM_RIGHTS = #const SCM_RIGHTS 1060#endif 1061 1062-- | This is the value of SOMAXCONN, typically 128. 1063-- 128 is good enough for normal network servers but 1064-- is too small for high performance servers. 1065maxListenQueue :: Int 1066maxListenQueue = sOMAXCONN 1067 1068-- ----------------------------------------------------------------------------- 1069 1070data ShutdownCmd 1071 = ShutdownReceive 1072 | ShutdownSend 1073 | ShutdownBoth 1074 deriving Typeable 1075 1076sdownCmdToInt :: ShutdownCmd -> CInt 1077sdownCmdToInt ShutdownReceive = 0 1078sdownCmdToInt ShutdownSend = 1 1079sdownCmdToInt ShutdownBoth = 2 1080 1081-- | Shut down one or both halves of the connection, depending on the 1082-- second argument to the function. If the second argument is 1083-- 'ShutdownReceive', further receives are disallowed. If it is 1084-- 'ShutdownSend', further sends are disallowed. If it is 1085-- 'ShutdownBoth', further sends and receives are disallowed. 1086shutdown :: Socket -> ShutdownCmd -> IO () 1087shutdown (MkSocket s _ _ _ _) stype = do 1088 throwSocketErrorIfMinus1Retry "shutdown" (c_shutdown s (sdownCmdToInt stype)) 1089 return () 1090 1091-- ----------------------------------------------------------------------------- 1092 1093-- | Close the socket. All future operations on the socket object 1094-- will fail. The remote end will receive no more data (after queued 1095-- data is flushed). 1096close :: Socket -> IO () 1097close (MkSocket s _ _ _ socketStatus) = do 1098 modifyMVar_ socketStatus $ \ status -> 1099 case status of 1100 ConvertedToHandle -> 1101 ioError (userError ("close: converted to a Handle, use hClose instead")) 1102 Closed -> 1103 return status 1104 _ -> closeFdWith (closeFd . fromIntegral) (fromIntegral s) >> return Closed 1105 1106-- ----------------------------------------------------------------------------- 1107 1108isConnected :: Socket -> IO Bool 1109isConnected (MkSocket _ _ _ _ status) = do 1110 value <- readMVar status 1111 return (value == Connected) 1112 1113-- ----------------------------------------------------------------------------- 1114-- Socket Predicates 1115 1116isBound :: Socket -> IO Bool 1117isBound (MkSocket _ _ _ _ status) = do 1118 value <- readMVar status 1119 return (value == Bound) 1120 1121isListening :: Socket -> IO Bool 1122isListening (MkSocket _ _ _ _ status) = do 1123 value <- readMVar status 1124 return (value == Listening) 1125 1126isReadable :: Socket -> IO Bool 1127isReadable (MkSocket _ _ _ _ status) = do 1128 value <- readMVar status 1129 return (value == Listening || value == Connected) 1130 1131isWritable :: Socket -> IO Bool 1132isWritable = isReadable -- sort of. 1133 1134isAcceptable :: Socket -> IO Bool 1135#if defined(DOMAIN_SOCKET_SUPPORT) 1136isAcceptable (MkSocket _ AF_UNIX x _ status) 1137 | x == Stream || x == SeqPacket = do 1138 value <- readMVar status 1139 return (value == Connected || value == Bound || value == Listening) 1140isAcceptable (MkSocket _ AF_UNIX _ _ _) = return False 1141#endif 1142isAcceptable (MkSocket _ _ _ _ status) = do 1143 value <- readMVar status 1144 return (value == Connected || value == Listening) 1145 1146-- ----------------------------------------------------------------------------- 1147-- Internet address manipulation routines: 1148 1149inet_addr :: String -> IO HostAddress 1150inet_addr ipstr = do 1151 withCString ipstr $ \str -> do 1152 had <- c_inet_addr str 1153 if had == -1 1154 then ioError (userError ("inet_addr: Malformed address: " ++ ipstr)) 1155 else return had -- network byte order 1156 1157inet_ntoa :: HostAddress -> IO String 1158inet_ntoa haddr = do 1159 pstr <- c_inet_ntoa haddr 1160 peekCString pstr 1161 1162-- | Turns a Socket into an 'Handle'. By default, the new handle is 1163-- unbuffered. Use 'System.IO.hSetBuffering' to change the buffering. 1164-- 1165-- Note that since a 'Handle' is automatically closed by a finalizer 1166-- when it is no longer referenced, you should avoid doing any more 1167-- operations on the 'Socket' after calling 'socketToHandle'. To 1168-- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose' 1169-- on the 'Handle'. 1170 1171#ifndef __PARALLEL_HASKELL__ 1172socketToHandle :: Socket -> IOMode -> IO Handle 1173socketToHandle s@(MkSocket fd _ _ _ socketStatus) mode = do 1174 modifyMVar socketStatus $ \ status -> 1175 if status == ConvertedToHandle 1176 then ioError (userError ("socketToHandle: already a Handle")) 1177 else do 1178# if __GLASGOW_HASKELL__ >= 611 1179 h <- fdToHandle' (fromIntegral fd) (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-} 1180# elif __GLASGOW_HASKELL__ >= 608 1181 h <- fdToHandle' (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-} 1182# elif __GLASGOW_HASKELL__ < 608 1183 h <- openFd (fromIntegral fd) (Just System.Posix.Internals.Stream) True (show s) mode True{-bin-} 1184# endif 1185 hSetBuffering h NoBuffering 1186 return (ConvertedToHandle, h) 1187#else 1188socketToHandle (MkSocket s family stype protocol status) m = 1189 error "socketToHandle not implemented in a parallel setup" 1190#endif 1191 1192-- | Pack a list of values into a bitmask. The possible mappings from 1193-- value to bit-to-set are given as the first argument. We assume 1194-- that each value can cause exactly one bit to be set; unpackBits will 1195-- break if this property is not true. 1196 1197packBits :: (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b 1198 1199packBits mapping xs = foldl' pack 0 mapping 1200 where pack acc (k, v) | k `elem` xs = acc .|. v 1201 | otherwise = acc 1202 1203-- | Unpack a bitmask into a list of values. 1204 1205unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a] 1206 1207-- Be permissive and ignore unknown bit values. At least on OS X, 1208-- getaddrinfo returns an ai_flags field with bits set that have no 1209-- entry in <netdb.h>. 1210unpackBits [] _ = [] 1211unpackBits ((k,v):xs) r 1212 | r .&. v /= 0 = k : unpackBits xs (r .&. complement v) 1213 | otherwise = unpackBits xs r 1214 1215----------------------------------------------------------------------------- 1216-- Address and service lookups 1217 1218#if defined(IPV6_SOCKET_SUPPORT) 1219 1220-- | Flags that control the querying behaviour of 'getAddrInfo'. 1221data AddrInfoFlag 1222 = AI_ADDRCONFIG 1223 | AI_ALL 1224 | AI_CANONNAME 1225 | AI_NUMERICHOST 1226 | AI_NUMERICSERV 1227 | AI_PASSIVE 1228 | AI_V4MAPPED 1229 deriving (Eq, Read, Show, Typeable) 1230 1231aiFlagMapping :: [(AddrInfoFlag, CInt)] 1232 1233aiFlagMapping = 1234 [ 1235#if HAVE_DECL_AI_ADDRCONFIG 1236 (AI_ADDRCONFIG, #const AI_ADDRCONFIG), 1237#else 1238 (AI_ADDRCONFIG, 0), 1239#endif 1240#if HAVE_DECL_AI_ALL 1241 (AI_ALL, #const AI_ALL), 1242#else 1243 (AI_ALL, 0), 1244#endif 1245 (AI_CANONNAME, #const AI_CANONNAME), 1246 (AI_NUMERICHOST, #const AI_NUMERICHOST), 1247#if HAVE_DECL_AI_NUMERICSERV 1248 (AI_NUMERICSERV, #const AI_NUMERICSERV), 1249#else 1250 (AI_NUMERICSERV, 0), 1251#endif 1252 (AI_PASSIVE, #const AI_PASSIVE), 1253#if HAVE_DECL_AI_V4MAPPED 1254 (AI_V4MAPPED, #const AI_V4MAPPED) 1255#else 1256 (AI_V4MAPPED, 0) 1257#endif 1258 ] 1259 1260-- | Indicate whether the given 'AddrInfoFlag' will have any effect on 1261-- this system. 1262addrInfoFlagImplemented :: AddrInfoFlag -> Bool 1263addrInfoFlagImplemented f = packBits aiFlagMapping [f] /= 0 1264 1265data AddrInfo = 1266 AddrInfo { 1267 addrFlags :: [AddrInfoFlag], 1268 addrFamily :: Family, 1269 addrSocketType :: SocketType, 1270 addrProtocol :: ProtocolNumber, 1271 addrAddress :: SockAddr, 1272 addrCanonName :: Maybe String 1273 } 1274 deriving (Eq, Show, Typeable) 1275 1276instance Storable AddrInfo where 1277 sizeOf _ = #const sizeof(struct addrinfo) 1278 alignment _ = alignment (undefined :: CInt) 1279 1280 peek p = do 1281 ai_flags <- (#peek struct addrinfo, ai_flags) p 1282 ai_family <- (#peek struct addrinfo, ai_family) p 1283 ai_socktype <- (#peek struct addrinfo, ai_socktype) p 1284 ai_protocol <- (#peek struct addrinfo, ai_protocol) p 1285 ai_addr <- (#peek struct addrinfo, ai_addr) p >>= peekSockAddr 1286 ai_canonname_ptr <- (#peek struct addrinfo, ai_canonname) p 1287 1288 ai_canonname <- if ai_canonname_ptr == nullPtr 1289 then return Nothing 1290 else liftM Just $ peekCString ai_canonname_ptr 1291 1292 socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype 1293 return (AddrInfo 1294 { 1295 addrFlags = unpackBits aiFlagMapping ai_flags, 1296 addrFamily = unpackFamily ai_family, 1297 addrSocketType = socktype, 1298 addrProtocol = ai_protocol, 1299 addrAddress = ai_addr, 1300 addrCanonName = ai_canonname 1301 }) 1302 1303 poke p (AddrInfo flags family socketType protocol _ _) = do 1304 c_stype <- packSocketTypeOrThrow "AddrInfo.poke" socketType 1305 1306 (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags) 1307 (#poke struct addrinfo, ai_family) p (packFamily family) 1308 (#poke struct addrinfo, ai_socktype) p c_stype 1309 (#poke struct addrinfo, ai_protocol) p protocol 1310 1311 -- stuff below is probably not needed, but let's zero it for safety 1312 1313 (#poke struct addrinfo, ai_addrlen) p (0::CSize) 1314 (#poke struct addrinfo, ai_addr) p nullPtr 1315 (#poke struct addrinfo, ai_canonname) p nullPtr 1316 (#poke struct addrinfo, ai_next) p nullPtr 1317 1318data NameInfoFlag 1319 = NI_DGRAM 1320 | NI_NAMEREQD 1321 | NI_NOFQDN 1322 | NI_NUMERICHOST 1323 | NI_NUMERICSERV 1324 deriving (Eq, Read, Show, Typeable) 1325 1326niFlagMapping :: [(NameInfoFlag, CInt)] 1327 1328niFlagMapping = [(NI_DGRAM, #const NI_DGRAM), 1329 (NI_NAMEREQD, #const NI_NAMEREQD), 1330 (NI_NOFQDN, #const NI_NOFQDN), 1331 (NI_NUMERICHOST, #const NI_NUMERICHOST), 1332 (NI_NUMERICSERV, #const NI_NUMERICSERV)] 1333 1334-- | Default hints for address lookup with 'getAddrInfo'. The values 1335-- of the 'addrAddress' and 'addrCanonName' fields are 'undefined', 1336-- and are never inspected by 'getAddrInfo'. 1337 1338defaultHints :: AddrInfo 1339 1340defaultHints = AddrInfo { 1341 addrFlags = [], 1342 addrFamily = AF_UNSPEC, 1343 addrSocketType = NoSocketType, 1344 addrProtocol = defaultProtocol, 1345 addrAddress = undefined, 1346 addrCanonName = undefined 1347 } 1348 1349-- | Resolve a host or service name to one or more addresses. 1350-- The 'AddrInfo' values that this function returns contain 'SockAddr' 1351-- values that you can pass directly to 'connect' or 1352-- 'bind'. 1353-- 1354-- This function is protocol independent. It can return both IPv4 and 1355-- IPv6 address information. 1356-- 1357-- The 'AddrInfo' argument specifies the preferred query behaviour, 1358-- socket options, or protocol. You can override these conveniently 1359-- using Haskell's record update syntax on 'defaultHints', for example 1360-- as follows: 1361-- 1362-- @ 1363-- myHints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] } 1364-- @ 1365-- 1366-- Values for 'addrFlags' control query behaviour. The supported 1367-- flags are as follows: 1368-- 1369-- [@AI_PASSIVE@] If no 'HostName' value is provided, the network 1370-- address in each 'SockAddr' 1371-- will be left as a "wild card", i.e. as either 'iNADDR_ANY' 1372-- or 'iN6ADDR_ANY'. This is useful for server applications that 1373-- will accept connections from any client. 1374-- 1375-- [@AI_CANONNAME@] The 'addrCanonName' field of the first returned 1376-- 'AddrInfo' will contain the "canonical name" of the host. 1377-- 1378-- [@AI_NUMERICHOST@] The 'HostName' argument /must/ be a numeric 1379-- address in string form, and network name lookups will not be 1380-- attempted. 1381-- 1382-- /Note/: Although the following flags are required by RFC 3493, they 1383-- may not have an effect on all platforms, because the underlying 1384-- network stack may not support them. To see whether a flag from the 1385-- list below will have any effect, call 'addrInfoFlagImplemented'. 1386-- 1387-- [@AI_NUMERICSERV@] The 'ServiceName' argument /must/ be a port 1388-- number in string form, and service name lookups will not be 1389-- attempted. 1390-- 1391-- [@AI_ADDRCONFIG@] The list of returned 'AddrInfo' values will 1392-- only contain IPv4 addresses if the local system has at least 1393-- one IPv4 interface configured, and likewise for IPv6. 1394-- 1395-- [@AI_V4MAPPED@] If an IPv6 lookup is performed, and no IPv6 1396-- addresses are found, IPv6-mapped IPv4 addresses will be 1397-- returned. 1398-- 1399-- [@AI_ALL@] If 'AI_ALL' is specified, return all matching IPv6 and 1400-- IPv4 addresses. Otherwise, this flag has no effect. 1401-- 1402-- You must provide a 'Just' value for at least one of the 'HostName' 1403-- or 'ServiceName' arguments. 'HostName' can be either a numeric 1404-- network address (dotted quad for IPv4, colon-separated hex for 1405-- IPv6) or a hostname. In the latter case, its addresses will be 1406-- looked up unless 'AI_NUMERICHOST' is specified as a hint. If you 1407-- do not provide a 'HostName' value /and/ do not set 'AI_PASSIVE' as 1408-- a hint, network addresses in the result will contain the address of 1409-- the loopback interface. 1410-- 1411-- If the query fails, this function throws an IO exception instead of 1412-- returning an empty list. Otherwise, it returns a non-empty list 1413-- of 'AddrInfo' values. 1414-- 1415-- There are several reasons why a query might result in several 1416-- values. For example, the queried-for host could be multihomed, or 1417-- the service might be available via several protocols. 1418-- 1419-- Note: the order of arguments is slightly different to that defined 1420-- for @getaddrinfo@ in RFC 2553. The 'AddrInfo' parameter comes first 1421-- to make partial application easier. 1422-- 1423-- Example: 1424-- @ 1425-- let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] } 1426-- addrs <- getAddrInfo (Just hints) (Just "www.haskell.org") (Just "http") 1427-- let addr = head addrs 1428-- sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) 1429-- connect sock (addrAddress addr) 1430-- @ 1431 1432getAddrInfo :: Maybe AddrInfo -- ^ preferred socket type or protocol 1433 -> Maybe HostName -- ^ host name to look up 1434 -> Maybe ServiceName -- ^ service name to look up 1435 -> IO [AddrInfo] -- ^ resolved addresses, with "best" first 1436 1437getAddrInfo hints node service = 1438 maybeWith withCString node $ \c_node -> 1439 maybeWith withCString service $ \c_service -> 1440 maybeWith with filteredHints $ \c_hints -> 1441 alloca $ \ptr_ptr_addrs -> do 1442 ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs 1443 case ret of 1444 0 -> do ptr_addrs <- peek ptr_ptr_addrs 1445 ais <- followAddrInfo ptr_addrs 1446 c_freeaddrinfo ptr_addrs 1447 return ais 1448 _ -> do err <- gai_strerror ret 1449 ioError (ioeSetErrorString 1450 (mkIOError NoSuchThing "getAddrInfo" Nothing 1451 Nothing) err) 1452 -- Leaving out the service and using AI_NUMERICSERV causes a 1453 -- segfault on OS X 10.8.2. This code removes AI_NUMERICSERV 1454 -- (which has no effect) in that case. 1455 where 1456#if defined(darwin_HOST_OS) 1457 filteredHints = case service of 1458 Nothing -> fmap (\ h -> h { addrFlags = delete AI_NUMERICSERV (addrFlags h) }) hints 1459 _ -> hints 1460#else 1461 filteredHints = hints 1462#endif 1463 1464followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo] 1465 1466followAddrInfo ptr_ai | ptr_ai == nullPtr = return [] 1467 | otherwise = do 1468 a <- peek ptr_ai 1469 as <- (#peek struct addrinfo, ai_next) ptr_ai >>= followAddrInfo 1470 return (a:as) 1471 1472foreign import ccall safe "hsnet_getaddrinfo" 1473 c_getaddrinfo :: CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo) 1474 -> IO CInt 1475 1476foreign import ccall safe "hsnet_freeaddrinfo" 1477 c_freeaddrinfo :: Ptr AddrInfo -> IO () 1478 1479gai_strerror :: CInt -> IO String 1480 1481#ifdef HAVE_GAI_STRERROR 1482gai_strerror n = c_gai_strerror n >>= peekCString 1483 1484foreign import ccall safe "gai_strerror" 1485 c_gai_strerror :: CInt -> IO CString 1486#else 1487gai_strerror n = return ("error " ++ show n) 1488#endif 1489 1490withCStringIf :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a 1491withCStringIf False _ f = f 0 nullPtr 1492withCStringIf True n f = allocaBytes n (f (fromIntegral n)) 1493 1494-- | Resolve an address to a host or service name. 1495-- This function is protocol independent. 1496-- 1497-- The list of 'NameInfoFlag' values controls query behaviour. The 1498-- supported flags are as follows: 1499-- 1500-- [@NI_NOFQDN@] If a host is local, return only the 1501-- hostname part of the FQDN. 1502-- 1503-- [@NI_NUMERICHOST@] The name of the host is not 1504-- looked up. Instead, a numeric representation of the host's 1505-- address is returned. For an IPv4 address, this will be a 1506-- dotted-quad string. For IPv6, it will be colon-separated 1507-- hexadecimal. 1508-- 1509-- [@NI_NUMERICSERV@] The name of the service is not 1510-- looked up. Instead, a numeric representation of the 1511-- service is returned. 1512-- 1513-- [@NI_NAMEREQD@] If the hostname cannot be looked up, an IO error 1514-- is thrown. 1515-- 1516-- [@NI_DGRAM@] Resolve a datagram-based service name. This is 1517-- required only for the few protocols that have different port 1518-- numbers for their datagram-based versions than for their 1519-- stream-based versions. 1520-- 1521-- Hostname and service name lookups can be expensive. You can 1522-- specify which lookups to perform via the two 'Bool' arguments. If 1523-- one of these is 'False', the corresponding value in the returned 1524-- tuple will be 'Nothing', and no lookup will be performed. 1525-- 1526-- If a host or service's name cannot be looked up, then the numeric 1527-- form of the address or service will be returned. 1528-- 1529-- If the query fails, this function throws an IO exception. 1530-- 1531-- Example: 1532-- @ 1533-- (hostName, _) <- getNameInfo [] True False myAddress 1534-- @ 1535 1536getNameInfo :: [NameInfoFlag] -- ^ flags to control lookup behaviour 1537 -> Bool -- ^ whether to look up a hostname 1538 -> Bool -- ^ whether to look up a service name 1539 -> SockAddr -- ^ the address to look up 1540 -> IO (Maybe HostName, Maybe ServiceName) 1541 1542getNameInfo flags doHost doService addr = 1543 withCStringIf doHost (#const NI_MAXHOST) $ \c_hostlen c_host -> 1544 withCStringIf doService (#const NI_MAXSERV) $ \c_servlen c_serv -> do 1545 withSockAddr addr $ \ptr_addr sz -> do 1546 ret <- c_getnameinfo ptr_addr (fromIntegral sz) c_host c_hostlen 1547 c_serv c_servlen (packBits niFlagMapping flags) 1548 case ret of 1549 0 -> do 1550 let peekIf doIf c_val = if doIf 1551 then liftM Just $ peekCString c_val 1552 else return Nothing 1553 host <- peekIf doHost c_host 1554 serv <- peekIf doService c_serv 1555 return (host, serv) 1556 _ -> do err <- gai_strerror ret 1557 ioError (ioeSetErrorString 1558 (mkIOError NoSuchThing "getNameInfo" Nothing 1559 Nothing) err) 1560 1561foreign import ccall safe "hsnet_getnameinfo" 1562 c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString 1563 -> CSize -> CInt -> IO CInt 1564#endif 1565 1566mkInvalidRecvArgError :: String -> IOError 1567mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError 1568 InvalidArgument 1569 loc Nothing Nothing) "non-positive length" 1570 1571mkEOFError :: String -> IOError 1572mkEOFError loc = ioeSetErrorString (mkIOError EOF loc Nothing Nothing) "end of file" 1573 1574-- --------------------------------------------------------------------------- 1575-- foreign imports from the C library 1576 1577foreign import ccall unsafe "my_inet_ntoa" 1578 c_inet_ntoa :: HostAddress -> IO (Ptr CChar) 1579 1580foreign import CALLCONV unsafe "inet_addr" 1581 c_inet_addr :: Ptr CChar -> IO HostAddress 1582 1583foreign import CALLCONV unsafe "shutdown" 1584 c_shutdown :: CInt -> CInt -> IO CInt 1585 1586closeFd :: CInt -> IO () 1587closeFd fd = throwSocketErrorIfMinus1_ "Network.Socket.close" $ c_close fd 1588 1589#if !defined(WITH_WINSOCK) 1590foreign import ccall unsafe "close" 1591 c_close :: CInt -> IO CInt 1592#else 1593foreign import stdcall unsafe "closesocket" 1594 c_close :: CInt -> IO CInt 1595#endif 1596 1597foreign import CALLCONV unsafe "socket" 1598 c_socket :: CInt -> CInt -> CInt -> IO CInt 1599foreign import CALLCONV unsafe "bind" 1600 c_bind :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt 1601foreign import CALLCONV SAFE_ON_WIN "connect" 1602 c_connect :: CInt -> Ptr SockAddr -> CInt{-CSockLen???-} -> IO CInt 1603foreign import CALLCONV unsafe "accept" 1604 c_accept :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt 1605#ifdef HAVE_ACCEPT4 1606foreign import CALLCONV unsafe "accept4" 1607 c_accept4 :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> CInt -> IO CInt 1608#endif 1609foreign import CALLCONV unsafe "listen" 1610 c_listen :: CInt -> CInt -> IO CInt 1611 1612#if defined(mingw32_HOST_OS) 1613foreign import CALLCONV safe "accept" 1614 c_accept_safe :: CInt -> Ptr SockAddr -> Ptr CInt{-CSockLen???-} -> IO CInt 1615 1616foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool 1617#endif 1618 1619foreign import CALLCONV unsafe "send" 1620 c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt 1621foreign import CALLCONV SAFE_ON_WIN "sendto" 1622 c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> CInt -> IO CInt 1623foreign import CALLCONV unsafe "recv" 1624 c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt 1625foreign import CALLCONV SAFE_ON_WIN "recvfrom" 1626 c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt 1627foreign import CALLCONV unsafe "getpeername" 1628 c_getpeername :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt 1629foreign import CALLCONV unsafe "getsockname" 1630 c_getsockname :: CInt -> Ptr SockAddr -> Ptr CInt -> IO CInt 1631 1632foreign import CALLCONV unsafe "getsockopt" 1633 c_getsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt 1634foreign import CALLCONV unsafe "setsockopt" 1635 c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt 1636 1637-- --------------------------------------------------------------------------- 1638-- * Deprecated aliases 1639 1640-- $deprecated-aliases 1641-- 1642-- These aliases are deprecated and should not be used in new code. 1643-- They will be removed in some future version of the package. 1644 1645-- | Deprecated alias for 'bind'. 1646bindSocket :: Socket -- Unconnected Socket 1647 -> SockAddr -- Address to Bind to 1648 -> IO () 1649bindSocket = bind 1650 1651-- | Deprecated alias for 'close'. 1652sClose :: Socket -> IO () 1653sClose = close 1654 1655-- | Deprecated alias for 'isConnected'. 1656sIsConnected :: Socket -> IO Bool 1657sIsConnected = isConnected 1658 1659-- | Deprecated alias for 'isBound'. 1660sIsBound :: Socket -> IO Bool 1661sIsBound = isBound 1662 1663-- | Deprecated alias for 'isListening'. 1664sIsListening :: Socket -> IO Bool 1665sIsListening = isListening 1666 1667-- | Deprecated alias for 'isReadable'. 1668sIsReadable :: Socket -> IO Bool 1669sIsReadable = isReadable 1670 1671-- | Deprecated alias for 'isWritable'. 1672sIsWritable :: Socket -> IO Bool 1673sIsWritable = isWritable