src/DNS.hs

   1 -- | Helpers to perform DNS queries.
   2 module DNS (
   3   Domain,
   4   lookup_ptrs
   5   )
   6 where
   7
   8 import qualified  Data.ByteString.Char8 as BS (
   9   append,
  10   intercalate,
  11   pack,
  12   split )
  13 import Network.DNS (
  14   Domain,
  15   ResolvConf(..),
  16   defaultResolvConf,
  17   lookupPTR,
  18   makeResolvSeed,
  19   withResolver
  20   )
  21
  22
  23 -- | Convert the given IP address (as a ByteString) to the format
  24 --   required for a PTR lookup. For example, "192.168.0.0" should be
  25 --   converted to "0.0.168.192.in-addr.arpa".
  26 ip_to_in_addr_arpa :: Domain -> Domain
  27 ip_to_in_addr_arpa ip =
  28   rev_ip `BS.append` suffix
  29   where
  30     dot = BS.pack "."
  31     suffix = BS.pack ".in-addr.arpa"
  32     rev_ip = BS.intercalate dot (reverse (BS.split '.' ip))
  33
  34 -- | Take the default ResolvConf and increase the timeout to 15
  35 --   seconds.
  36 our_resolv_conf :: ResolvConf
  37 our_resolv_conf =
  38   defaultResolvConf { resolvTimeout = 15*1000*1000 } -- 15s
  39
  40
  41 -- | Takes a list of IP addresses (as ByteStrings) and performs
  42 --   reverse (PTR) lookups on each of them.
  43 lookup_ptrs :: [Domain] -> IO [Maybe [Domain]]
  44 lookup_ptrs ips = do
  45   rs <- makeResolvSeed our_resolv_conf
  46   withResolver rs $ \resolver ->
  47     mapM (lookupPTR resolver) in_addrs
  48   where
  49     in_addrs = map ip_to_in_addr_arpa ips