summaryrefslogtreecommitdiff
path: root/Presence/GetHostByAddr.hs
blob: a451f0889c20bef75260b14db0fc1ecc8bbeb85e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
{-# LINE 1 "Presence/GetHostByAddr.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LINE 2 "Presence/GetHostByAddr.hsc" #-}
#include "Typeable.h"
module GetHostByAddr where

import Network.BSD
import Foreign.Ptr
import Foreign.C.Types
import Foreign.Storable (Storable(..))
import Foreign.Marshal.Utils (with)
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 addr scope) = do
 let family = AF_INET6
 with addr $ \ ptr_addr -> withLock $ do
 throwNoSuchThingIfNull         "getHostByAddr" "no such host entry"
   $ trySysCall $ c_gethostbyaddr ptr_addr (fromIntegral (sizeOf addr)) (packFamily family)
 >>= peek


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



-- vim:ft=haskell: