{-# LINE 1 "Network/Socket/Internal.hsc" #-} {-# LANGUAGE CPP, FlexibleInstances, ForeignFunctionInterface #-} {-# LINE 2 "Network/Socket/Internal.hsc" #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- 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 21 "Network/Socket/Internal.hsc" #-} module Network.Socket.Internal ( -- * Socket addresses HostAddress {-# LINE 27 "Network/Socket/Internal.hsc" #-} , HostAddress6 , FlowInfo , ScopeID {-# LINE 31 "Network/Socket/Internal.hsc" #-} , PortNumber(..) , SockAddr(..) , peekSockAddr , pokeSockAddr , sizeOfSockAddr , sizeOfSockAddrByFamily , withSockAddr , withNewSockAddr -- * Protocol families , Family(..) -- * Socket error functions {-# LINE 48 "Network/Socket/Internal.hsc" #-} , throwSocketError -- * Guards for socket operations that may fail , throwSocketErrorIfMinus1_ , throwSocketErrorIfMinus1Retry , throwSocketErrorIfMinus1RetryMayBlock -- * Initialization , withSocketsDo -- * Low-level helpers , zeroMemory ) where import Data.Bits ( (.|.), shiftL, shiftR ) import Data.Word ( Word8, Word16, Word32 ) import Data.Typeable (Typeable) import Foreign.C.Error (throwErrno, throwErrnoIfMinus1Retry, throwErrnoIfMinus1RetryMayBlock, throwErrnoIfMinus1_) import Foreign.C.String ( castCharToCChar, peekCString ) {-# LINE 69 "Network/Socket/Internal.hsc" #-} import Foreign.C.Types ( CInt(..), CSize(..) ) {-# LINE 73 "Network/Socket/Internal.hsc" #-} import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.Marshal.Array ( pokeArray, pokeArray0 ) import Foreign.Ptr ( Ptr, castPtr, plusPtr ) import Foreign.Storable ( Storable(..) ) {-# LINE 86 "Network/Socket/Internal.hsc" #-} ------------------------------------------------------------------------ -- | Network byte order. type HostAddress = Word32 {-# LINE 93 "Network/Socket/Internal.hsc" #-} -- | Host byte order. 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 102 "Network/Socket/Internal.hsc" #-} peek32 :: Ptr a -> Int -> IO Word32 peek32 p i0 = do let i' = i0 * 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 i0 a = do let i' = i0 * 4 pokeByte n = pokeByteOff p (s6_addr_offset + i' + n) x `sr` i = fromIntegral (x `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 126 "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 141 "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, Typeable) ------------------------------------------------------------------------ -- 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 173 "Network/Socket/Internal.hsc" #-} type FlowInfo = Word32 type ScopeID = Word32 {-# LINE 176 "Network/Socket/Internal.hsc" #-} data SockAddr -- C Names = SockAddrInet PortNumber -- sin_port (network byte order) HostAddress -- sin_addr (ditto) {-# LINE 182 "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 188 "Network/Socket/Internal.hsc" #-} {-# LINE 189 "Network/Socket/Internal.hsc" #-} | SockAddrUnix String -- sun_path {-# LINE 192 "Network/Socket/Internal.hsc" #-} deriving (Eq, Typeable) {-# LINE 199 "Network/Socket/Internal.hsc" #-} type CSaFamily = (Word16) {-# LINE 200 "Network/Socket/Internal.hsc" #-} {-# LINE 201 "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 207 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrUnix path) = case path of '\0':_ -> (2) + length path {-# LINE 210 "Network/Socket/Internal.hsc" #-} _ -> 110 {-# LINE 211 "Network/Socket/Internal.hsc" #-} {-# LINE 212 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrInet _ _) = 16 {-# LINE 213 "Network/Socket/Internal.hsc" #-} {-# LINE 214 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrInet6 _ _ _ _) = 28 {-# LINE 215 "Network/Socket/Internal.hsc" #-} {-# LINE 216 "Network/Socket/Internal.hsc" #-} -- | Computes the storage requirements (in bytes) required for a -- 'SockAddr' with the given 'Family'. sizeOfSockAddrByFamily :: Family -> Int {-# LINE 221 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_UNIX = 110 {-# LINE 222 "Network/Socket/Internal.hsc" #-} {-# LINE 223 "Network/Socket/Internal.hsc" #-} {-# LINE 224 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_INET6 = 28 {-# LINE 225 "Network/Socket/Internal.hsc" #-} {-# LINE 226 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_INET = 16 {-# LINE 227 "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 252 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrUnix path) = do {-# LINE 256 "Network/Socket/Internal.hsc" #-} {-# LINE 259 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((1) :: CSaFamily) {-# LINE 260 "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 263 "Network/Socket/Internal.hsc" #-} {-# LINE 264 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrInet (PortNum port) addr) = do {-# LINE 268 "Network/Socket/Internal.hsc" #-} {-# LINE 271 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((2) :: CSaFamily) {-# LINE 272 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port {-# LINE 273 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p addr {-# LINE 274 "Network/Socket/Internal.hsc" #-} {-# LINE 275 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrInet6 (PortNum port) flow addr scope) = do {-# LINE 279 "Network/Socket/Internal.hsc" #-} {-# LINE 282 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((10) :: CSaFamily) {-# LINE 283 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port {-# LINE 284 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p flow {-# LINE 285 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p addr {-# LINE 286 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p scope {-# LINE 287 "Network/Socket/Internal.hsc" #-} {-# LINE 288 "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 293 "Network/Socket/Internal.hsc" #-} case family :: CSaFamily of {-# LINE 295 "Network/Socket/Internal.hsc" #-} (1) -> do {-# LINE 296 "Network/Socket/Internal.hsc" #-} str <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p) {-# LINE 297 "Network/Socket/Internal.hsc" #-} return (SockAddrUnix str) {-# LINE 299 "Network/Socket/Internal.hsc" #-} (2) -> do {-# LINE 300 "Network/Socket/Internal.hsc" #-} addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p {-# LINE 301 "Network/Socket/Internal.hsc" #-} port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p {-# LINE 302 "Network/Socket/Internal.hsc" #-} return (SockAddrInet (PortNum port) addr) {-# LINE 304 "Network/Socket/Internal.hsc" #-} (10) -> do {-# LINE 305 "Network/Socket/Internal.hsc" #-} port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p {-# LINE 306 "Network/Socket/Internal.hsc" #-} flow <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p {-# LINE 307 "Network/Socket/Internal.hsc" #-} addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p {-# LINE 308 "Network/Socket/Internal.hsc" #-} scope <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p {-# LINE 309 "Network/Socket/Internal.hsc" #-} return (SockAddrInet6 (PortNum port) flow addr scope) {-# LINE 311 "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 320 "Network/Socket/Internal.hsc" #-} | AF_UNIX -- local to host (pipes, portals {-# LINE 322 "Network/Socket/Internal.hsc" #-} {-# LINE 323 "Network/Socket/Internal.hsc" #-} | AF_INET -- internetwork: UDP, TCP, etc {-# LINE 325 "Network/Socket/Internal.hsc" #-} {-# LINE 326 "Network/Socket/Internal.hsc" #-} | AF_INET6 -- Internet Protocol version 6 {-# LINE 328 "Network/Socket/Internal.hsc" #-} {-# LINE 331 "Network/Socket/Internal.hsc" #-} {-# LINE 334 "Network/Socket/Internal.hsc" #-} {-# LINE 337 "Network/Socket/Internal.hsc" #-} {-# LINE 340 "Network/Socket/Internal.hsc" #-} {-# LINE 343 "Network/Socket/Internal.hsc" #-} {-# LINE 346 "Network/Socket/Internal.hsc" #-} {-# LINE 349 "Network/Socket/Internal.hsc" #-} {-# LINE 352 "Network/Socket/Internal.hsc" #-} {-# LINE 353 "Network/Socket/Internal.hsc" #-} | AF_SNA -- IBM SNA {-# LINE 355 "Network/Socket/Internal.hsc" #-} {-# LINE 356 "Network/Socket/Internal.hsc" #-} | AF_DECnet -- DECnet {-# LINE 358 "Network/Socket/Internal.hsc" #-} {-# LINE 361 "Network/Socket/Internal.hsc" #-} {-# LINE 364 "Network/Socket/Internal.hsc" #-} {-# LINE 367 "Network/Socket/Internal.hsc" #-} {-# LINE 368 "Network/Socket/Internal.hsc" #-} | AF_APPLETALK -- Apple Talk {-# LINE 370 "Network/Socket/Internal.hsc" #-} {-# LINE 371 "Network/Socket/Internal.hsc" #-} | AF_ROUTE -- Internal Routing Protocol {-# LINE 373 "Network/Socket/Internal.hsc" #-} {-# LINE 376 "Network/Socket/Internal.hsc" #-} {-# LINE 379 "Network/Socket/Internal.hsc" #-} {-# LINE 382 "Network/Socket/Internal.hsc" #-} {-# LINE 385 "Network/Socket/Internal.hsc" #-} {-# LINE 388 "Network/Socket/Internal.hsc" #-} {-# LINE 391 "Network/Socket/Internal.hsc" #-} {-# LINE 392 "Network/Socket/Internal.hsc" #-} | AF_X25 -- CCITT X.25 {-# LINE 394 "Network/Socket/Internal.hsc" #-} {-# LINE 395 "Network/Socket/Internal.hsc" #-} | AF_AX25 {-# LINE 397 "Network/Socket/Internal.hsc" #-} {-# LINE 400 "Network/Socket/Internal.hsc" #-} {-# LINE 403 "Network/Socket/Internal.hsc" #-} {-# LINE 404 "Network/Socket/Internal.hsc" #-} | AF_IPX -- Novell Internet Protocol {-# LINE 406 "Network/Socket/Internal.hsc" #-} {-# LINE 409 "Network/Socket/Internal.hsc" #-} {-# LINE 412 "Network/Socket/Internal.hsc" #-} {-# LINE 415 "Network/Socket/Internal.hsc" #-} {-# LINE 418 "Network/Socket/Internal.hsc" #-} {-# LINE 421 "Network/Socket/Internal.hsc" #-} {-# LINE 424 "Network/Socket/Internal.hsc" #-} {-# LINE 427 "Network/Socket/Internal.hsc" #-} {-# LINE 430 "Network/Socket/Internal.hsc" #-} {-# LINE 433 "Network/Socket/Internal.hsc" #-} {-# LINE 436 "Network/Socket/Internal.hsc" #-} {-# LINE 439 "Network/Socket/Internal.hsc" #-} {-# LINE 442 "Network/Socket/Internal.hsc" #-} {-# LINE 443 "Network/Socket/Internal.hsc" #-} | AF_ISDN -- Integrated Services Digital Network {-# LINE 445 "Network/Socket/Internal.hsc" #-} {-# LINE 448 "Network/Socket/Internal.hsc" #-} {-# LINE 451 "Network/Socket/Internal.hsc" #-} {-# LINE 454 "Network/Socket/Internal.hsc" #-} {-# LINE 457 "Network/Socket/Internal.hsc" #-} {-# LINE 460 "Network/Socket/Internal.hsc" #-} {-# LINE 463 "Network/Socket/Internal.hsc" #-} {-# LINE 466 "Network/Socket/Internal.hsc" #-} {-# LINE 469 "Network/Socket/Internal.hsc" #-} {-# LINE 470 "Network/Socket/Internal.hsc" #-} | AF_NETROM -- Amateur radio NetROM {-# LINE 472 "Network/Socket/Internal.hsc" #-} {-# LINE 473 "Network/Socket/Internal.hsc" #-} | AF_BRIDGE -- multiprotocol bridge {-# LINE 475 "Network/Socket/Internal.hsc" #-} {-# LINE 476 "Network/Socket/Internal.hsc" #-} | AF_ATMPVC -- ATM PVCs {-# LINE 478 "Network/Socket/Internal.hsc" #-} {-# LINE 479 "Network/Socket/Internal.hsc" #-} | AF_ROSE -- Amateur Radio X.25 PLP {-# LINE 481 "Network/Socket/Internal.hsc" #-} {-# LINE 482 "Network/Socket/Internal.hsc" #-} | AF_NETBEUI -- 802.2LLC {-# LINE 484 "Network/Socket/Internal.hsc" #-} {-# LINE 485 "Network/Socket/Internal.hsc" #-} | AF_SECURITY -- Security callback pseudo AF {-# LINE 487 "Network/Socket/Internal.hsc" #-} {-# LINE 488 "Network/Socket/Internal.hsc" #-} | AF_PACKET -- Packet family {-# LINE 490 "Network/Socket/Internal.hsc" #-} {-# LINE 491 "Network/Socket/Internal.hsc" #-} | AF_ASH -- Ash {-# LINE 493 "Network/Socket/Internal.hsc" #-} {-# LINE 494 "Network/Socket/Internal.hsc" #-} | AF_ECONET -- Acorn Econet {-# LINE 496 "Network/Socket/Internal.hsc" #-} {-# LINE 497 "Network/Socket/Internal.hsc" #-} | AF_ATMSVC -- ATM SVCs {-# LINE 499 "Network/Socket/Internal.hsc" #-} {-# LINE 500 "Network/Socket/Internal.hsc" #-} | AF_IRDA -- IRDA sockets {-# LINE 502 "Network/Socket/Internal.hsc" #-} {-# LINE 503 "Network/Socket/Internal.hsc" #-} | AF_PPPOX -- PPPoX sockets {-# LINE 505 "Network/Socket/Internal.hsc" #-} {-# LINE 506 "Network/Socket/Internal.hsc" #-} | AF_WANPIPE -- Wanpipe API sockets {-# LINE 508 "Network/Socket/Internal.hsc" #-} {-# LINE 509 "Network/Socket/Internal.hsc" #-} | AF_BLUETOOTH -- bluetooth sockets {-# LINE 511 "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_ :: (Eq a, 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 :: (Eq a, 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 :: (Eq a, 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 558 "Network/Socket/Internal.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock name on_block act = throwErrnoIfMinus1RetryMayBlock name act on_block throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_ throwSocketError = throwErrno {-# LINE 615 "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 631 "Network/Socket/Internal.hsc" #-} withSocketsDo x = x {-# LINE 643 "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)