module Network.Socket.Internal( HostAddress , HostAddress6 , FlowInfo , ScopeID , PortNumber(..) , SockAddr(..) , peekSockAddr , pokeSockAddr , sizeOfSockAddr , sizeOfSockAddrByFamily , withSockAddr , withNewSockAddr , Family(..) , throwSocketError , throwSocketErrorCode , throwSocketErrorIfMinus1_ , throwSocketErrorIfMinus1Retry , throwSocketErrorIfMinus1Retry_ , throwSocketErrorIfMinus1RetryMayBlock , throwSocketErrorWaitRead , throwSocketErrorWaitWrite , withSocketsDo , zeroMemory ) where import Control.Exception(throwIO) import Control.Monad(unless) import Data.Typeable(Typeable) import Data.Word(Word32, Word16) import Foreign.C.Error(Errno(..), throwErrno, errnoToIOError, throwErrnoIfMinus1_, throwErrnoIfMinus1Retry, throwErrnoIfMinus1RetryMayBlock) import Foreign.C.Types(CInt(..), CSize(..)) import Foreign.Marshal.Alloc(allocaBytes) import Foreign.Ptr(Ptr, castPtr) import Foreign.Storable(Storable(..)) import Network.Socket.Types(Socket) type HostAddress = Word32 type HostAddress6 = (Word32, Word32, Word32, Word32) type FlowInfo = Word32 type ScopeID = Word32 newtype PortNumber = PortNum Word16 deriving (Enum, Eq, Integral, Num, Ord, Real, Show, Typeable, Storable) data SockAddr = SockAddrInet PortNumber HostAddress deriving (Eq, Ord, Show, Typeable) peekSockAddr :: Ptr SockAddr -> IO SockAddr peekSockAddr ptr = do family <- peek (castPtr ptr) :: IO Word16 unless (family == 2) $ throwIO (userError ("peekSockAddr: " ++ show family ++ "not supported on this platform.")) addr <- peekByteOff (castPtr ptr) 4 port <- peekByteOff (castPtr ptr) 2 return (SockAddrInet (PortNum port) addr) pokeSockAddr :: Ptr a -> SockAddr -> IO () pokeSockAddr ptr (SockAddrInet (PortNum port) addr) = do pokeByteOff (castPtr ptr) 0 (2 :: Word16) pokeByteOff (castPtr ptr) 2 port pokeByteOff (castPtr ptr) 4 addr sizeOfSockAddr :: SockAddr -> Int sizeOfSockAddr _ = 8 sizeOfSockAddrByFamily :: Family -> Int sizeOfSockAddrByFamily f = case f of AF_INET -> 8 _ -> error ("sizeOfSockAddrByFamily: " ++ show f ++ " not supported.") withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a withSockAddr saddr action = allocaBytes (sizeOfSockAddr saddr) $ \ ptr -> do pokeSockAddr ptr saddr action (castPtr ptr) (sizeOfSockAddr saddr) withNewSockAddr :: Family -> (Ptr SockAddr -> Int -> IO a) -> IO a withNewSockAddr family action = allocaBytes (sizeOfSockAddrByFamily family) $ \ ptr -> action ptr (sizeOfSockAddrByFamily family) data Family = AF_UNSPEC -- ^unspecified | AF_UNIX -- ^local to host (pipes, portals | AF_INET -- ^internetwork: UDP, TCP, etc | AF_INET6 -- ^Internet Protocol version 6 | AF_IMPLINK -- ^arpanet imp addresses | AF_PUP -- ^pup protocols: e.g. BSP | AF_CHAOS -- ^mit CHAOS protocols | AF_NS -- ^XEROX NS protocols | AF_NBS -- ^nbs protocols | AF_ECMA -- ^european computer manufacturers | AF_DATAKIT -- ^datakit protocols | AF_CCITT -- ^CCITT protocols, X.25 etc | AF_SNA -- ^IBM SNA | AF_DECnet -- ^DECnet | AF_DLI -- ^Direct data link interface | AF_LAT -- ^LAT | AF_HYLINK -- ^NSC Hyperchannel | AF_APPLETALK -- ^Apple Talk | AF_ROUTE -- ^Internal Routing Protocol | AF_NETBIOS -- ^NetBios-style addresses | AF_NIT -- ^Network Interface Tap | AF_802 -- ^IEEE 802.2, also ISO 8802 | AF_ISO -- ^ISO protocols | AF_OSI -- ^umbrella of all families used by OSI | AF_NETMAN -- ^DNA Network Management | AF_X25 -- ^CCITT X.25 | AF_AX25 | AF_OSINET -- ^AFI | AF_GOSSIP -- ^US Government OSI | AF_IPX -- ^Novell Internet Protocol | Pseudo_AF_XTP -- ^eXpress Transfer Protocol (no AF) | AF_CTF -- ^Common Trace Facility | AF_WAN -- ^Wide Area Network protocols | AF_SDL -- ^SGI Data Link for DLPI | AF_NETWARE | AF_NDD | AF_INTF -- ^Debugging use only | AF_COIP -- ^connection-oriented IP, aka ST II | AF_CNT -- ^Computer Network Technology | Pseudo_AF_RTIP -- ^Help Identify RTIP packets | Pseudo_AF_PIP -- ^Help Identify PIP packets | AF_SIP -- ^Simple Internet Protocol | AF_ISDN -- ^Integrated Services Digital Network | Pseudo_AF_KEY -- ^Internal key-management function | AF_NATM -- ^native ATM access | AF_ARP -- ^(rev.) addr. res. prot. (RFC 826) | Pseudo_AF_HDRCMPLT -- ^Used by BPF to not rewrite hdrs in iface output | AF_ENCAP | AF_LINK -- ^Link layer interface | AF_RAW -- ^Link layer interface | AF_RIF -- ^raw interface | AF_NETROM -- ^Amateur radio NetROM | AF_BRIDGE -- ^multiprotocol bridge | AF_ATMPVC -- ^ATM PVCs | AF_ROSE -- ^Amateur Radio X.25 PLP | AF_NETBEUI -- ^802.2LLC | AF_SECURITY -- ^Security callback pseudo AF | AF_PACKET -- ^Packet family | AF_ASH -- ^Ash | AF_ECONET -- ^Acorn Econet | AF_ATMSVC -- ^ATM SVCs | AF_IRDA -- ^IRDA sockets | AF_PPPOX -- ^PPPoX sockets | AF_WANPIPE -- ^Wanpipe API sockets | AF_BLUETOOTH -- ^bluetooth sockets deriving (Eq, Ord, Read, Show) throwSocketError :: String -> IO a throwSocketError = throwErrno throwSocketErrorCode :: String -> CInt ->IO a throwSocketErrorCode loc errno = ioError (errnoToIOError loc (Errno errno) Nothing Nothing) -- | 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 () throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_ -- | 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 throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry -- | 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. Discards the result of the IO action after -- error handling. throwSocketErrorIfMinus1Retry_ :: (Eq a, Num a) => String -- ^ textual description of the location -> IO a -- ^ the 'IO' operation to be executed -> IO () throwSocketErrorIfMinus1Retry_ loc m = throwSocketErrorIfMinus1Retry loc m >> return () -- | 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 throwSocketErrorIfMinus1RetryMayBlock name on_block act = throwErrnoIfMinus1RetryMayBlock name act on_block -- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with -- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready, -- and try again. throwSocketErrorWaitRead :: (Eq a, Num a) => Socket -> String -> IO a -> IO a throwSocketErrorWaitRead _ _ _ = fail "FIXME: throwSocketErrorWaitRead is not supported in network-hans" -- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with -- @EWOULDBLOCK@ or similar, wait for the socket to be write-ready, -- and try again. throwSocketErrorWaitWrite :: (Eq a, Num a) => Socket -> String -> IO a -> IO a throwSocketErrorWaitWrite _ _ _ = fail "FIXME: throwSocketErrorWaitWrite is not supported in network-hans" withSocketsDo :: IO a -> IO a withSocketsDo action = action zeroMemory :: Ptr a -> CSize -> IO () zeroMemory p s = memset p 0 s foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO ()