X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FMain.hs;h=142ace670cf62d4a83796c431185d5af2eeb891f;hp=b141e302f8298e50ef10600616b3084b64cc6c18;hb=825753e2731b8491d93d9f2d66b457fe31b1c763;hpb=e5168c9d5f32912d4e77713935e8c09a468bfd01 diff --git a/src/Main.hs b/src/Main.hs index b141e30..142ace6 100644 --- 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."