1{-# LANGUAGE CPP #-} 2{-# LANGUAGE MagicHash, UnboxedTuples #-} 3{-# LANGUAGE FlexibleInstances #-} 4{-# LANGUAGE LambdaCase #-} 5{-# LANGUAGE PatternSynonyms #-} 6{-# LANGUAGE RecordWildCards #-} 7{-# LANGUAGE ScopedTypeVariables #-} 8{-# LANGUAGE StandaloneDeriving #-} 9{-# LANGUAGE GeneralizedNewtypeDeriving #-} 10 11#include "HsNet.h" 12##include "HsNetDef.h" 13 14module Network.Socket.Types ( 15 -- * Socket type 16 Socket 17 , withFdSocket 18 , unsafeFdSocket 19 , touchSocket 20 , socketToFd 21 , fdSocket 22 , mkSocket 23 , invalidateSocket 24 , close 25 , close' 26 , c_close 27 -- * Types of socket 28 , SocketType(GeneralSocketType, UnsupportedSocketType, NoSocketType 29 , Stream, Datagram, Raw, RDM, SeqPacket) 30 , isSupportedSocketType 31 , packSocketType 32 , unpackSocketType 33 34 -- * Family 35 , Family(GeneralFamily, UnsupportedFamily 36 ,AF_UNSPEC,AF_UNIX,AF_INET,AF_INET6,AF_IMPLINK,AF_PUP,AF_CHAOS 37 ,AF_NS,AF_NBS,AF_ECMA,AF_DATAKIT,AF_CCITT,AF_SNA,AF_DECnet 38 ,AF_DLI,AF_LAT,AF_HYLINK,AF_APPLETALK,AF_ROUTE,AF_NETBIOS 39 ,AF_NIT,AF_802,AF_ISO,AF_OSI,AF_NETMAN,AF_X25,AF_AX25,AF_OSINET 40 ,AF_GOSSIP,AF_IPX,Pseudo_AF_XTP,AF_CTF,AF_WAN,AF_SDL,AF_NETWARE 41 ,AF_NDD,AF_INTF,AF_COIP,AF_CNT,Pseudo_AF_RTIP,Pseudo_AF_PIP 42 ,AF_SIP,AF_ISDN,Pseudo_AF_KEY,AF_NATM,AF_ARP,Pseudo_AF_HDRCMPLT 43 ,AF_ENCAP,AF_LINK,AF_RAW,AF_RIF,AF_NETROM,AF_BRIDGE,AF_ATMPVC 44 ,AF_ROSE,AF_NETBEUI,AF_SECURITY,AF_PACKET,AF_ASH,AF_ECONET 45 ,AF_ATMSVC,AF_IRDA,AF_PPPOX,AF_WANPIPE,AF_BLUETOOTH,AF_CAN) 46 , isSupportedFamily 47 , packFamily 48 , unpackFamily 49 50 -- * Socket address typeclass 51 , SocketAddress(..) 52 , withSocketAddress 53 , withNewSocketAddress 54 55 -- * Socket address type 56 , SockAddr(..) 57 , isSupportedSockAddr 58 , HostAddress 59 , hostAddressToTuple 60 , tupleToHostAddress 61 , HostAddress6 62 , hostAddress6ToTuple 63 , tupleToHostAddress6 64 , FlowInfo 65 , ScopeID 66 , peekSockAddr 67 , pokeSockAddr 68 , withSockAddr 69 70 -- * Unsorted 71 , ProtocolNumber 72 , defaultProtocol 73 , PortNumber 74 , defaultPort 75 76 -- * Low-level helpers 77 , zeroMemory 78 , htonl 79 , ntohl 80 , In6Addr(..) 81 ) where 82 83import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef', mkWeakIORef) 84import Foreign.C.Error (throwErrno) 85import Foreign.Marshal.Alloc 86import GHC.Conc (closeFdWith) 87import System.Posix.Types (Fd) 88import Control.DeepSeq (NFData (..)) 89import GHC.Exts (touch##) 90import GHC.IORef (IORef (..)) 91import GHC.STRef (STRef (..)) 92import GHC.IO (IO (..)) 93 94import qualified Text.Read as P 95 96#if defined(DOMAIN_SOCKET_SUPPORT) 97import Foreign.Marshal.Array 98#endif 99 100import Network.Socket.Imports 101 102----- readshow module import 103import Network.Socket.ReadShow 104 105 106----------------------------------------------------------------------------- 107 108-- | Basic type for a socket. 109data Socket = Socket !(IORef CInt) !CInt {- for Show -} 110 111instance Show Socket where 112 show (Socket _ ofd) = "<socket: " ++ show ofd ++ ">" 113 114instance Eq Socket where 115 Socket ref1 _ == Socket ref2 _ = ref1 == ref2 116 117{-# DEPRECATED fdSocket "Use withFdSocket or unsafeFdSocket instead" #-} 118-- | Currently, this is an alias of `unsafeFdSocket`. 119fdSocket :: Socket -> IO CInt 120fdSocket = unsafeFdSocket 121 122-- | Getting a file descriptor from a socket. 123-- 124-- If a 'Socket' is shared with multiple threads and 125-- one uses 'unsafeFdSocket', unexpected issues may happen. 126-- Consider the following scenario: 127-- 128-- 1) Thread A acquires a 'Fd' from 'Socket' by 'unsafeFdSocket'. 129-- 130-- 2) Thread B close the 'Socket'. 131-- 132-- 3) Thread C opens a new 'Socket'. Unfortunately it gets the same 'Fd' 133-- number which thread A is holding. 134-- 135-- In this case, it is safer for Thread A to clone 'Fd' by 136-- 'System.Posix.IO.dup'. But this would still suffer from 137-- a race condition between 'unsafeFdSocket' and 'close'. 138-- 139-- If you use this function, you need to guarantee that the 'Socket' does not 140-- get garbage-collected until after you finish using the file descriptor. 141-- 'touchSocket' can be used for this purpose. 142-- 143-- A safer option is to use 'withFdSocket' instead. 144unsafeFdSocket :: Socket -> IO CInt 145unsafeFdSocket (Socket ref _) = readIORef ref 146 147-- | Ensure that the given 'Socket' stays alive (i.e. not garbage-collected) 148-- at the given place in the sequence of IO actions. This function can be 149-- used in conjunction with 'unsafeFdSocket' to guarantee that the file 150-- descriptor is not prematurely freed. 151-- 152-- > fd <- unsafeFdSocket sock 153-- > -- using fd with blocking operations such as accept(2) 154-- > touchSocket sock 155touchSocket :: Socket -> IO () 156touchSocket (Socket ref _) = touch ref 157 158touch :: IORef a -> IO () 159touch (IORef (STRef mutVar)) = 160 -- Thanks to a GHC issue, this touch# may not be quite guaranteed 161 -- to work. There's talk of replacing the touch# primop with one 162 -- that works better with the optimizer. But this seems to be the 163 -- "right" way to do it for now. 164 IO $ \s -> (## touch## mutVar s, () ##) 165 166-- | Get a file descriptor from a 'Socket'. The socket will never 167-- be closed automatically before @withFdSocket@ completes, but 168-- it may still be closed by an explicit call to 'close' or `close'`, 169-- either before or during the call. 170-- 171-- The file descriptor must not be used after @withFdSocket@ returns, because 172-- the 'Socket' may have been garbage-collected, invalidating the file 173-- descriptor. 174-- 175-- Since: 3.1.0.0 176withFdSocket :: Socket -> (CInt -> IO r) -> IO r 177withFdSocket (Socket ref _) f = do 178 fd <- readIORef ref 179 -- Should we throw an exception if the socket is already invalid? 180 -- That will catch some mistakes but certainly not all. 181 182 r <- f fd 183 184 touch ref 185 return r 186 187-- | Socket is closed and a duplicated file descriptor is returned. 188-- The duplicated descriptor is no longer subject to the possibility 189-- of unexpectedly being closed if the socket is finalized. It is 190-- now the caller's responsibility to ultimately close the 191-- duplicated file descriptor. 192socketToFd :: Socket -> IO CInt 193socketToFd s = do 194#if defined(mingw32_HOST_OS) 195 fd <- unsafeFdSocket s 196 fd2 <- c_wsaDuplicate fd 197 -- FIXME: throw error no if -1 198 close s 199 return fd2 200 201foreign import ccall unsafe "wsaDuplicate" 202 c_wsaDuplicate :: CInt -> IO CInt 203#else 204 fd <- unsafeFdSocket s 205 -- FIXME: throw error no if -1 206 fd2 <- c_dup fd 207 close s 208 return fd2 209 210foreign import ccall unsafe "dup" 211 c_dup :: CInt -> IO CInt 212#endif 213 214-- | Creating a socket from a file descriptor. 215mkSocket :: CInt -> IO Socket 216mkSocket fd = do 217 ref <- newIORef fd 218 let s = Socket ref fd 219 void $ mkWeakIORef ref $ close s 220 return s 221 222invalidSocket :: CInt 223#if defined(mingw32_HOST_OS) 224invalidSocket = #const INVALID_SOCKET 225#else 226invalidSocket = -1 227#endif 228 229invalidateSocket :: 230 Socket 231 -> (CInt -> IO a) 232 -> (CInt -> IO a) 233 -> IO a 234invalidateSocket (Socket ref _) errorAction normalAction = do 235 oldfd <- atomicModifyIORef' ref $ \cur -> (invalidSocket, cur) 236 if oldfd == invalidSocket then errorAction oldfd else normalAction oldfd 237 238----------------------------------------------------------------------------- 239 240-- | Close the socket. This function does not throw exceptions even if 241-- the underlying system call returns errors. 242-- 243-- If multiple threads use the same socket and one uses 'unsafeFdSocket' and 244-- the other use 'close', unexpected behavior may happen. 245-- For more information, please refer to the documentation of 'unsafeFdSocket'. 246close :: Socket -> IO () 247close s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do 248 -- closeFdWith avoids the deadlock of IO manager. 249 closeFdWith closeFd (toFd oldfd) 250 where 251 toFd :: CInt -> Fd 252 toFd = fromIntegral 253 -- closeFd ignores the return value of c_close and 254 -- does not throw exceptions 255 closeFd :: Fd -> IO () 256 closeFd = void . c_close . fromIntegral 257 258-- | Close the socket. This function throws exceptions if 259-- the underlying system call returns errors. 260close' :: Socket -> IO () 261close' s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do 262 -- closeFdWith avoids the deadlock of IO manager. 263 closeFdWith closeFd (toFd oldfd) 264 where 265 toFd :: CInt -> Fd 266 toFd = fromIntegral 267 closeFd :: Fd -> IO () 268 closeFd fd = do 269 ret <- c_close $ fromIntegral fd 270 when (ret == -1) $ throwErrno "Network.Socket.close'" 271 272#if defined(mingw32_HOST_OS) 273foreign import CALLCONV unsafe "closesocket" 274 c_close :: CInt -> IO CInt 275#else 276foreign import ccall unsafe "close" 277 c_close :: CInt -> IO CInt 278#endif 279 280----------------------------------------------------------------------------- 281 282-- | Protocol number. 283type ProtocolNumber = CInt 284 285-- | This is the default protocol for a given service. 286-- 287-- >>> defaultProtocol 288-- 0 289defaultProtocol :: ProtocolNumber 290defaultProtocol = 0 291 292----------------------------------------------------------------------------- 293-- Socket types 294 295-- There are a few possible ways to do this. The first is convert the 296-- structs used in the C library into an equivalent Haskell type. An 297-- other possible implementation is to keep all the internals in the C 298-- code and use an Int## and a status flag. The second method is used 299-- here since a lot of the C structures are not required to be 300-- manipulated. 301 302-- Originally the status was non-mutable so we had to return a new 303-- socket each time we changed the status. This version now uses 304-- mutable variables to avoid the need to do this. The result is a 305-- cleaner interface and better security since the application 306-- programmer now can't circumvent the status information to perform 307-- invalid operations on sockets. 308 309-- | Socket Types. 310-- 311-- Some of the defined patterns may be unsupported on some systems: 312-- see 'isSupportedSocketType'. 313newtype SocketType = SocketType { packSocketType :: CInt } 314 deriving (Eq, Ord) 315 316unpackSocketType :: CInt -> SocketType 317unpackSocketType = SocketType 318{-# INLINE unpackSocketType #-} 319 320-- | Is the @SOCK_xxxxx@ constant corresponding to the given SocketType known 321-- on this system? 'GeneralSocketType' values, not equal to any of the named 322-- patterns or 'UnsupportedSocketType', will return 'True' even when not 323-- known on this system. 324isSupportedSocketType :: SocketType -> Bool 325isSupportedSocketType = (/= UnsupportedSocketType) 326 327-- | Pattern for a general socket type. 328pattern GeneralSocketType :: CInt -> SocketType 329pattern GeneralSocketType n = SocketType n 330#if __GLASGOW_HASKELL__ >= 806 331{-# COMPLETE GeneralSocketType #-} 332#endif 333-- The actual constructor is not exported, which keeps the internal 334-- representation private, but for all purposes other than 'coerce' the 335-- above pattern is just as good. 336 337-- | Unsupported socket type, equal to any other types not supported on this 338-- system. 339pattern UnsupportedSocketType :: SocketType 340pattern UnsupportedSocketType = SocketType (-1) 341 342-- | Used in getAddrInfo hints, for example. 343pattern NoSocketType :: SocketType 344pattern NoSocketType = SocketType 0 345 346pattern Stream :: SocketType 347#ifdef SOCK_STREAM 348pattern Stream = SocketType (#const SOCK_STREAM) 349#else 350pattern Stream = (-1) 351#endif 352 353pattern Datagram :: SocketType 354#ifdef SOCK_DGRAM 355pattern Datagram = SocketType (#const SOCK_DGRAM) 356#else 357pattern Datagram = (-1) 358#endif 359 360pattern Raw :: SocketType 361#ifdef SOCK_RAW 362pattern Raw = SocketType (#const SOCK_RAW) 363#else 364pattern Raw = (-1) 365#endif 366 367pattern RDM :: SocketType 368#ifdef SOCK_RDM 369pattern RDM = SocketType (#const SOCK_RDM) 370#else 371pattern RDM = (-1) 372#endif 373 374pattern SeqPacket :: SocketType 375#ifdef SOCK_SEQPACKET 376pattern SeqPacket = SocketType (#const SOCK_SEQPACKET) 377#else 378pattern SeqPacket = (-1) 379#endif 380 381------------------------------------------------------------------------ 382-- Protocol Families. 383 384 385-- | Address families. The @AF_xxxxx@ constants are widely used as synonyms 386-- for the corresponding @PF_xxxxx@ protocol family values, to which they are 387-- numerically equal in mainstream socket API implementations. 388-- 389-- Stictly correct usage would be to pass the @PF_xxxxx@ constants as the first 390-- argument when creating a 'Socket', while the @AF_xxxxx@ constants should be 391-- used as @addrFamily@ values with 'getAddrInfo'. For now only the @AF_xxxxx@ 392-- constants are provided. 393-- 394-- Some of the defined patterns may be unsupported on some systems: 395-- see 'isSupportedFamily'. 396newtype Family = Family { packFamily :: CInt } deriving (Eq, Ord) 397 398 399-- | Does one of the AF_ constants correspond to a known address family on this 400-- system. 'GeneralFamily' values, not equal to any of the named @AF_xxxxx@ 401-- patterns or 'UnsupportedFamily', will return 'True' even when not known on 402-- this system. 403isSupportedFamily :: Family -> Bool 404isSupportedFamily f = case f of 405 UnsupportedFamily -> False 406 GeneralFamily _ -> True 407 408-- | Convert 'CInt' to 'Family'. 409unpackFamily :: CInt -> Family 410unpackFamily = Family 411{-# INLINE unpackFamily #-} 412 413-- | Pattern for a general protocol family (a.k.a. address family). 414-- 415-- @since 3.2.0.0 416pattern GeneralFamily :: CInt -> Family 417pattern GeneralFamily n = Family n 418#if __GLASGOW_HASKELL__ >= 806 419{-# COMPLETE GeneralFamily #-} 420#endif 421-- The actual constructor is not exported, which keeps the internal 422-- representation private, but for all purposes other than 'coerce' the 423-- above pattern is just as good. 424 425-- | Unsupported address family, equal to any other families that are not 426-- supported on the system. 427-- 428-- @since 3.2.0.0 429pattern UnsupportedFamily :: Family 430pattern UnsupportedFamily = Family (-1) 431 432-- | unspecified 433pattern AF_UNSPEC :: Family 434pattern AF_UNSPEC = Family (#const AF_UNSPEC) 435 436-- | UNIX-domain 437pattern AF_UNIX :: Family 438#ifdef AF_UNIX 439pattern AF_UNIX = Family (#const AF_UNIX) 440#else 441pattern AF_UNIX = Family (-1) 442#endif 443 444-- | Internet Protocol version 4 445pattern AF_INET :: Family 446#ifdef AF_INET 447pattern AF_INET = Family (#const AF_INET) 448#else 449pattern AF_INET = Family (-1) 450#endif 451 452-- | Internet Protocol version 6 453pattern AF_INET6 :: Family 454#ifdef AF_INET6 455pattern AF_INET6 = Family (#const AF_INET6) 456#else 457pattern AF_INET6 = Family (-1) 458#endif 459 460-- | Arpanet imp addresses 461pattern AF_IMPLINK :: Family 462#ifdef AF_IMPLINK 463pattern AF_IMPLINK = Family (#const AF_IMPLINK) 464#else 465pattern AF_IMPLINK = Family (-1) 466#endif 467 468-- | pup protocols: e.g. BSP 469pattern AF_PUP :: Family 470#ifdef AF_PUP 471pattern AF_PUP = Family (#const AF_PUP) 472#else 473pattern AF_PUP = Family (-1) 474#endif 475 476-- | mit CHAOS protocols 477pattern AF_CHAOS :: Family 478#ifdef AF_CHAOS 479pattern AF_CHAOS = Family (#const AF_CHAOS) 480#else 481pattern AF_CHAOS = Family (-1) 482#endif 483 484-- | XEROX NS protocols 485pattern AF_NS :: Family 486#ifdef AF_NS 487pattern AF_NS = Family (#const AF_NS) 488#else 489pattern AF_NS = Family (-1) 490#endif 491 492-- | nbs protocols 493pattern AF_NBS :: Family 494#ifdef AF_NBS 495pattern AF_NBS = Family (#const AF_NBS) 496#else 497pattern AF_NBS = Family (-1) 498#endif 499 500-- | european computer manufacturers 501pattern AF_ECMA :: Family 502#ifdef AF_ECMA 503pattern AF_ECMA = Family (#const AF_ECMA) 504#else 505pattern AF_ECMA = Family (-1) 506#endif 507 508-- | datakit protocols 509pattern AF_DATAKIT :: Family 510#ifdef AF_DATAKIT 511pattern AF_DATAKIT = Family (#const AF_DATAKIT) 512#else 513pattern AF_DATAKIT = Family (-1) 514#endif 515 516-- | CCITT protocols, X.25 etc 517pattern AF_CCITT :: Family 518#ifdef AF_CCITT 519pattern AF_CCITT = Family (#const AF_CCITT) 520#else 521pattern AF_CCITT = Family (-1) 522#endif 523 524-- | IBM SNA 525pattern AF_SNA :: Family 526#ifdef AF_SNA 527pattern AF_SNA = Family (#const AF_SNA) 528#else 529pattern AF_SNA = Family (-1) 530#endif 531 532-- | DECnet 533pattern AF_DECnet :: Family 534#ifdef AF_DECnet 535pattern AF_DECnet = Family (#const AF_DECnet) 536#else 537pattern AF_DECnet = Family (-1) 538#endif 539 540-- | Direct data link interface 541pattern AF_DLI :: Family 542#ifdef AF_DLI 543pattern AF_DLI = Family (#const AF_DLI) 544#else 545pattern AF_DLI = Family (-1) 546#endif 547 548-- | LAT 549pattern AF_LAT :: Family 550#ifdef AF_LAT 551pattern AF_LAT = Family (#const AF_LAT) 552#else 553pattern AF_LAT = Family (-1) 554#endif 555 556-- | NSC Hyperchannel 557pattern AF_HYLINK :: Family 558#ifdef AF_HYLINK 559pattern AF_HYLINK = Family (#const AF_HYLINK) 560#else 561pattern AF_HYLINK = Family (-1) 562#endif 563 564-- | Apple Talk 565pattern AF_APPLETALK :: Family 566#ifdef AF_APPLETALK 567pattern AF_APPLETALK = Family (#const AF_APPLETALK) 568#else 569pattern AF_APPLETALK = Family (-1) 570#endif 571 572-- | Internal Routing Protocol (aka AF_NETLINK) 573pattern AF_ROUTE :: Family 574#ifdef AF_ROUTE 575pattern AF_ROUTE = Family (#const AF_ROUTE) 576#else 577pattern AF_ROUTE = Family (-1) 578#endif 579 580-- | NetBios-style addresses 581pattern AF_NETBIOS :: Family 582#ifdef AF_NETBIOS 583pattern AF_NETBIOS = Family (#const AF_NETBIOS) 584#else 585pattern AF_NETBIOS = Family (-1) 586#endif 587 588-- | Network Interface Tap 589pattern AF_NIT :: Family 590#ifdef AF_NIT 591pattern AF_NIT = Family (#const AF_NIT) 592#else 593pattern AF_NIT = Family (-1) 594#endif 595 596-- | IEEE 802.2, also ISO 8802 597pattern AF_802 :: Family 598#ifdef AF_802 599pattern AF_802 = Family (#const AF_802) 600#else 601pattern AF_802 = Family (-1) 602#endif 603 604-- | ISO protocols 605pattern AF_ISO :: Family 606#ifdef AF_ISO 607pattern AF_ISO = Family (#const AF_ISO) 608#else 609pattern AF_ISO = Family (-1) 610#endif 611 612-- | umbrella of all families used by OSI 613pattern AF_OSI :: Family 614#ifdef AF_OSI 615pattern AF_OSI = Family (#const AF_OSI) 616#else 617pattern AF_OSI = Family (-1) 618#endif 619 620-- | DNA Network Management 621pattern AF_NETMAN :: Family 622#ifdef AF_NETMAN 623pattern AF_NETMAN = Family (#const AF_NETMAN) 624#else 625pattern AF_NETMAN = Family (-1) 626#endif 627 628-- | CCITT X.25 629pattern AF_X25 :: Family 630#ifdef AF_X25 631pattern AF_X25 = Family (#const AF_X25) 632#else 633pattern AF_X25 = Family (-1) 634#endif 635 636-- | AX25 637pattern AF_AX25 :: Family 638#ifdef AF_AX25 639pattern AF_AX25 = Family (#const AF_AX25) 640#else 641pattern AF_AX25 = Family (-1) 642#endif 643 644-- | AFI 645pattern AF_OSINET :: Family 646#ifdef AF_OSINET 647pattern AF_OSINET = Family (#const AF_OSINET) 648#else 649pattern AF_OSINET = Family (-1) 650#endif 651 652-- | US Government OSI 653pattern AF_GOSSIP :: Family 654#ifdef AF_GOSSIP 655pattern AF_GOSSIP = Family (#const AF_GOSSIP) 656#else 657pattern AF_GOSSIP = Family (-1) 658#endif 659 660-- | Novell Internet Protocol 661pattern AF_IPX :: Family 662#ifdef AF_IPX 663pattern AF_IPX = Family (#const AF_IPX) 664#else 665pattern AF_IPX = Family (-1) 666#endif 667 668-- | eXpress Transfer Protocol (no AF) 669pattern Pseudo_AF_XTP :: Family 670#ifdef Pseudo_AF_XTP 671pattern Pseudo_AF_XTP = Family (#const Pseudo_AF_XTP) 672#else 673pattern Pseudo_AF_XTP = Family (-1) 674#endif 675 676-- | Common Trace Facility 677pattern AF_CTF :: Family 678#ifdef AF_CTF 679pattern AF_CTF = Family (#const AF_CTF) 680#else 681pattern AF_CTF = Family (-1) 682#endif 683 684-- | Wide Area Network protocols 685pattern AF_WAN :: Family 686#ifdef AF_WAN 687pattern AF_WAN = Family (#const AF_WAN) 688#else 689pattern AF_WAN = Family (-1) 690#endif 691 692-- | SGI Data Link for DLPI 693pattern AF_SDL :: Family 694#ifdef AF_SDL 695pattern AF_SDL = Family (#const AF_SDL) 696#else 697pattern AF_SDL = Family (-1) 698#endif 699 700-- | Netware 701pattern AF_NETWARE :: Family 702#ifdef AF_NETWARE 703pattern AF_NETWARE = Family (#const AF_NETWARE) 704#else 705pattern AF_NETWARE = Family (-1) 706#endif 707 708-- | NDD 709pattern AF_NDD :: Family 710#ifdef AF_NDD 711pattern AF_NDD = Family (#const AF_NDD) 712#else 713pattern AF_NDD = Family (-1) 714#endif 715 716-- | Debugging use only 717pattern AF_INTF :: Family 718#ifdef AF_INTF 719pattern AF_INTF = Family (#const AF_INTF) 720#else 721pattern AF_INTF = Family (-1) 722#endif 723 724-- | connection-oriented IP, aka ST II 725pattern AF_COIP :: Family 726#ifdef AF_COIP 727pattern AF_COIP = Family (#const AF_COIP) 728#else 729pattern AF_COIP = Family (-1) 730#endif 731 732-- | Computer Network Technology 733pattern AF_CNT :: Family 734#ifdef AF_CNT 735pattern AF_CNT = Family (#const AF_CNT) 736#else 737pattern AF_CNT = Family (-1) 738#endif 739 740-- | Help Identify RTIP packets 741pattern Pseudo_AF_RTIP :: Family 742#ifdef Pseudo_AF_RTIP 743pattern Pseudo_AF_RTIP = Family (#const Pseudo_AF_RTIP) 744#else 745pattern Pseudo_AF_RTIP = Family (-1) 746#endif 747 748-- | Help Identify PIP packets 749pattern Pseudo_AF_PIP :: Family 750#ifdef Pseudo_AF_PIP 751pattern Pseudo_AF_PIP = Family (#const Pseudo_AF_PIP) 752#else 753pattern Pseudo_AF_PIP = Family (-1) 754#endif 755 756-- | Simple Internet Protocol 757pattern AF_SIP :: Family 758#ifdef AF_SIP 759pattern AF_SIP = Family (#const AF_SIP) 760#else 761pattern AF_SIP = Family (-1) 762#endif 763 764-- | Integrated Services Digital Network 765pattern AF_ISDN :: Family 766#ifdef AF_ISDN 767pattern AF_ISDN = Family (#const AF_ISDN) 768#else 769pattern AF_ISDN = Family (-1) 770#endif 771 772-- | Internal key-management function 773pattern Pseudo_AF_KEY :: Family 774#ifdef Pseudo_AF_KEY 775pattern Pseudo_AF_KEY = Family (#const Pseudo_AF_KEY) 776#else 777pattern Pseudo_AF_KEY = Family (-1) 778#endif 779 780-- | native ATM access 781pattern AF_NATM :: Family 782#ifdef AF_NATM 783pattern AF_NATM = Family (#const AF_NATM) 784#else 785pattern AF_NATM = Family (-1) 786#endif 787 788-- | ARP (RFC 826) 789pattern AF_ARP :: Family 790#ifdef AF_ARP 791pattern AF_ARP = Family (#const AF_ARP) 792#else 793pattern AF_ARP = Family (-1) 794#endif 795 796-- | Used by BPF to not rewrite hdrs in iface output 797pattern Pseudo_AF_HDRCMPLT :: Family 798#ifdef Pseudo_AF_HDRCMPLT 799pattern Pseudo_AF_HDRCMPLT = Family (#const Pseudo_AF_HDRCMPLT) 800#else 801pattern Pseudo_AF_HDRCMPLT = Family (-1) 802#endif 803 804-- | ENCAP 805pattern AF_ENCAP :: Family 806#ifdef AF_ENCAP 807pattern AF_ENCAP = Family (#const AF_ENCAP) 808#else 809pattern AF_ENCAP = Family (-1) 810#endif 811 812-- | Link layer interface 813pattern AF_LINK :: Family 814#ifdef AF_LINK 815pattern AF_LINK = Family (#const AF_LINK) 816#else 817pattern AF_LINK = Family (-1) 818#endif 819 820-- | Link layer interface 821pattern AF_RAW :: Family 822#ifdef AF_RAW 823pattern AF_RAW = Family (#const AF_RAW) 824#else 825pattern AF_RAW = Family (-1) 826#endif 827 828-- | raw interface 829pattern AF_RIF :: Family 830#ifdef AF_RIF 831pattern AF_RIF = Family (#const AF_RIF) 832#else 833pattern AF_RIF = Family (-1) 834#endif 835 836-- | Amateur radio NetROM 837pattern AF_NETROM :: Family 838#ifdef AF_NETROM 839pattern AF_NETROM = Family (#const AF_NETROM) 840#else 841pattern AF_NETROM = Family (-1) 842#endif 843 844-- | multiprotocol bridge 845pattern AF_BRIDGE :: Family 846#ifdef AF_BRIDGE 847pattern AF_BRIDGE = Family (#const AF_BRIDGE) 848#else 849pattern AF_BRIDGE = Family (-1) 850#endif 851 852-- | ATM PVCs 853pattern AF_ATMPVC :: Family 854#ifdef AF_ATMPVC 855pattern AF_ATMPVC = Family (#const AF_ATMPVC) 856#else 857pattern AF_ATMPVC = Family (-1) 858#endif 859 860-- | Amateur Radio X.25 PLP 861pattern AF_ROSE :: Family 862#ifdef AF_ROSE 863pattern AF_ROSE = Family (#const AF_ROSE) 864#else 865pattern AF_ROSE = Family (-1) 866#endif 867 868-- | Netbeui 802.2LLC 869pattern AF_NETBEUI :: Family 870#ifdef AF_NETBEUI 871pattern AF_NETBEUI = Family (#const AF_NETBEUI) 872#else 873pattern AF_NETBEUI = Family (-1) 874#endif 875 876-- | Security callback pseudo AF 877pattern AF_SECURITY :: Family 878#ifdef AF_SECURITY 879pattern AF_SECURITY = Family (#const AF_SECURITY) 880#else 881pattern AF_SECURITY = Family (-1) 882#endif 883 884-- | Packet family 885pattern AF_PACKET :: Family 886#ifdef AF_PACKET 887pattern AF_PACKET = Family (#const AF_PACKET) 888#else 889pattern AF_PACKET = Family (-1) 890#endif 891 892-- | Ash 893pattern AF_ASH :: Family 894#ifdef AF_ASH 895pattern AF_ASH = Family (#const AF_ASH) 896#else 897pattern AF_ASH = Family (-1) 898#endif 899 900-- | Acorn Econet 901pattern AF_ECONET :: Family 902#ifdef AF_ECONET 903pattern AF_ECONET = Family (#const AF_ECONET) 904#else 905pattern AF_ECONET = Family (-1) 906#endif 907 908-- | ATM SVCs 909pattern AF_ATMSVC :: Family 910#ifdef AF_ATMSVC 911pattern AF_ATMSVC = Family (#const AF_ATMSVC) 912#else 913pattern AF_ATMSVC = Family (-1) 914#endif 915 916-- | IRDA sockets 917pattern AF_IRDA :: Family 918#ifdef AF_IRDA 919pattern AF_IRDA = Family (#const AF_IRDA) 920#else 921pattern AF_IRDA = Family (-1) 922#endif 923 924-- | PPPoX sockets 925pattern AF_PPPOX :: Family 926#ifdef AF_PPPOX 927pattern AF_PPPOX = Family (#const AF_PPPOX) 928#else 929pattern AF_PPPOX = Family (-1) 930#endif 931 932-- | Wanpipe API sockets 933pattern AF_WANPIPE :: Family 934#ifdef AF_WANPIPE 935pattern AF_WANPIPE = Family (#const AF_WANPIPE) 936#else 937pattern AF_WANPIPE = Family (-1) 938#endif 939 940-- | bluetooth sockets 941pattern AF_BLUETOOTH :: Family 942#ifdef AF_BLUETOOTH 943pattern AF_BLUETOOTH = Family (#const AF_BLUETOOTH) 944#else 945pattern AF_BLUETOOTH = Family (-1) 946#endif 947 948-- | Controller Area Network 949pattern AF_CAN :: Family 950#ifdef AF_CAN 951pattern AF_CAN = Family (#const AF_CAN) 952#else 953pattern AF_CAN = Family (-1) 954#endif 955 956------------------------------------------------------------------------ 957-- Port Numbers 958 959-- | Port number. 960-- Use the @Num@ instance (i.e. use a literal) to create a 961-- @PortNumber@ value. 962-- 963-- >>> 1 :: PortNumber 964-- 1 965-- >>> read "1" :: PortNumber 966-- 1 967-- >>> show (12345 :: PortNumber) 968-- "12345" 969-- >>> 50000 < (51000 :: PortNumber) 970-- True 971-- >>> 50000 < (52000 :: PortNumber) 972-- True 973-- >>> 50000 + (10000 :: PortNumber) 974-- 60000 975newtype PortNumber = PortNum Word16 deriving (Eq, Ord, Num, Enum, Bounded, Real, Integral) 976 977foreign import CALLCONV unsafe "ntohs" ntohs :: Word16 -> Word16 978foreign import CALLCONV unsafe "htons" htons :: Word16 -> Word16 979-- | Converts the from host byte order to network byte order. 980foreign import CALLCONV unsafe "htonl" htonl :: Word32 -> Word32 981-- | Converts the from network byte order to host byte order. 982foreign import CALLCONV unsafe "ntohl" ntohl :: Word32 -> Word32 983{-# DEPRECATED htonl "Use getAddrInfo instead" #-} 984{-# DEPRECATED ntohl "Use getAddrInfo instead" #-} 985 986instance Storable PortNumber where 987 sizeOf _ = sizeOf (0 :: Word16) 988 alignment _ = alignment (0 :: Word16) 989 poke p (PortNum po) = poke (castPtr p) (htons po) 990 peek p = PortNum . ntohs <$> peek (castPtr p) 991 992-- | Default port number. 993-- 994-- >>> defaultPort 995-- 0 996defaultPort :: PortNumber 997defaultPort = 0 998 999------------------------------------------------------------------------ 1000 1001-- | The core typeclass to unify socket addresses. 1002class SocketAddress sa where 1003 sizeOfSocketAddress :: sa -> Int 1004 peekSocketAddress :: Ptr sa -> IO sa 1005 pokeSocketAddress :: Ptr a -> sa -> IO () 1006 1007-- sizeof(struct sockaddr_storage) which has enough space to contain 1008-- sockaddr_in, sockaddr_in6 and sockaddr_un. 1009sockaddrStorageLen :: Int 1010sockaddrStorageLen = 128 1011 1012withSocketAddress :: SocketAddress sa => sa -> (Ptr sa -> Int -> IO a) -> IO a 1013withSocketAddress addr f = do 1014 let sz = sizeOfSocketAddress addr 1015 if sz == 0 then 1016 f nullPtr 0 1017 else 1018 allocaBytes sz $ \p -> pokeSocketAddress p addr >> f (castPtr p) sz 1019 1020withNewSocketAddress :: SocketAddress sa => (Ptr sa -> Int -> IO a) -> IO a 1021withNewSocketAddress f = allocaBytes sockaddrStorageLen $ \ptr -> do 1022 zeroMemory ptr $ fromIntegral sockaddrStorageLen 1023 f ptr sockaddrStorageLen 1024 1025------------------------------------------------------------------------ 1026-- Socket addresses 1027 1028-- The scheme used for addressing sockets is somewhat quirky. The 1029-- calls in the BSD socket API that need to know the socket address 1030-- all operate in terms of struct sockaddr, a `virtual' type of 1031-- socket address. 1032 1033-- The Internet family of sockets are addressed as struct sockaddr_in, 1034-- so when calling functions that operate on struct sockaddr, we have 1035-- to type cast the Internet socket address into a struct sockaddr. 1036-- Instances of the structure for different families might *not* be 1037-- the same size. Same casting is required of other families of 1038-- sockets such as Xerox NS. Similarly for UNIX-domain sockets. 1039 1040-- To represent these socket addresses in Haskell-land, we do what BSD 1041-- didn't do, and use a union/algebraic type for the different 1042-- families. Currently only UNIX-domain sockets and the Internet 1043-- families are supported. 1044 1045-- | Flow information. 1046type FlowInfo = Word32 1047-- | Scope identifier. 1048type ScopeID = Word32 1049 1050-- | Socket addresses. 1051-- The existence of a constructor does not necessarily imply that 1052-- that socket address type is supported on your system: see 1053-- 'isSupportedSockAddr'. 1054data SockAddr 1055 = SockAddrInet 1056 !PortNumber -- sin_port 1057 !HostAddress -- sin_addr (ditto) 1058 | SockAddrInet6 1059 !PortNumber -- sin6_port 1060 !FlowInfo -- sin6_flowinfo (ditto) 1061 !HostAddress6 -- sin6_addr (ditto) 1062 !ScopeID -- sin6_scope_id (ditto) 1063 -- | The path must have fewer than 104 characters. All of these characters must have code points less than 256. 1064 | SockAddrUnix 1065 String -- sun_path 1066 deriving (Eq, Ord) 1067 1068instance NFData SockAddr where 1069 rnf (SockAddrInet _ _) = () 1070 rnf (SockAddrInet6 _ _ _ _) = () 1071 rnf (SockAddrUnix str) = rnf str 1072 1073-- | Is the socket address type supported on this system? 1074isSupportedSockAddr :: SockAddr -> Bool 1075isSupportedSockAddr addr = case addr of 1076 SockAddrInet{} -> True 1077 SockAddrInet6{} -> True 1078#if defined(DOMAIN_SOCKET_SUPPORT) 1079 SockAddrUnix{} -> True 1080#else 1081 SockAddrUnix{} -> False 1082#endif 1083 1084instance SocketAddress SockAddr where 1085 sizeOfSocketAddress = sizeOfSockAddr 1086 peekSocketAddress = peekSockAddr 1087 pokeSocketAddress = pokeSockAddr 1088 1089#if defined(mingw32_HOST_OS) 1090type CSaFamily = (#type unsigned short) 1091#elif defined(darwin_HOST_OS) 1092type CSaFamily = (#type u_char) 1093#else 1094type CSaFamily = (#type sa_family_t) 1095#endif 1096 1097-- | Computes the storage requirements (in bytes) of the given 1098-- 'SockAddr'. This function differs from 'Foreign.Storable.sizeOf' 1099-- in that the value of the argument /is/ used. 1100sizeOfSockAddr :: SockAddr -> Int 1101#if defined(DOMAIN_SOCKET_SUPPORT) 1102# ifdef linux_HOST_OS 1103-- http://man7.org/linux/man-pages/man7/unix.7.html says: 1104-- "an abstract socket address is distinguished (from a 1105-- pathname socket) by the fact that sun_path[0] is a null byte 1106-- ('\0'). The socket's address in this namespace is given by the 1107-- additional bytes in sun_path that are covered by the specified 1108-- length of the address structure. (Null bytes in the name have no 1109-- special significance.) The name has no connection with filesystem 1110-- pathnames. When the address of an abstract socket is returned, 1111-- the returned addrlen is greater than sizeof(sa_family_t) (i.e., 1112-- greater than 2), and the name of the socket is contained in the 1113-- first (addrlen - sizeof(sa_family_t)) bytes of sun_path." 1114sizeOfSockAddr (SockAddrUnix path) = 1115 case path of 1116 '\0':_ -> (#const sizeof(sa_family_t)) + length path 1117 _ -> #const sizeof(struct sockaddr_un) 1118# else 1119sizeOfSockAddr SockAddrUnix{} = #const sizeof(struct sockaddr_un) 1120# endif 1121#else 1122sizeOfSockAddr SockAddrUnix{} = error "sizeOfSockAddr: not supported" 1123#endif 1124sizeOfSockAddr SockAddrInet{} = #const sizeof(struct sockaddr_in) 1125sizeOfSockAddr SockAddrInet6{} = #const sizeof(struct sockaddr_in6) 1126 1127-- | Use a 'SockAddr' with a function requiring a pointer to a 1128-- 'SockAddr' and the length of that 'SockAddr'. 1129withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a 1130withSockAddr addr f = do 1131 let sz = sizeOfSockAddr addr 1132 allocaBytes sz $ \p -> pokeSockAddr p addr >> f (castPtr p) sz 1133 1134-- We cannot bind sun_paths longer than than the space in the sockaddr_un 1135-- structure, and attempting to do so could overflow the allocated storage 1136-- space. This constant holds the maximum allowable path length. 1137-- 1138#if defined(DOMAIN_SOCKET_SUPPORT) 1139unixPathMax :: Int 1140unixPathMax = #const sizeof(((struct sockaddr_un *)NULL)->sun_path) 1141#endif 1142 1143-- We can't write an instance of 'Storable' for 'SockAddr' because 1144-- @sockaddr@ is a sum type of variable size but 1145-- 'Foreign.Storable.sizeOf' is required to be constant. 1146 1147-- Note that on Darwin, the sockaddr structure must be zeroed before 1148-- use. 1149 1150-- | Write the given 'SockAddr' to the given memory location. 1151pokeSockAddr :: Ptr a -> SockAddr -> IO () 1152#if defined(DOMAIN_SOCKET_SUPPORT) 1153pokeSockAddr p sa@(SockAddrUnix path) = do 1154 when (length path > unixPathMax) $ error "pokeSockAddr: path is too long" 1155 zeroMemory p $ fromIntegral $ sizeOfSockAddr sa 1156# if defined(HAVE_STRUCT_SOCKADDR_SA_LEN) 1157 (#poke struct sockaddr_un, sun_len) p ((#const sizeof(struct sockaddr_un)) :: Word8) 1158# endif 1159 (#poke struct sockaddr_un, sun_family) p ((#const AF_UNIX) :: CSaFamily) 1160 let pathC = map castCharToCChar path 1161 -- the buffer is already filled with nulls. 1162 pokeArray ((#ptr struct sockaddr_un, sun_path) p) pathC 1163#else 1164pokeSockAddr _ SockAddrUnix{} = error "pokeSockAddr: not supported" 1165#endif 1166pokeSockAddr p (SockAddrInet port addr) = do 1167 zeroMemory p (#const sizeof(struct sockaddr_in)) 1168#if defined(HAVE_STRUCT_SOCKADDR_SA_LEN) 1169 (#poke struct sockaddr_in, sin_len) p ((#const sizeof(struct sockaddr_in)) :: Word8) 1170#endif 1171 (#poke struct sockaddr_in, sin_family) p ((#const AF_INET) :: CSaFamily) 1172 (#poke struct sockaddr_in, sin_port) p port 1173 (#poke struct sockaddr_in, sin_addr) p addr 1174pokeSockAddr p (SockAddrInet6 port flow addr scope) = do 1175 zeroMemory p (#const sizeof(struct sockaddr_in6)) 1176# if defined(HAVE_STRUCT_SOCKADDR_SA_LEN) 1177 (#poke struct sockaddr_in6, sin6_len) p ((#const sizeof(struct sockaddr_in6)) :: Word8) 1178# endif 1179 (#poke struct sockaddr_in6, sin6_family) p ((#const AF_INET6) :: CSaFamily) 1180 (#poke struct sockaddr_in6, sin6_port) p port 1181 (#poke struct sockaddr_in6, sin6_flowinfo) p flow 1182 (#poke struct sockaddr_in6, sin6_addr) p (In6Addr addr) 1183 (#poke struct sockaddr_in6, sin6_scope_id) p scope 1184 1185-- | Read a 'SockAddr' from the given memory location. 1186peekSockAddr :: Ptr SockAddr -> IO SockAddr 1187peekSockAddr p = do 1188 family <- (#peek struct sockaddr, sa_family) p 1189 case family :: CSaFamily of 1190#if defined(DOMAIN_SOCKET_SUPPORT) 1191 (#const AF_UNIX) -> do 1192 str <- peekCAString ((#ptr struct sockaddr_un, sun_path) p) 1193 return (SockAddrUnix str) 1194#endif 1195 (#const AF_INET) -> do 1196 addr <- (#peek struct sockaddr_in, sin_addr) p 1197 port <- (#peek struct sockaddr_in, sin_port) p 1198 return (SockAddrInet port addr) 1199 (#const AF_INET6) -> do 1200 port <- (#peek struct sockaddr_in6, sin6_port) p 1201 flow <- (#peek struct sockaddr_in6, sin6_flowinfo) p 1202 In6Addr addr <- (#peek struct sockaddr_in6, sin6_addr) p 1203 scope <- (#peek struct sockaddr_in6, sin6_scope_id) p 1204 return (SockAddrInet6 port flow addr scope) 1205 _ -> ioError $ userError $ 1206 "Network.Socket.Types.peekSockAddr: address family '" ++ 1207 show family ++ "' not supported." 1208 1209------------------------------------------------------------------------ 1210 1211-- | The raw network byte order number is read using host byte order. 1212-- Therefore on little-endian architectures the byte order is swapped. For 1213-- example @127.0.0.1@ is represented as @0x0100007f@ on little-endian hosts 1214-- and as @0x7f000001@ on big-endian hosts. 1215-- 1216-- For direct manipulation prefer 'hostAddressToTuple' and 1217-- 'tupleToHostAddress'. 1218type HostAddress = Word32 1219 1220-- | Converts 'HostAddress' to representation-independent IPv4 quadruple. 1221-- For example for @127.0.0.1@ the function will return @(0x7f, 0, 0, 1)@ 1222-- regardless of host endianness. 1223-- 1224{- -- prop> tow == hostAddressToTuple (tupleToHostAddress tow) -} 1225hostAddressToTuple :: HostAddress -> (Word8, Word8, Word8, Word8) 1226hostAddressToTuple ha' = 1227 let ha = htonl ha' 1228 byte i = fromIntegral (ha `shiftR` i) :: Word8 1229 in (byte 24, byte 16, byte 8, byte 0) 1230 1231-- | Converts IPv4 quadruple to 'HostAddress'. 1232tupleToHostAddress :: (Word8, Word8, Word8, Word8) -> HostAddress 1233tupleToHostAddress (b3, b2, b1, b0) = 1234 let x `sl` i = fromIntegral x `shiftL` i :: Word32 1235 in ntohl $ (b3 `sl` 24) .|. (b2 `sl` 16) .|. (b1 `sl` 8) .|. (b0 `sl` 0) 1236 1237-- | Independent of endianness. For example @::1@ is stored as @(0, 0, 0, 1)@. 1238-- 1239-- For direct manipulation prefer 'hostAddress6ToTuple' and 1240-- 'tupleToHostAddress6'. 1241type HostAddress6 = (Word32, Word32, Word32, Word32) 1242 1243-- | Converts 'HostAddress6' to representation-independent IPv6 octuple. 1244-- 1245{- -- prop> (w1,w2,w3,w4,w5,w6,w7,w8) == hostAddress6ToTuple (tupleToHostAddress6 (w1,w2,w3,w4,w5,w6,w7,w8)) -} 1246hostAddress6ToTuple :: HostAddress6 -> (Word16, Word16, Word16, Word16, 1247 Word16, Word16, Word16, Word16) 1248hostAddress6ToTuple (w3, w2, w1, w0) = 1249 let high, low :: Word32 -> Word16 1250 high w = fromIntegral (w `shiftR` 16) 1251 low w = fromIntegral w 1252 in (high w3, low w3, high w2, low w2, high w1, low w1, high w0, low w0) 1253 1254-- | Converts IPv6 octuple to 'HostAddress6'. 1255tupleToHostAddress6 :: (Word16, Word16, Word16, Word16, 1256 Word16, Word16, Word16, Word16) -> HostAddress6 1257tupleToHostAddress6 (w7, w6, w5, w4, w3, w2, w1, w0) = 1258 let add :: Word16 -> Word16 -> Word32 1259 high `add` low = (fromIntegral high `shiftL` 16) .|. (fromIntegral low) 1260 in (w7 `add` w6, w5 `add` w4, w3 `add` w2, w1 `add` w0) 1261 1262-- The peek32 and poke32 functions work around the fact that the RFCs 1263-- don't require 32-bit-wide address fields to be present. We can 1264-- only portably rely on an 8-bit field, s6_addr. 1265 1266s6_addr_offset :: Int 1267s6_addr_offset = (#offset struct in6_addr, s6_addr) 1268 1269peek32 :: Ptr a -> Int -> IO Word32 1270peek32 p i0 = do 1271 let i' = i0 * 4 1272 peekByte n = peekByteOff p (s6_addr_offset + i' + n) :: IO Word8 1273 a `sl` i = fromIntegral a `shiftL` i 1274 a0 <- peekByte 0 1275 a1 <- peekByte 1 1276 a2 <- peekByte 2 1277 a3 <- peekByte 3 1278 return ((a0 `sl` 24) .|. (a1 `sl` 16) .|. (a2 `sl` 8) .|. (a3 `sl` 0)) 1279 1280poke32 :: Ptr a -> Int -> Word32 -> IO () 1281poke32 p i0 a = do 1282 let i' = i0 * 4 1283 pokeByte n = pokeByteOff p (s6_addr_offset + i' + n) 1284 x `sr` i = fromIntegral (x `shiftR` i) :: Word8 1285 pokeByte 0 (a `sr` 24) 1286 pokeByte 1 (a `sr` 16) 1287 pokeByte 2 (a `sr` 8) 1288 pokeByte 3 (a `sr` 0) 1289 1290-- | Private newtype proxy for the Storable instance. To avoid orphan instances. 1291newtype In6Addr = In6Addr HostAddress6 1292 1293#if __GLASGOW_HASKELL__ < 800 1294#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) 1295#endif 1296 1297instance Storable In6Addr where 1298 sizeOf _ = #const sizeof(struct in6_addr) 1299 alignment _ = #alignment struct in6_addr 1300 1301 peek p = do 1302 a <- peek32 p 0 1303 b <- peek32 p 1 1304 c <- peek32 p 2 1305 d <- peek32 p 3 1306 return $ In6Addr (a, b, c, d) 1307 1308 poke p (In6Addr (a, b, c, d)) = do 1309 poke32 p 0 a 1310 poke32 p 1 b 1311 poke32 p 2 c 1312 poke32 p 3 d 1313 1314------------------------------------------------------------------------ 1315-- Read and Show instance for pattern-based integral newtypes 1316 1317socktypeBijection :: Bijection SocketType String 1318socktypeBijection = 1319 [ (UnsupportedSocketType, "UnsupportedSocketType") 1320 , (Stream, "Stream") 1321 , (Datagram, "Datagram") 1322 , (Raw, "Raw") 1323 , (RDM, "RDM") 1324 , (SeqPacket, "SeqPacket") 1325 , (NoSocketType, "NoSocketType") 1326 ] 1327 1328instance Show SocketType where 1329 showsPrec = bijectiveShow socktypeBijection def 1330 where 1331 gst = "GeneralSocketType" 1332 def = defShow gst packSocketType _showInt 1333 1334instance Read SocketType where 1335 readPrec = bijectiveRead socktypeBijection def 1336 where 1337 gst = "GeneralSocketType" 1338 def = defRead gst unpackSocketType _readInt 1339 1340familyBijection :: Bijection Family String 1341familyBijection = 1342 [ (UnsupportedFamily, "UnsupportedFamily") 1343 , (AF_UNSPEC, "AF_UNSPEC") 1344 , (AF_UNIX, "AF_UNIX") 1345 , (AF_INET, "AF_INET") 1346 , (AF_INET6, "AF_INET6") 1347 , (AF_IMPLINK, "AF_IMPLINK") 1348 , (AF_PUP, "AF_PUP") 1349 , (AF_CHAOS, "AF_CHAOS") 1350 , (AF_NS, "AF_NS") 1351 , (AF_NBS, "AF_NBS") 1352 , (AF_ECMA, "AF_ECMA") 1353 , (AF_DATAKIT, "AF_DATAKIT") 1354 , (AF_CCITT, "AF_CCITT") 1355 , (AF_SNA, "AF_SNA") 1356 , (AF_DECnet, "AF_DECnet") 1357 , (AF_DLI, "AF_DLI") 1358 , (AF_LAT, "AF_LAT") 1359 , (AF_HYLINK, "AF_HYLINK") 1360 , (AF_APPLETALK, "AF_APPLETALK") 1361 , (AF_ROUTE, "AF_ROUTE") 1362 , (AF_NETBIOS, "AF_NETBIOS") 1363 , (AF_NIT, "AF_NIT") 1364 , (AF_802, "AF_802") 1365 , (AF_ISO, "AF_ISO") 1366 , (AF_OSI, "AF_OSI") 1367 , (AF_NETMAN, "AF_NETMAN") 1368 , (AF_X25, "AF_X25") 1369 , (AF_AX25, "AF_AX25") 1370 , (AF_OSINET, "AF_OSINET") 1371 , (AF_GOSSIP, "AF_GOSSIP") 1372 , (AF_IPX, "AF_IPX") 1373 , (Pseudo_AF_XTP, "Pseudo_AF_XTP") 1374 , (AF_CTF, "AF_CTF") 1375 , (AF_WAN, "AF_WAN") 1376 , (AF_SDL, "AF_SDL") 1377 , (AF_NETWARE, "AF_NETWARE") 1378 , (AF_NDD, "AF_NDD") 1379 , (AF_INTF, "AF_INTF") 1380 , (AF_COIP, "AF_COIP") 1381 , (AF_CNT, "AF_CNT") 1382 , (Pseudo_AF_RTIP, "Pseudo_AF_RTIP") 1383 , (Pseudo_AF_PIP, "Pseudo_AF_PIP") 1384 , (AF_SIP, "AF_SIP") 1385 , (AF_ISDN, "AF_ISDN") 1386 , (Pseudo_AF_KEY, "Pseudo_AF_KEY") 1387 , (AF_NATM, "AF_NATM") 1388 , (AF_ARP, "AF_ARP") 1389 , (Pseudo_AF_HDRCMPLT, "Pseudo_AF_HDRCMPLT") 1390 , (AF_ENCAP, "AF_ENCAP") 1391 , (AF_LINK, "AF_LINK") 1392 , (AF_RAW, "AF_RAW") 1393 , (AF_RIF, "AF_RIF") 1394 , (AF_NETROM, "AF_NETROM") 1395 , (AF_BRIDGE, "AF_BRIDGE") 1396 , (AF_ATMPVC, "AF_ATMPVC") 1397 , (AF_ROSE, "AF_ROSE") 1398 , (AF_NETBEUI, "AF_NETBEUI") 1399 , (AF_SECURITY, "AF_SECURITY") 1400 , (AF_PACKET, "AF_PACKET") 1401 , (AF_ASH, "AF_ASH") 1402 , (AF_ECONET, "AF_ECONET") 1403 , (AF_ATMSVC, "AF_ATMSVC") 1404 , (AF_IRDA, "AF_IRDA") 1405 , (AF_PPPOX, "AF_PPPOX") 1406 , (AF_WANPIPE, "AF_WANPIPE") 1407 , (AF_BLUETOOTH, "AF_BLUETOOTH") 1408 , (AF_CAN, "AF_CAN") 1409 ] 1410 1411instance Show Family where 1412 showsPrec = bijectiveShow familyBijection def 1413 where 1414 gf = "GeneralFamily" 1415 def = defShow gf packFamily _showInt 1416 1417instance Read Family where 1418 readPrec = bijectiveRead familyBijection def 1419 where 1420 gf = "GeneralFamily" 1421 def = defRead gf unpackFamily _readInt 1422 1423-- Print "n" instead of "PortNum n". 1424instance Show PortNumber where 1425 showsPrec p (PortNum pn) = showsPrec p pn 1426 1427-- Read "n" instead of "PortNum n". 1428instance Read PortNumber where 1429 readPrec = safeInt 1430 1431------------------------------------------------------------------------ 1432-- Helper functions 1433 1434foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () 1435 1436-- | Zero a structure. 1437zeroMemory :: Ptr a -> CSize -> IO () 1438zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes) 1439