src/DNS.hs

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