]> gitweb.michael.orlitzky.com - hath.git/blobdiff - src/DNS.hs
Bump the version number to 0.0.4 in hath.cabal.
[hath.git] / src / DNS.hs
diff --git a/src/DNS.hs b/src/DNS.hs
new file mode 100644 (file)
index 0000000..e1c4e51
--- /dev/null
@@ -0,0 +1,49 @@
+-- | Helpers to perform DNS queries.
+module DNS (
+  Domain,
+  lookup_ptrs
+  )
+where
+
+import qualified  Data.ByteString.Char8 as BS (
+  append,
+  intercalate,
+  pack,
+  split )
+import Network.DNS (
+  Domain,
+  ResolvConf(..),
+  defaultResolvConf,
+  lookupPTR,
+  makeResolvSeed,
+  withResolver
+  )
+
+
+-- | Convert the given IP address (as a ByteString) to the format
+--   required for a PTR lookup. For example, "192.168.0.0" should be
+--   converted to "0.0.168.192.in-addr.arpa".
+ip_to_in_addr_arpa :: Domain -> Domain
+ip_to_in_addr_arpa ip =
+  rev_ip `BS.append` suffix
+  where
+    dot = BS.pack "."
+    suffix = BS.pack ".in-addr.arpa"
+    rev_ip = BS.intercalate dot (reverse (BS.split '.' ip))
+
+-- | Take the default ResolvConf and increase the timeout to 15
+--   seconds.
+our_resolv_conf :: ResolvConf
+our_resolv_conf =
+  defaultResolvConf { resolvTimeout = 15*1000*1000 } -- 15s
+
+
+-- | Takes a list of IP addresses (as ByteStrings) and performs
+--   reverse (PTR) lookups on each of them.
+lookup_ptrs :: [Domain] -> IO [Maybe [Domain]]
+lookup_ptrs ips = do
+  rs <- makeResolvSeed our_resolv_conf
+  withResolver rs $ \resolver ->
+    mapM (lookupPTR resolver) in_addrs
+  where
+    in_addrs = map ip_to_in_addr_arpa ips