1 files changed, 78 insertions, 0 deletions

diff --git a/server/src/GetHostByAddr.hs b/server/src/GetHostByAddr.hs
new file mode 100644
index 00000000..068fc93d
--- /dev/null
+++ b/server/src/GetHostByAddr.hs
@@ -0,0 +1,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: