module Main where import Control.Concurrent.ParallelIO.Global ( parallel, stopGlobalPool ) import Control.Monad (unless) import qualified Data.ByteString.Char8 as BS ( getContents, pack, words ) import Data.List ((\\)) import Data.String.Utils (join) import Network.DNS ( Domain, FileOrNumericHost(RCHostName), ResolvConf(resolvInfo), defaultResolvConf, makeResolvSeed, withResolver ) import System.Exit (ExitCode(..), exitWith) import System.IO (hPutStrLn, stderr) import CommandLine (Args(..), get_args) import DNS ( LookupResult, lookupMX', lookupNS', normalize, resolve_address ) import ExitCodes (exit_bad_server) report :: (Domain, Maybe [Domain]) -> IO () report (d, Nothing) = putStrLn $ "Domain " ++ (show d) ++ " not delegated." report (d, Just leftovers) = unless (null leftovers) $ putStrLn $ "Domain " ++ (show d) ++ " delegates somewhere else: " ++ (join " " (map show leftovers)) clean :: [Domain] -- ^ List of delegates, @ds@ -> LookupResult -> LookupResult clean _ p@(_, Nothing) = p clean delgts (d, Just targets) = (d, Just $ targets \\ delgts) main :: IO () main = do cfg <- get_args -- This reads stdin. input <- BS.getContents -- Split the input on any whitespace characters. let raw_domains = BS.words input -- Convert these to ByteStrings. let raw_delegates = map BS.pack (delegates cfg) -- Normalize the given names and delegates let nrml_domains = map normalize raw_domains let nrml_delegates = map normalize raw_delegates rc <- case (server cfg) of Nothing -> return defaultResolvConf Just s -> do s' <- resolve_address s case s' of Nothing -> do hPutStrLn stderr ("Bad DNS server or lookup error: " ++ s) exitWith (ExitFailure exit_bad_server) Just s'' -> return $ defaultResolvConf { resolvInfo = RCHostName (show s'') } rs <- makeResolvSeed rc let lookup_function = case cfg of (NS _ _) -> lookupNS' (MX _ _) -> lookupMX' _ <- withResolver rs $ \resolver -> do -- Bad stuff happens if we try to run these lookups in parallel -- instead of the reports. records <- mapM (lookup_function resolver) nrml_domains let cleaned_records = map (clean nrml_delegates) records parallel (map report cleaned_records) stopGlobalPool