src/Main.hs

   1 module Main
   2 where
   3
   4 import qualified Data.ByteString.Char8 as BS (pack)
   5 import Data.List ((\\))
   6 import Data.String.Utils (join, splitWs)
   7
   8 import Network.DNS (
   9   Domain,
  10   FileOrNumericHost(RCHostName),
  11   ResolvConf(resolvInfo),
  12   defaultResolvConf,
  13   lookupNS,
  14   makeResolvSeed,
  15   withResolver
  16   )
  17
  18 import System.IO (hGetContents, stdin)
  19
  20 import CommandLine (Args(..), Delegates(..), get_args)
  21
  22 report :: (Domain, Maybe [Domain]) -> IO ()
  23 report (d, Nothing) =
  24   putStrLn $ "Domain " ++ (show d) ++ " not delegated."
  25 report (d, Just leftovers) =
  26   if null leftovers
  27   then return ()
  28   else putStrLn $ "Domain " ++
  29                   (show d) ++
  30                   " delegates somewhere else: " ++
  31                   (join " " (map show leftovers))
  32
  33 clean :: Delegates -> (Domain, Maybe [Domain]) -> (Domain, Maybe [Domain])
  34 clean _ p@(_, Nothing) = p
  35 clean (Delegates ds') (d, Just targets) =
  36   (d, Just $ targets \\ ds)
  37   where
  38     ds = map BS.pack ds'
  39
  40 main :: IO ()
  41 main = do
  42   cfg <- get_args
  43   print cfg
  44   input <- hGetContents stdin
  45
  46   -- Split the input on any whitespace characters.
  47   let domains' = splitWs input
  48
  49   -- Convert those Strings to ByteStrings
  50   let domains  = map BS.pack domains'
  51
  52   let rc = case (server cfg) of
  53              Nothing -> defaultResolvConf
  54              Just s -> defaultResolvConf { resolvInfo = RCHostName s }
  55
  56   rs <- makeResolvSeed rc
  57   withResolver rs $ \resolver -> do
  58     -- This function keeps the domain matches with its NS records.
  59     let lookupNS' = \d -> (lookupNS resolver d) >>= (return . ((,) d))
  60     domains_ns <- mapM lookupNS' domains
  61     let cdns = map (clean (delegates cfg)) domains_ns
  62
  63     case cfg of
  64       (NS _ _) ->
  65         -- We're only checking NS records, so report what we found.
  66         mapM_ report cdns
  67       (MX _ _) ->
  68         print "Hello, world."