X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FMain.hs;h=0c215b758a59501b6d4c8bd049a5dd4cab53e9ee;hp=d425734c275404e24310edb650ac33c9b4fe0b67;hb=fa4220513eb9d2036c3db0cc9c518c6346050318;hpb=70dffd6160208adf2c1c5746924c100cb0ffcb2e diff --git a/src/Main.hs b/src/Main.hs index d425734..0c215b7 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -16,12 +16,15 @@ import Network.DNS ( FileOrNumericHost(RCHostName), ResolvConf(resolvInfo), defaultResolvConf, - lookupNS, makeResolvSeed, withResolver ) import CommandLine (Args(..), get_args) -import DNS (normalize) +import DNS ( + LookupResult, + lookupMX', + lookupNS', + normalize ) report :: (Domain, Maybe [Domain]) -> IO () report (d, Nothing) = @@ -35,11 +38,12 @@ report (d, Just leftovers) = (join " " (map show leftovers)) clean :: [Domain] -- ^ List of delegates, @ds@ - -> (Domain, Maybe [Domain]) -- ^ Pairs of (domain name, lookup result) - -> (Domain, Maybe [Domain]) + -> LookupResult + -> LookupResult clean _ p@(_, Nothing) = p -clean ds (d, Just targets) = - (d, Just $ targets \\ ds) +clean delgts (d, Just targets) = + (d, Just $ targets \\ delgts) + main :: IO () @@ -64,20 +68,16 @@ main = do 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)) - - -- Bad stuff happens if we try to run these lookups in parallel - -- instead of the reports. - domains_ns <- mapM lookupNS' nrml_domains - let cdns = map (clean nrml_delegates) domains_ns - - _ <- case cfg of - (NS _ _) -> - -- We're only checking NS records, so report what we found. - parallel (map report cdns) - (MX _ _) -> - return [()] - - stopGlobalPool + + 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