First iteration that does anything.

[haeredes.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index b141e302f8298e50ef10600616b3084b64cc6c18..142ace670cf62d4a83796c431185d5af2eeb891f 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,6 +1,68 @@
 module Main
 where
 
+import qualified Data.ByteString.Char8 as BS (pack)
+import Data.List ((\\))
+import Data.String.Utils (join, splitWs)
+
+import Network.DNS (
+  Domain,
+  FileOrNumericHost(RCHostName),
+  ResolvConf(resolvInfo),
+  defaultResolvConf,
+  lookupNS,
+  makeResolvSeed,
+  withResolver
+  )
+
+import System.IO (hGetContents, stdin)
+
+import CommandLine (Args(..), Delegates(..), get_args)
+
+report :: (Domain, Maybe [Domain]) -> IO ()
+report (d, Nothing) =
+  putStrLn $ "Domain " ++ (show d) ++ " not delegated."
+report (d, Just leftovers) =
+  if null leftovers
+  then return ()
+  else putStrLn $ "Domain " ++
+                  (show d) ++
+                  " delegates somewhere else: " ++
+                  (join " " (map show leftovers))
+
+clean :: Delegates -> (Domain, Maybe [Domain]) -> (Domain, Maybe [Domain])
+clean _ p@(_, Nothing) = p
+clean (Delegates ds') (d, Just targets) =
+  (d, Just $ targets \\ ds)
+  where
+    ds = map BS.pack ds'
+
 main :: IO ()
 main = do
-  putStrLn "Hello, World."
+  cfg <- get_args
+  print cfg
+  input <- hGetContents stdin
+
+  -- Split the input on any whitespace characters.
+  let domains' = splitWs input
+
+  -- Convert those Strings to ByteStrings
+  let domains  = map BS.pack domains'
+
+  let rc = case (server cfg) of
+             Nothing -> defaultResolvConf
+             Just s -> defaultResolvConf { resolvInfo = RCHostName s }
+
+  rs <- makeResolvSeed rc
+  withResolver rs $ \resolver -> do
+    -- This function keeps the domain matches with its NS records.
+    let lookupNS' = \d -> (lookupNS resolver d) >>= (return . ((,) d))
+    domains_ns <- mapM lookupNS' domains
+    let cdns = map (clean (delegates cfg)) domains_ns
+
+    case cfg of
+      (NS _ _) ->
+        -- We're only checking NS records, so report what we found.
+        mapM_ report cdns
+      (MX _ _) ->
+        print "Hello, world."