4 import Control.Concurrent.ParallelIO.Global (
7 import qualified Data.ByteString.Char8 as BS (
11 import Data.List ((\\))
12 import Data.String.Utils (join)
16 FileOrNumericHost(RCHostName),
17 ResolvConf(resolvInfo),
23 import CommandLine (Args(..), get_args)
24 import DNS (normalize)
26 report :: (Domain, Maybe [Domain]) -> IO ()
28 putStrLn $ "Domain " ++ (show d) ++ " not delegated."
29 report (d, Just leftovers) =
32 else putStrLn $ "Domain " ++
34 " delegates somewhere else: " ++
35 (join " " (map show leftovers))
37 clean :: [Domain] -- ^ List of delegates, @ds@
38 -> (Domain, Maybe [Domain]) -- ^ Pairs of (domain name, lookup result)
39 -> (Domain, Maybe [Domain])
40 clean _ p@(_, Nothing) = p
41 clean ds (d, Just targets) =
42 (d, Just $ targets \\ ds)
50 input <- BS.getContents
52 -- Split the input on any whitespace characters.
53 let raw_domains = BS.words input
55 -- Convert these to ByteStrings.
56 let raw_delegates = map BS.pack (delegates cfg)
58 -- Normalize the given names and delegates
59 let nrml_domains = map normalize raw_domains
60 let nrml_delegates = map normalize raw_delegates
62 let rc = case (server cfg) of
63 Nothing -> defaultResolvConf
64 Just s -> defaultResolvConf { resolvInfo = RCHostName s }
66 rs <- makeResolvSeed rc
67 withResolver rs $ \resolver -> do
68 -- This function keeps the domain matches with its NS records.
69 let lookupNS' = \d -> (lookupNS resolver d) >>= (return . ((,) d))
71 -- Bad stuff happens if we try to run these lookups in parallel
72 -- instead of the reports.
73 domains_ns <- mapM lookupNS' nrml_domains
74 let cdns = map (clean nrml_delegates) domains_ns
78 -- We're only checking NS records, so report what we found.
79 parallel (map report cdns)