{-# OPTIONS_GHC -optc-DDOMAIN_SOCKET_SUPPORT=1 #-} {-# LINE 1 "Network/Socket/Internal.hsc" #-} {-# LANGUAGE CPP, ForeignFunctionInterface #-} {-# LINE 2 "Network/Socket/Internal.hsc" #-} ----------------------------------------------------------------------------- -- | -- Module : Network.Socket.Internal -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/network/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- A module containing semi-public 'Network.Socket' internals. -- Modules which extend the 'Network.Socket' module will need to use -- this module while ideally most users will be able to make do with -- the public interface. -- ----------------------------------------------------------------------------- {-# LINE 20 "Network/Socket/Internal.hsc" #-} {-# LINE 24 "Network/Socket/Internal.hsc" #-} {-# LINE 26 "Network/Socket/Internal.hsc" #-} {-# LINE 27 "Network/Socket/Internal.hsc" #-} {-# LINE 28 "Network/Socket/Internal.hsc" #-} {-# LINE 36 "Network/Socket/Internal.hsc" #-} module Network.Socket.Internal ( -- * Socket addresses HostAddress, {-# LINE 42 "Network/Socket/Internal.hsc" #-} HostAddress6, FlowInfo, ScopeID, {-# LINE 46 "Network/Socket/Internal.hsc" #-} PortNumber(..), SockAddr(..), peekSockAddr, pokeSockAddr, sizeOfSockAddr, sizeOfSockAddrByFamily, withSockAddr, withNewSockAddr, -- * Protocol families Family(..), -- * Socket error functions {-# LINE 63 "Network/Socket/Internal.hsc" #-} throwSocketError, -- * Guards for socket operations that may fail throwSocketErrorIfMinus1_, throwSocketErrorIfMinus1Retry, throwSocketErrorIfMinus1RetryMayBlock, -- * Initialization withSocketsDo, ) where import Data.Bits ( (.|.), shiftL, shiftR ) import Data.Word ( Word8, Word16, Word32 ) import Foreign.C.Error (throwErrno, throwErrnoIfMinus1Retry, throwErrnoIfMinus1RetryMayBlock, throwErrnoIfMinus1_) import Foreign.C.String ( castCharToCChar, peekCString ) import Foreign.C.Types ( CInt, CSize ) import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.Marshal.Array ( pokeArray, pokeArray0 ) import Foreign.Ptr ( Ptr, castPtr, plusPtr ) import Foreign.Storable ( Storable(..) ) {-# LINE 93 "Network/Socket/Internal.hsc" #-} ------------------------------------------------------------------------ type HostAddress = Word32 {-# LINE 99 "Network/Socket/Internal.hsc" #-} type HostAddress6 = (Word32, Word32, Word32, Word32) -- The peek32 and poke32 functions work around the fact that the RFCs -- don't require 32-bit-wide address fields to be present. We can -- only portably rely on an 8-bit field, s6_addr. s6_addr_offset :: Int s6_addr_offset = ((0)) {-# LINE 107 "Network/Socket/Internal.hsc" #-} peek32 :: Ptr a -> Int -> IO Word32 peek32 p i = do let i' = i * 4 peekByte n = peekByteOff p (s6_addr_offset + i' + n) :: IO Word8 a `sl` i = fromIntegral a `shiftL` i a0 <- peekByte 0 a1 <- peekByte 1 a2 <- peekByte 2 a3 <- peekByte 3 return ((a0 `sl` 24) .|. (a1 `sl` 16) .|. (a2 `sl` 8) .|. (a3 `sl` 0)) poke32 :: Ptr a -> Int -> Word32 -> IO () poke32 p i a = do let i' = i * 4 pokeByte n = pokeByteOff p (s6_addr_offset + i' + n) a `sr` i = fromIntegral (a `shiftR` i) :: Word8 pokeByte 0 (a `sr` 24) pokeByte 1 (a `sr` 16) pokeByte 2 (a `sr` 8) pokeByte 3 (a `sr` 0) instance Storable HostAddress6 where sizeOf _ = (16) {-# LINE 131 "Network/Socket/Internal.hsc" #-} alignment _ = alignment (undefined :: CInt) peek p = do a <- peek32 p 0 b <- peek32 p 1 c <- peek32 p 2 d <- peek32 p 3 return (a, b, c, d) poke p (a, b, c, d) = do poke32 p 0 a poke32 p 1 b poke32 p 2 c poke32 p 3 d {-# LINE 146 "Network/Socket/Internal.hsc" #-} ------------------------------------------------------------------------ -- Port Numbers -- -- newtyped to prevent accidental use of sane-looking -- port numbers that haven't actually been converted to -- network-byte-order first. -- newtype PortNumber = PortNum Word16 deriving ( Eq, Ord ) ------------------------------------------------------------------------ -- Socket addresses -- The scheme used for addressing sockets is somewhat quirky. The -- calls in the BSD socket API that need to know the socket address -- all operate in terms of struct sockaddr, a `virtual' type of -- socket address. -- The Internet family of sockets are addressed as struct sockaddr_in, -- so when calling functions that operate on struct sockaddr, we have -- to type cast the Internet socket address into a struct sockaddr. -- Instances of the structure for different families might *not* be -- the same size. Same casting is required of other families of -- sockets such as Xerox NS. Similarly for Unix domain sockets. -- To represent these socket addresses in Haskell-land, we do what BSD -- didn't do, and use a union/algebraic type for the different -- families. Currently only Unix domain sockets and the Internet -- families are supported. {-# LINE 178 "Network/Socket/Internal.hsc" #-} type FlowInfo = Word32 type ScopeID = Word32 {-# LINE 181 "Network/Socket/Internal.hsc" #-} data SockAddr -- C Names = SockAddrInet PortNumber -- sin_port (network byte order) HostAddress -- sin_addr (ditto) {-# LINE 187 "Network/Socket/Internal.hsc" #-} | SockAddrInet6 PortNumber -- sin6_port (network byte order) FlowInfo -- sin6_flowinfo (ditto) HostAddress6 -- sin6_addr (ditto) ScopeID -- sin6_scope_id (ditto) {-# LINE 193 "Network/Socket/Internal.hsc" #-} {-# LINE 194 "Network/Socket/Internal.hsc" #-} | SockAddrUnix String -- sun_path {-# LINE 197 "Network/Socket/Internal.hsc" #-} deriving (Eq) {-# LINE 204 "Network/Socket/Internal.hsc" #-} type CSaFamily = (Word16) {-# LINE 205 "Network/Socket/Internal.hsc" #-} {-# LINE 206 "Network/Socket/Internal.hsc" #-} -- | Computes the storage requirements (in bytes) of the given -- 'SockAddr'. This function differs from 'Foreign.Storable.sizeOf' -- in that the value of the argument /is/ used. sizeOfSockAddr :: SockAddr -> Int {-# LINE 212 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrUnix path) = case path of '\0':_ -> (2) + length path {-# LINE 215 "Network/Socket/Internal.hsc" #-} _ -> 110 {-# LINE 216 "Network/Socket/Internal.hsc" #-} {-# LINE 217 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrInet _ _) = 16 {-# LINE 218 "Network/Socket/Internal.hsc" #-} {-# LINE 219 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrInet6 _ _ _ _) = 28 {-# LINE 220 "Network/Socket/Internal.hsc" #-} {-# LINE 221 "Network/Socket/Internal.hsc" #-} -- | Computes the storage requirements (in bytes) required for a -- 'SockAddr' with the given 'Family'. sizeOfSockAddrByFamily :: Family -> Int {-# LINE 226 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_UNIX = 110 {-# LINE 227 "Network/Socket/Internal.hsc" #-} {-# LINE 228 "Network/Socket/Internal.hsc" #-} {-# LINE 229 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_INET6 = 28 {-# LINE 230 "Network/Socket/Internal.hsc" #-} {-# LINE 231 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_INET = 16 {-# LINE 232 "Network/Socket/Internal.hsc" #-} -- | Use a 'SockAddr' with a function requiring a pointer to a -- 'SockAddr' and the length of that 'SockAddr'. withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a withSockAddr addr f = do let sz = sizeOfSockAddr addr allocaBytes sz $ \p -> pokeSockAddr p addr >> f (castPtr p) sz -- | Create a new 'SockAddr' for use with a function requiring a -- pointer to a 'SockAddr' and the length of that 'SockAddr'. withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a withNewSockAddr family f = do let sz = sizeOfSockAddrByFamily family allocaBytes sz $ \ptr -> f ptr sz -- We can't write an instance of 'Storable' for 'SockAddr' because -- @sockaddr@ is a sum type of variable size but -- 'Foreign.Storable.sizeOf' is required to be constant. -- Note that on Darwin, the sockaddr structure must be zeroed before -- use. -- | Write the given 'SockAddr' to the given memory location. pokeSockAddr :: Ptr a -> SockAddr -> IO () {-# LINE 257 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrUnix path) = do {-# LINE 261 "Network/Socket/Internal.hsc" #-} {-# LINE 264 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((1) :: CSaFamily) {-# LINE 265 "Network/Socket/Internal.hsc" #-} let pathC = map castCharToCChar path poker = case path of ('\0':_) -> pokeArray; _ -> pokeArray0 0 poker (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p) pathC {-# LINE 268 "Network/Socket/Internal.hsc" #-} {-# LINE 269 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrInet (PortNum port) addr) = do {-# LINE 273 "Network/Socket/Internal.hsc" #-} {-# LINE 276 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((2) :: CSaFamily) {-# LINE 277 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port {-# LINE 278 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p addr {-# LINE 279 "Network/Socket/Internal.hsc" #-} {-# LINE 280 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrInet6 (PortNum port) flow addr scope) = do {-# LINE 284 "Network/Socket/Internal.hsc" #-} {-# LINE 287 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((10) :: CSaFamily) {-# LINE 288 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port {-# LINE 289 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p flow {-# LINE 290 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p addr {-# LINE 291 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p scope {-# LINE 292 "Network/Socket/Internal.hsc" #-} {-# LINE 293 "Network/Socket/Internal.hsc" #-} -- | Read a 'SockAddr' from the given memory location. peekSockAddr :: Ptr SockAddr -> IO SockAddr peekSockAddr p = do family <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p {-# LINE 298 "Network/Socket/Internal.hsc" #-} case family :: CSaFamily of {-# LINE 300 "Network/Socket/Internal.hsc" #-} (1) -> do {-# LINE 301 "Network/Socket/Internal.hsc" #-} str <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p) {-# LINE 302 "Network/Socket/Internal.hsc" #-} return (SockAddrUnix str) {-# LINE 304 "Network/Socket/Internal.hsc" #-} (2) -> do {-# LINE 305 "Network/Socket/Internal.hsc" #-} addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p {-# LINE 306 "Network/Socket/Internal.hsc" #-} port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p {-# LINE 307 "Network/Socket/Internal.hsc" #-} return (SockAddrInet (PortNum port) addr) {-# LINE 309 "Network/Socket/Internal.hsc" #-} (10) -> do {-# LINE 310 "Network/Socket/Internal.hsc" #-} port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p {-# LINE 311 "Network/Socket/Internal.hsc" #-} flow <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p {-# LINE 312 "Network/Socket/Internal.hsc" #-} addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p {-# LINE 313 "Network/Socket/Internal.hsc" #-} scope <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p {-# LINE 314 "Network/Socket/Internal.hsc" #-} return (SockAddrInet6 (PortNum port) flow addr scope) {-# LINE 316 "Network/Socket/Internal.hsc" #-} ------------------------------------------------------------------------ -- Protocol Families. -- | This data type might have different constructors depending on -- what is supported by the operating system. data Family = AF_UNSPEC -- unspecified {-# LINE 325 "Network/Socket/Internal.hsc" #-} | AF_UNIX -- local to host (pipes, portals {-# LINE 327 "Network/Socket/Internal.hsc" #-} {-# LINE 328 "Network/Socket/Internal.hsc" #-} | AF_INET -- internetwork: UDP, TCP, etc {-# LINE 330 "Network/Socket/Internal.hsc" #-} {-# LINE 331 "Network/Socket/Internal.hsc" #-} | AF_INET6 -- Internet Protocol version 6 {-# LINE 333 "Network/Socket/Internal.hsc" #-} {-# LINE 336 "Network/Socket/Internal.hsc" #-} {-# LINE 339 "Network/Socket/Internal.hsc" #-} {-# LINE 342 "Network/Socket/Internal.hsc" #-} {-# LINE 345 "Network/Socket/Internal.hsc" #-} {-# LINE 348 "Network/Socket/Internal.hsc" #-} {-# LINE 351 "Network/Socket/Internal.hsc" #-} {-# LINE 354 "Network/Socket/Internal.hsc" #-} {-# LINE 357 "Network/Socket/Internal.hsc" #-} {-# LINE 358 "Network/Socket/Internal.hsc" #-} | AF_SNA -- IBM SNA {-# LINE 360 "Network/Socket/Internal.hsc" #-} {-# LINE 361 "Network/Socket/Internal.hsc" #-} | AF_DECnet -- DECnet {-# LINE 363 "Network/Socket/Internal.hsc" #-} {-# LINE 366 "Network/Socket/Internal.hsc" #-} {-# LINE 369 "Network/Socket/Internal.hsc" #-} {-# LINE 372 "Network/Socket/Internal.hsc" #-} {-# LINE 373 "Network/Socket/Internal.hsc" #-} | AF_APPLETALK -- Apple Talk {-# LINE 375 "Network/Socket/Internal.hsc" #-} {-# LINE 376 "Network/Socket/Internal.hsc" #-} | AF_ROUTE -- Internal Routing Protocol {-# LINE 378 "Network/Socket/Internal.hsc" #-} {-# LINE 381 "Network/Socket/Internal.hsc" #-} {-# LINE 384 "Network/Socket/Internal.hsc" #-} {-# LINE 387 "Network/Socket/Internal.hsc" #-} {-# LINE 390 "Network/Socket/Internal.hsc" #-} {-# LINE 393 "Network/Socket/Internal.hsc" #-} {-# LINE 396 "Network/Socket/Internal.hsc" #-} {-# LINE 397 "Network/Socket/Internal.hsc" #-} | AF_X25 -- CCITT X.25 {-# LINE 399 "Network/Socket/Internal.hsc" #-} {-# LINE 400 "Network/Socket/Internal.hsc" #-} | AF_AX25 {-# LINE 402 "Network/Socket/Internal.hsc" #-} {-# LINE 405 "Network/Socket/Internal.hsc" #-} {-# LINE 408 "Network/Socket/Internal.hsc" #-} {-# LINE 409 "Network/Socket/Internal.hsc" #-} | AF_IPX -- Novell Internet Protocol {-# LINE 411 "Network/Socket/Internal.hsc" #-} {-# LINE 414 "Network/Socket/Internal.hsc" #-} {-# LINE 417 "Network/Socket/Internal.hsc" #-} {-# LINE 420 "Network/Socket/Internal.hsc" #-} {-# LINE 423 "Network/Socket/Internal.hsc" #-} {-# LINE 426 "Network/Socket/Internal.hsc" #-} {-# LINE 429 "Network/Socket/Internal.hsc" #-} {-# LINE 432 "Network/Socket/Internal.hsc" #-} {-# LINE 435 "Network/Socket/Internal.hsc" #-} {-# LINE 438 "Network/Socket/Internal.hsc" #-} {-# LINE 441 "Network/Socket/Internal.hsc" #-} {-# LINE 444 "Network/Socket/Internal.hsc" #-} {-# LINE 447 "Network/Socket/Internal.hsc" #-} {-# LINE 448 "Network/Socket/Internal.hsc" #-} | AF_ISDN -- Integrated Services Digital Network {-# LINE 450 "Network/Socket/Internal.hsc" #-} {-# LINE 453 "Network/Socket/Internal.hsc" #-} {-# LINE 456 "Network/Socket/Internal.hsc" #-} {-# LINE 459 "Network/Socket/Internal.hsc" #-} {-# LINE 462 "Network/Socket/Internal.hsc" #-} {-# LINE 465 "Network/Socket/Internal.hsc" #-} {-# LINE 468 "Network/Socket/Internal.hsc" #-} {-# LINE 471 "Network/Socket/Internal.hsc" #-} {-# LINE 474 "Network/Socket/Internal.hsc" #-} {-# LINE 475 "Network/Socket/Internal.hsc" #-} | AF_NETROM -- Amateur radio NetROM {-# LINE 477 "Network/Socket/Internal.hsc" #-} {-# LINE 478 "Network/Socket/Internal.hsc" #-} | AF_BRIDGE -- multiprotocol bridge {-# LINE 480 "Network/Socket/Internal.hsc" #-} {-# LINE 481 "Network/Socket/Internal.hsc" #-} | AF_ATMPVC -- ATM PVCs {-# LINE 483 "Network/Socket/Internal.hsc" #-} {-# LINE 484 "Network/Socket/Internal.hsc" #-} | AF_ROSE -- Amateur Radio X.25 PLP {-# LINE 486 "Network/Socket/Internal.hsc" #-} {-# LINE 487 "Network/Socket/Internal.hsc" #-} | AF_NETBEUI -- 802.2LLC {-# LINE 489 "Network/Socket/Internal.hsc" #-} {-# LINE 490 "Network/Socket/Internal.hsc" #-} | AF_SECURITY -- Security callback pseudo AF {-# LINE 492 "Network/Socket/Internal.hsc" #-} {-# LINE 493 "Network/Socket/Internal.hsc" #-} | AF_PACKET -- Packet family {-# LINE 495 "Network/Socket/Internal.hsc" #-} {-# LINE 496 "Network/Socket/Internal.hsc" #-} | AF_ASH -- Ash {-# LINE 498 "Network/Socket/Internal.hsc" #-} {-# LINE 499 "Network/Socket/Internal.hsc" #-} | AF_ECONET -- Acorn Econet {-# LINE 501 "Network/Socket/Internal.hsc" #-} {-# LINE 502 "Network/Socket/Internal.hsc" #-} | AF_ATMSVC -- ATM SVCs {-# LINE 504 "Network/Socket/Internal.hsc" #-} {-# LINE 505 "Network/Socket/Internal.hsc" #-} | AF_IRDA -- IRDA sockets {-# LINE 507 "Network/Socket/Internal.hsc" #-} {-# LINE 508 "Network/Socket/Internal.hsc" #-} | AF_PPPOX -- PPPoX sockets {-# LINE 510 "Network/Socket/Internal.hsc" #-} {-# LINE 511 "Network/Socket/Internal.hsc" #-} | AF_WANPIPE -- Wanpipe API sockets {-# LINE 513 "Network/Socket/Internal.hsc" #-} {-# LINE 514 "Network/Socket/Internal.hsc" #-} | AF_BLUETOOTH -- bluetooth sockets {-# LINE 516 "Network/Socket/Internal.hsc" #-} deriving (Eq, Ord, Read, Show) -- --------------------------------------------------------------------- -- Guards for socket operations that may fail -- | Throw an 'IOError' corresponding to the current socket error. throwSocketError :: String -- ^ textual description of the error location -> IO a -- | Throw an 'IOError' corresponding to the current socket error if -- the IO action returns a result of @-1@. Discards the result of the -- IO action after error handling. throwSocketErrorIfMinus1_ :: Num a => String -- ^ textual description of the location -> IO a -- ^ the 'IO' operation to be executed -> IO () {-# SPECIALIZE throwSocketErrorIfMinus1_ :: String -> IO CInt -> IO () #-} -- | Throw an 'IOError' corresponding to the current socket error if -- the IO action returns a result of @-1@, but retries in case of an -- interrupted operation. throwSocketErrorIfMinus1Retry :: Num a => String -- ^ textual description of the location -> IO a -- ^ the 'IO' operation to be executed -> IO a {-# SPECIALIZE throwSocketErrorIfMinus1Retry :: String -> IO CInt -> IO CInt #-} -- | Throw an 'IOError' corresponding to the current socket error if -- the IO action returns a result of @-1@, but retries in case of an -- interrupted operation. Checks for operations that would block and -- executes an alternative action before retrying in that case. throwSocketErrorIfMinus1RetryMayBlock :: Num a => String -- ^ textual description of the location -> IO b -- ^ action to execute before retrying if an -- immediate retry would block -> IO a -- ^ the 'IO' operation to be executed -> IO a {-# SPECIALIZE throwSocketErrorIfMinus1RetryMayBlock :: String -> IO b -> IO CInt -> IO CInt #-} {-# LINE 560 "Network/Socket/Internal.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock name on_block act = throwErrnoIfMinus1RetryMayBlock name act on_block throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_ throwSocketError = throwErrno {-# LINE 617 "Network/Socket/Internal.hsc" #-} -- --------------------------------------------------------------------------- -- WinSock support {-| On Windows operating systems, the networking subsystem has to be initialised using 'withSocketsDo' before any networking operations can be used. eg. > main = withSocketsDo $ do {...} Although this is only strictly necessary on Windows platforms, it is harmless on other platforms, so for portability it is good practice to use it all the time. -} withSocketsDo :: IO a -> IO a {-# LINE 633 "Network/Socket/Internal.hsc" #-} withSocketsDo x = x {-# LINE 645 "Network/Socket/Internal.hsc" #-} ------------------------------------------------------------------------ -- Helper functions foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () -- | Zero a structure. zeroMemory :: Ptr a -> CSize -> IO () zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes)