summaryrefslogtreecommitdiff
path: root/Presence/GetHostByAddr.hs
blob: fd01108d5acf7907802e11bae14e284e0ccc7554 (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
75
{-# 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
import Network.Socket.Internal


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: