{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE NondecreasingIndentation #-}
module GetHostByAddr where

import Network.BSD
import Foreign.Ptr
import Foreign.C.Types
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Utils (with)
import Foreign.Marshal.Alloc
import Control.Concurrent
import System.IO.Unsafe
import System.IO.Error (ioeSetErrorString, mkIOError)
import Network.Socket
import GHC.IO.Exception


throwNoSuchThingIfNull :: String -> String -> IO (Ptr a) -> IO (Ptr a)
throwNoSuchThingIfNull loc desc act = do
  ptr <- act
  if (ptr == nullPtr)
       then ioError (ioeSetErrorString (mkIOError NoSuchThing loc Nothing Nothing) desc)
       else return ptr

{-# NOINLINE lock #-}
lock :: MVar ()
lock = unsafePerformIO $ newMVar ()

withLock :: IO a -> IO a
withLock act = withMVar lock (\_ -> act)

trySysCall :: IO a -> IO a
trySysCall act = act

{-
-- The locking of gethostbyaddr is similar to gethostbyname.
-- | Get a 'HostEntry' corresponding to the given address and family.
-- Note that only IPv4 is currently supported.
getHostByAddr :: Family -> SockAddr -> IO HostEntry
getHostByAddr family addr = do
 withSockAddr addr $ \ ptr_addr len -> withLock $ do
 throwNoSuchThingIfNull         "getHostByAddr" "no such host entry"
   $ trySysCall $ c_gethostbyaddr ptr_addr (fromIntegral len) (packFamily family)
 >>= peek
-}


-- The locking of gethostbyaddr is similar to gethostbyname.
-- | Get a 'HostEntry' corresponding to the given address and family.
-- Note that only IPv4 is currently supported.
-- getHostByAddr :: Family -> HostAddress -> IO HostEntry
-- getHostByAddr family addr = do
getHostByAddr :: SockAddr -> IO HostEntry
getHostByAddr (SockAddrInet port addr ) = do
 let family = AF_INET
 with addr $ \ ptr_addr -> withLock $ do
 throwNoSuchThingIfNull         "getHostByAddr" "no such host entry"
   $ trySysCall $ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (packFamily family)
 >>= peek
getHostByAddr (SockAddrInet6 port flow (a,b,c,d) scope) = do
 let family = AF_INET6
 allocaBytes 16 $ \ ptr_addr -> do
 pokeElemOff ptr_addr 0 a
 pokeElemOff ptr_addr 1 b
 pokeElemOff ptr_addr 2 c
 pokeElemOff ptr_addr 3 d
 withLock $ do
 throwNoSuchThingIfNull         "getHostByAddr" "no such host entry"
   $ trySysCall $ c_gethostbyaddr ptr_addr 16 (packFamily family)
 >>= peek


foreign import ccall safe "gethostbyaddr"
   c_gethostbyaddr :: Ptr a -> CInt -> CInt -> IO (Ptr HostEntry)



-- vim:ft=haskell: