module Foundation.Network.HostName
( HostName(..)
, HostNameInfo(..)
, getHostNameInfo
, getHostNameInfo_
) where
import Foundation.Class.Storable
import Foundation.Internal.Base
import Foundation.Internal.Proxy
import Foundation.Hashing (Hashable)
import Foundation.String
import Foundation.Array
import Foundation.Collection.Mappable
import Foundation.Network.IPv4 (IPv4)
import Foundation.Network.IPv6 (IPv6)
import Foundation.System.Bindings.Network
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr (nullPtr)
import Control.Concurrent.MVar
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad ((=<<))
newtype HostName = HostName { toString :: String }
deriving (Eq, Ord, Typeable, Hashable)
instance Show HostName where
show = show . toString
instance IsString HostName where
fromString = HostName . fromString
data HostNameInfo address_type = HostNameInfo
{ officialName :: !HostName
, aliases :: !(Array HostName)
, addresses :: !(Array address_type)
} deriving (Show, Eq, Ord, Typeable)
data HostNameError
= HostNotFound !HostName
| NoAssociatedData !HostName
| FatalError
| UnknownError !CInt
deriving (Show,Eq,Typeable)
instance Exception HostNameError
class SocketFamily a where
familyCode :: proxy a -> CInt
instance SocketFamily IPv4 where
familyCode _ = (2)
instance SocketFamily IPv6 where
familyCode _ = (10)
getHostNameInfo :: (Eq address_type, Storable address_type, SocketFamily address_type)
=> HostName
-> IO (HostNameInfo address_type)
getHostNameInfo = getHostNameInfo_ Proxy
globalMutex :: MVar ()
globalMutex = unsafePerformIO (newMVar ())
getHostNameInfo_ :: (SocketFamily address_type, Eq address_type, Storable address_type)
=> Proxy address_type
-> HostName
-> IO (HostNameInfo address_type)
getHostNameInfo_ p h@(HostName hn) =
withMVar globalMutex $ \_ ->
withCString (toList hn) $ \cname -> do
ptr <- loop $ c_gethostbyname2 cname (familyCode p)
on <- peekHostName . castPtr =<< peek (castPtr $ offname_ptr ptr)
as <- getAliases . castPtr =<< peek (castPtr $ aliases_ptr ptr)
addrs <- getAddresses p . castPtr =<< peek (castPtr $ addr_list ptr)
return $ HostNameInfo on as addrs
where
loop f = do
ptr <- f
if ptr /= nullPtr
then return ptr
else do
err <- getHErrno
case err of
_ | err == herr_NoData -> throwIO $ NoAssociatedData h
| err == herr_HostNotFound -> throwIO $ HostNotFound h
| err == herr_TryAgain -> loop f
| err == herr_NoRecovery -> throwIO FatalError
| otherwise -> throwIO $ UnknownError err
offname_ptr = ((\hsc_ptr -> hsc_ptr `plusPtr` 0))
aliases_ptr = ((\hsc_ptr -> hsc_ptr `plusPtr` 8))
addr_list = ((\hsc_ptr -> hsc_ptr `plusPtr` 24))
peekHostName :: Ptr Word8 -> IO HostName
peekHostName ptr = HostName . fst . fromBytesLenient <$> peekArrayEndedBy 0x00 ptr
getAliases :: Ptr (Ptr Word8) -> IO (Array HostName)
getAliases ptr = do
arr <- peekArrayEndedBy nullPtr ptr
forM arr peekHostName
getAddresses :: Storable address_type
=> Proxy address_type
-> Ptr (Ptr address_type)
-> IO (Array address_type)
getAddresses _ ptr = do
arr <- peekArrayEndedBy nullPtr ptr
forM arr peek
foreign import ccall safe "gethostbyname2"
c_gethostbyname2 :: CString -> CInt -> IO (Ptr Word8)