{-# 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" #-} module Network.Socket.Internal ( -- * Socket addresses HostAddress, {-# LINE 26 "Network/Socket/Internal.hsc" #-} HostAddress6, FlowInfo, ScopeID, {-# LINE 30 "Network/Socket/Internal.hsc" #-} PortNumber(..), SockAddr(..), peekSockAddr, pokeSockAddr, sizeOfSockAddr, sizeOfSockAddrByFamily, withSockAddr, withNewSockAddr, -- * Protocol families Family(..), -- * Socket error functions {-# LINE 47 "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 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 80 "Network/Socket/Internal.hsc" #-} ------------------------------------------------------------------------ type HostAddress = Word32 {-# LINE 86 "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 94 "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 118 "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 133 "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 165 "Network/Socket/Internal.hsc" #-} type FlowInfo = Word32 type ScopeID = Word32 {-# LINE 168 "Network/Socket/Internal.hsc" #-} data SockAddr -- C Names = SockAddrInet PortNumber -- sin_port (network byte order) HostAddress -- sin_addr (ditto) {-# LINE 174 "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 180 "Network/Socket/Internal.hsc" #-} {-# LINE 181 "Network/Socket/Internal.hsc" #-} | SockAddrUnix String -- sun_path {-# LINE 184 "Network/Socket/Internal.hsc" #-} deriving (Eq) {-# LINE 191 "Network/Socket/Internal.hsc" #-} type CSaFamily = (Word16) {-# LINE 192 "Network/Socket/Internal.hsc" #-} {-# LINE 193 "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 199 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrUnix path) = case path of '\0':_ -> (2) + length path {-# LINE 202 "Network/Socket/Internal.hsc" #-} _ -> 110 {-# LINE 203 "Network/Socket/Internal.hsc" #-} {-# LINE 204 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrInet _ _) = 16 {-# LINE 205 "Network/Socket/Internal.hsc" #-} {-# LINE 206 "Network/Socket/Internal.hsc" #-} sizeOfSockAddr (SockAddrInet6 _ _ _ _) = 28 {-# LINE 207 "Network/Socket/Internal.hsc" #-} {-# LINE 208 "Network/Socket/Internal.hsc" #-} -- | Computes the storage requirements (in bytes) required for a -- 'SockAddr' with the given 'Family'. sizeOfSockAddrByFamily :: Family -> Int {-# LINE 213 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_UNIX = 110 {-# LINE 214 "Network/Socket/Internal.hsc" #-} {-# LINE 215 "Network/Socket/Internal.hsc" #-} {-# LINE 216 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_INET6 = 28 {-# LINE 217 "Network/Socket/Internal.hsc" #-} {-# LINE 218 "Network/Socket/Internal.hsc" #-} sizeOfSockAddrByFamily AF_INET = 16 {-# LINE 219 "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 244 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrUnix path) = do {-# LINE 248 "Network/Socket/Internal.hsc" #-} {-# LINE 251 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((1) :: CSaFamily) {-# LINE 252 "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 255 "Network/Socket/Internal.hsc" #-} {-# LINE 256 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrInet (PortNum port) addr) = do {-# LINE 260 "Network/Socket/Internal.hsc" #-} {-# LINE 263 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((2) :: CSaFamily) {-# LINE 264 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port {-# LINE 265 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p addr {-# LINE 266 "Network/Socket/Internal.hsc" #-} {-# LINE 267 "Network/Socket/Internal.hsc" #-} pokeSockAddr p (SockAddrInet6 (PortNum port) flow addr scope) = do {-# LINE 271 "Network/Socket/Internal.hsc" #-} {-# LINE 274 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p ((10) :: CSaFamily) {-# LINE 275 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p port {-# LINE 276 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p flow {-# LINE 277 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p addr {-# LINE 278 "Network/Socket/Internal.hsc" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p scope {-# LINE 279 "Network/Socket/Internal.hsc" #-} {-# LINE 280 "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 285 "Network/Socket/Internal.hsc" #-} case family :: CSaFamily of {-# LINE 287 "Network/Socket/Internal.hsc" #-} (1) -> do {-# LINE 288 "Network/Socket/Internal.hsc" #-} str <- peekCString (((\hsc_ptr -> hsc_ptr `plusPtr` 2)) p) {-# LINE 289 "Network/Socket/Internal.hsc" #-} return (SockAddrUnix str) {-# LINE 291 "Network/Socket/Internal.hsc" #-} (2) -> do {-# LINE 292 "Network/Socket/Internal.hsc" #-} addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p {-# LINE 293 "Network/Socket/Internal.hsc" #-} port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p {-# LINE 294 "Network/Socket/Internal.hsc" #-} return (SockAddrInet (PortNum port) addr) {-# LINE 296 "Network/Socket/Internal.hsc" #-} (10) -> do {-# LINE 297 "Network/Socket/Internal.hsc" #-} port <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p {-# LINE 298 "Network/Socket/Internal.hsc" #-} flow <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p {-# LINE 299 "Network/Socket/Internal.hsc" #-} addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p {-# LINE 300 "Network/Socket/Internal.hsc" #-} scope <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p {-# LINE 301 "Network/Socket/Internal.hsc" #-} return (SockAddrInet6 (PortNum port) flow addr scope) {-# LINE 303 "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 312 "Network/Socket/Internal.hsc" #-} | AF_UNIX -- local to host (pipes, portals {-# LINE 314 "Network/Socket/Internal.hsc" #-} {-# LINE 315 "Network/Socket/Internal.hsc" #-} | AF_INET -- internetwork: UDP, TCP, etc {-# LINE 317 "Network/Socket/Internal.hsc" #-} {-# LINE 318 "Network/Socket/Internal.hsc" #-} | AF_INET6 -- Internet Protocol version 6 {-# LINE 320 "Network/Socket/Internal.hsc" #-} {-# LINE 323 "Network/Socket/Internal.hsc" #-} {-# LINE 326 "Network/Socket/Internal.hsc" #-} {-# LINE 329 "Network/Socket/Internal.hsc" #-} {-# LINE 332 "Network/Socket/Internal.hsc" #-} {-# LINE 335 "Network/Socket/Internal.hsc" #-} {-# LINE 338 "Network/Socket/Internal.hsc" #-} {-# LINE 341 "Network/Socket/Internal.hsc" #-} {-# LINE 344 "Network/Socket/Internal.hsc" #-} {-# LINE 345 "Network/Socket/Internal.hsc" #-} | AF_SNA -- IBM SNA {-# LINE 347 "Network/Socket/Internal.hsc" #-} {-# LINE 348 "Network/Socket/Internal.hsc" #-} | AF_DECnet -- DECnet {-# LINE 350 "Network/Socket/Internal.hsc" #-} {-# LINE 353 "Network/Socket/Internal.hsc" #-} {-# LINE 356 "Network/Socket/Internal.hsc" #-} {-# LINE 359 "Network/Socket/Internal.hsc" #-} {-# LINE 360 "Network/Socket/Internal.hsc" #-} | AF_APPLETALK -- Apple Talk {-# LINE 362 "Network/Socket/Internal.hsc" #-} {-# LINE 363 "Network/Socket/Internal.hsc" #-} | AF_ROUTE -- Internal Routing Protocol {-# LINE 365 "Network/Socket/Internal.hsc" #-} {-# LINE 368 "Network/Socket/Internal.hsc" #-} {-# LINE 371 "Network/Socket/Internal.hsc" #-} {-# LINE 374 "Network/Socket/Internal.hsc" #-} {-# LINE 377 "Network/Socket/Internal.hsc" #-} {-# LINE 380 "Network/Socket/Internal.hsc" #-} {-# LINE 383 "Network/Socket/Internal.hsc" #-} {-# LINE 384 "Network/Socket/Internal.hsc" #-} | AF_X25 -- CCITT X.25 {-# LINE 386 "Network/Socket/Internal.hsc" #-} {-# LINE 387 "Network/Socket/Internal.hsc" #-} | AF_AX25 {-# LINE 389 "Network/Socket/Internal.hsc" #-} {-# LINE 392 "Network/Socket/Internal.hsc" #-} {-# LINE 395 "Network/Socket/Internal.hsc" #-} {-# LINE 396 "Network/Socket/Internal.hsc" #-} | AF_IPX -- Novell Internet Protocol {-# LINE 398 "Network/Socket/Internal.hsc" #-} {-# LINE 401 "Network/Socket/Internal.hsc" #-} {-# LINE 404 "Network/Socket/Internal.hsc" #-} {-# LINE 407 "Network/Socket/Internal.hsc" #-} {-# LINE 410 "Network/Socket/Internal.hsc" #-} {-# LINE 413 "Network/Socket/Internal.hsc" #-} {-# LINE 416 "Network/Socket/Internal.hsc" #-} {-# LINE 419 "Network/Socket/Internal.hsc" #-} {-# LINE 422 "Network/Socket/Internal.hsc" #-} {-# LINE 425 "Network/Socket/Internal.hsc" #-} {-# LINE 428 "Network/Socket/Internal.hsc" #-} {-# LINE 431 "Network/Socket/Internal.hsc" #-} {-# LINE 434 "Network/Socket/Internal.hsc" #-} {-# LINE 435 "Network/Socket/Internal.hsc" #-} | AF_ISDN -- Integrated Services Digital Network {-# LINE 437 "Network/Socket/Internal.hsc" #-} {-# LINE 440 "Network/Socket/Internal.hsc" #-} {-# LINE 443 "Network/Socket/Internal.hsc" #-} {-# LINE 446 "Network/Socket/Internal.hsc" #-} {-# LINE 449 "Network/Socket/Internal.hsc" #-} {-# LINE 452 "Network/Socket/Internal.hsc" #-} {-# LINE 455 "Network/Socket/Internal.hsc" #-} {-# LINE 458 "Network/Socket/Internal.hsc" #-} {-# LINE 461 "Network/Socket/Internal.hsc" #-} {-# LINE 462 "Network/Socket/Internal.hsc" #-} | AF_NETROM -- Amateur radio NetROM {-# LINE 464 "Network/Socket/Internal.hsc" #-} {-# LINE 465 "Network/Socket/Internal.hsc" #-} | AF_BRIDGE -- multiprotocol bridge {-# LINE 467 "Network/Socket/Internal.hsc" #-} {-# LINE 468 "Network/Socket/Internal.hsc" #-} | AF_ATMPVC -- ATM PVCs {-# LINE 470 "Network/Socket/Internal.hsc" #-} {-# LINE 471 "Network/Socket/Internal.hsc" #-} | AF_ROSE -- Amateur Radio X.25 PLP {-# LINE 473 "Network/Socket/Internal.hsc" #-} {-# LINE 474 "Network/Socket/Internal.hsc" #-} | AF_NETBEUI -- 802.2LLC {-# LINE 476 "Network/Socket/Internal.hsc" #-} {-# LINE 477 "Network/Socket/Internal.hsc" #-} | AF_SECURITY -- Security callback pseudo AF {-# LINE 479 "Network/Socket/Internal.hsc" #-} {-# LINE 480 "Network/Socket/Internal.hsc" #-} | AF_PACKET -- Packet family {-# LINE 482 "Network/Socket/Internal.hsc" #-} {-# LINE 483 "Network/Socket/Internal.hsc" #-} | AF_ASH -- Ash {-# LINE 485 "Network/Socket/Internal.hsc" #-} {-# LINE 486 "Network/Socket/Internal.hsc" #-} | AF_ECONET -- Acorn Econet {-# LINE 488 "Network/Socket/Internal.hsc" #-} {-# LINE 489 "Network/Socket/Internal.hsc" #-} | AF_ATMSVC -- ATM SVCs {-# LINE 491 "Network/Socket/Internal.hsc" #-} {-# LINE 492 "Network/Socket/Internal.hsc" #-} | AF_IRDA -- IRDA sockets {-# LINE 494 "Network/Socket/Internal.hsc" #-} {-# LINE 495 "Network/Socket/Internal.hsc" #-} | AF_PPPOX -- PPPoX sockets {-# LINE 497 "Network/Socket/Internal.hsc" #-} {-# LINE 498 "Network/Socket/Internal.hsc" #-} | AF_WANPIPE -- Wanpipe API sockets {-# LINE 500 "Network/Socket/Internal.hsc" #-} {-# LINE 501 "Network/Socket/Internal.hsc" #-} | AF_BLUETOOTH -- bluetooth sockets {-# LINE 503 "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 547 "Network/Socket/Internal.hsc" #-} throwSocketErrorIfMinus1RetryMayBlock name on_block act = throwErrnoIfMinus1RetryMayBlock name act on_block throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_ throwSocketError = throwErrno {-# LINE 604 "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 620 "Network/Socket/Internal.hsc" #-} withSocketsDo x = x {-# LINE 632 "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)