blob: 068fc93deae3aa17fa067feb0af21a5e82db1761 (
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
76
77
78
|
{-# 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:
|
