{-# LINE 1 "Network/Socket/Info.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#include "HsNetDef.h"
module Network.Socket.Info where
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Utils (maybeWith, with)
import GHC.IO (unsafePerformIO)
import GHC.IO.Exception (IOErrorType(NoSuchThing))
import System.IO.Error (ioeSetErrorString, mkIOError)
import Network.Socket.Imports
import Network.Socket.Internal
import Network.Socket.Types
type HostName = String
type ServiceName = String
data AddrInfoFlag =
AI_ADDRCONFIG
| AI_ALL
| AI_CANONNAME
| AI_NUMERICHOST
| AI_NUMERICSERV
| AI_PASSIVE
| AI_V4MAPPED
deriving (Eq, Read, Show, Typeable)
aiFlagMapping :: [(AddrInfoFlag, CInt)]
aiFlagMapping =
[
{-# LINE 73 "Network/Socket/Info.hsc" #-}
(AI_ADDRCONFIG, 32),
{-# LINE 74 "Network/Socket/Info.hsc" #-}
{-# LINE 77 "Network/Socket/Info.hsc" #-}
{-# LINE 78 "Network/Socket/Info.hsc" #-}
(AI_ALL, 16),
{-# LINE 79 "Network/Socket/Info.hsc" #-}
{-# LINE 82 "Network/Socket/Info.hsc" #-}
(AI_CANONNAME, 2),
{-# LINE 83 "Network/Socket/Info.hsc" #-}
(AI_NUMERICHOST, 4),
{-# LINE 84 "Network/Socket/Info.hsc" #-}
{-# LINE 85 "Network/Socket/Info.hsc" #-}
(AI_NUMERICSERV, 1024),
{-# LINE 86 "Network/Socket/Info.hsc" #-}
{-# LINE 89 "Network/Socket/Info.hsc" #-}
(AI_PASSIVE, 1),
{-# LINE 90 "Network/Socket/Info.hsc" #-}
{-# LINE 91 "Network/Socket/Info.hsc" #-}
(AI_V4MAPPED, 8)
{-# LINE 92 "Network/Socket/Info.hsc" #-}
{-# LINE 95 "Network/Socket/Info.hsc" #-}
]
addrInfoFlagImplemented :: AddrInfoFlag -> Bool
addrInfoFlagImplemented f = packBits aiFlagMapping [f] /= 0
data AddrInfo = AddrInfo {
addrFlags :: [AddrInfoFlag]
, addrFamily :: Family
, addrSocketType :: SocketType
, addrProtocol :: ProtocolNumber
, addrAddress :: SockAddr
, addrCanonName :: Maybe String
} deriving (Eq, Show, Typeable)
instance Storable AddrInfo where
sizeOf _ = 48
{-# LINE 113 "Network/Socket/Info.hsc" #-}
alignment _ = alignment (undefined :: CInt)
peek p = do
ai_flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 117 "Network/Socket/Info.hsc" #-}
ai_family <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 118 "Network/Socket/Info.hsc" #-}
ai_socktype <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 119 "Network/Socket/Info.hsc" #-}
ai_protocol <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p
{-# LINE 120 "Network/Socket/Info.hsc" #-}
ai_addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p >>= peekSockAddr
{-# LINE 121 "Network/Socket/Info.hsc" #-}
ai_canonname_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 122 "Network/Socket/Info.hsc" #-}
ai_canonname <- if ai_canonname_ptr == nullPtr
then return Nothing
else Just <$> peekCString ai_canonname_ptr
socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype
return $ AddrInfo {
addrFlags = unpackBits aiFlagMapping ai_flags
, addrFamily = unpackFamily ai_family
, addrSocketType = socktype
, addrProtocol = ai_protocol
, addrAddress = ai_addr
, addrCanonName = ai_canonname
}
poke p (AddrInfo flags family sockType protocol _ _) = do
c_stype <- packSocketTypeOrThrow "AddrInfo.poke" sockType
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (packBits aiFlagMapping flags)
{-# LINE 141 "Network/Socket/Info.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p (packFamily family)
{-# LINE 142 "Network/Socket/Info.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p c_stype
{-# LINE 143 "Network/Socket/Info.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p protocol
{-# LINE 144 "Network/Socket/Info.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p (0::CSize)
{-# LINE 148 "Network/Socket/Info.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p nullPtr
{-# LINE 149 "Network/Socket/Info.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p nullPtr
{-# LINE 150 "Network/Socket/Info.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) p nullPtr
{-# LINE 151 "Network/Socket/Info.hsc" #-}
data NameInfoFlag =
NI_DGRAM
| NI_NAMEREQD
| NI_NOFQDN
| NI_NUMERICHOST
| NI_NUMERICSERV
deriving (Eq, Read, Show, Typeable)
niFlagMapping :: [(NameInfoFlag, CInt)]
niFlagMapping = [(NI_DGRAM, 16),
{-# LINE 179 "Network/Socket/Info.hsc" #-}
(NI_NAMEREQD, 8),
{-# LINE 180 "Network/Socket/Info.hsc" #-}
(NI_NOFQDN, 4),
{-# LINE 181 "Network/Socket/Info.hsc" #-}
(NI_NUMERICHOST, 1),
{-# LINE 182 "Network/Socket/Info.hsc" #-}
(NI_NUMERICSERV, 2)]
{-# LINE 183 "Network/Socket/Info.hsc" #-}
defaultHints :: AddrInfo
defaultHints = AddrInfo {
addrFlags = []
, addrFamily = AF_UNSPEC
, addrSocketType = NoSocketType
, addrProtocol = defaultProtocol
, addrAddress = undefined
, addrCanonName = undefined
}
showDefaultHints :: AddrInfo -> String
showDefaultHints AddrInfo{..} = concat [
"AddrInfo {"
, "addrFlags = "
, show addrFlags
, ", addrFamily = "
, show addrFamily
, ", addrSocketType = "
, show addrSocketType
, ", addrProtocol = "
, show addrProtocol
, ", addrAddress = "
, "<assumed to be undefined>"
, ", addrCanonName = "
, "<assumed to be undefined>"
, "}"
]
getAddrInfo
:: Maybe AddrInfo
-> Maybe HostName
-> Maybe ServiceName
-> IO [AddrInfo]
getAddrInfo hints node service = alloc getaddrinfo
where
alloc body = withSocketsDo $ maybeWith withCString node $ \c_node ->
maybeWith withCString service $ \c_service ->
maybeWith with filteredHints $ \c_hints ->
alloca $ \ptr_ptr_addrs ->
body c_node c_service c_hints ptr_ptr_addrs
getaddrinfo c_node c_service c_hints ptr_ptr_addrs = do
ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs
if ret == 0 then do
ptr_addrs <- peek ptr_ptr_addrs
ais <- followAddrInfo ptr_addrs
c_freeaddrinfo ptr_addrs
return ais
else do
err <- gai_strerror ret
ioError $ ioeSetErrorString
(mkIOError NoSuchThing message Nothing Nothing)
err
message = concat [
"Network.Socket.getAddrInfo (called with preferred socket type/protocol: "
, maybe (show hints) showDefaultHints hints
, ", host name: "
, show node
, ", service name: "
, show service
, ")"
]
{-# LINE 309 "Network/Socket/Info.hsc" #-}
filteredHints = hints
{-# LINE 311 "Network/Socket/Info.hsc" #-}
followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]
followAddrInfo ptr_ai
| ptr_ai == nullPtr = return []
| otherwise = do
a <- peek ptr_ai
as <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr_ai >>= followAddrInfo
{-# LINE 318 "Network/Socket/Info.hsc" #-}
return (a : as)
foreign import ccall safe "hsnet_getaddrinfo"
c_getaddrinfo :: CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo)
-> IO CInt
foreign import ccall safe "hsnet_freeaddrinfo"
c_freeaddrinfo :: Ptr AddrInfo -> IO ()
gai_strerror :: CInt -> IO String
{-# LINE 330 "Network/Socket/Info.hsc" #-}
gai_strerror n = c_gai_strerror n >>= peekCString
foreign import ccall safe "gai_strerror"
c_gai_strerror :: CInt -> IO CString
{-# LINE 337 "Network/Socket/Info.hsc" #-}
withCStringIf :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a
withCStringIf False _ f = f 0 nullPtr
withCStringIf True n f = allocaBytes n (f (fromIntegral n))
getNameInfo
:: [NameInfoFlag]
-> Bool
-> Bool
-> SockAddr
-> IO (Maybe HostName, Maybe ServiceName)
getNameInfo flags doHost doService addr = alloc getnameinfo
where
alloc body = withSocketsDo $
withCStringIf doHost (1025) $ \c_hostlen c_host ->
{-# LINE 370 "Network/Socket/Info.hsc" #-}
withCStringIf doService (32) $ \c_servlen c_serv ->
{-# LINE 371 "Network/Socket/Info.hsc" #-}
withSockAddr addr $ \ptr_addr sz ->
body c_hostlen c_host c_servlen c_serv ptr_addr sz
getnameinfo c_hostlen c_host c_servlen c_serv ptr_addr sz = do
ret <- c_getnameinfo ptr_addr
(fromIntegral sz)
c_host
c_hostlen
c_serv
c_servlen
(packBits niFlagMapping flags)
if ret == 0 then do
let peekIf doIf c_val =
if doIf then Just <$> peekCString c_val else return Nothing
host <- peekIf doHost c_host
serv <- peekIf doService c_serv
return (host, serv)
else do
err <- gai_strerror ret
ioError $ ioeSetErrorString
(mkIOError NoSuchThing message Nothing Nothing)
err
message = concat [
"Network.Socket.getNameInfo (called with flags: "
, show flags
, ", hostname lookup: "
, show doHost
, ", service name lookup: "
, show doService
, ", socket address: "
, show addr
, ")"
]
foreign import ccall safe "hsnet_getnameinfo"
c_getnameinfo :: Ptr SockAddr -> CInt -> CString -> CSize -> CString
-> CSize -> CInt -> IO CInt
packBits :: (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b
packBits mapping xs = foldl' pack 0 mapping
where
pack acc (k, v) | k `elem` xs = acc .|. v
| otherwise = acc
unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a]
unpackBits [] _ = []
unpackBits ((k,v):xs) r
| r .&. v /= 0 = k : unpackBits xs (r .&. complement v)
| otherwise = unpackBits xs r
instance Show SockAddr where
{-# LINE 436 "Network/Socket/Info.hsc" #-}
showsPrec _ (SockAddrUnix str) = showString str
{-# LINE 440 "Network/Socket/Info.hsc" #-}
showsPrec _ addr@(SockAddrInet port _)
= showString (unsafePerformIO $
fst <$> getNameInfo [NI_NUMERICHOST] True False addr >>=
maybe (fail "showsPrec: impossible internal error") return)
. showString ":"
. shows port
showsPrec _ addr@(SockAddrInet6 port _ _ _)
= showChar '['
. showString (unsafePerformIO $
fst <$> getNameInfo [NI_NUMERICHOST] True False addr >>=
maybe (fail "showsPrec: impossible internal error") return)
. showString "]:"
. shows port