4 import Control.Concurrent.ParallelIO.Global (
7 import Control.Monad (unless)
8 import qualified Data.ByteString.Char8 as BS (
12 import Data.List ((\\))
13 import Data.String.Utils (join)
16 FileOrNumericHost(RCHostName),
17 ResolvConf(resolvInfo),
21 import System.Exit (ExitCode(..), exitWith)
22 import System.IO (hPutStrLn, stderr)
25 import CommandLine (Args(..), get_args)
32 import ExitCodes (exit_bad_server)
34 report :: (Domain, Maybe [Domain]) -> IO ()
36 putStrLn $ "Domain " ++ (show d) ++ " not delegated."
37 report (d, Just leftovers) =
38 unless (null leftovers) $
39 putStrLn $ "Domain " ++
41 " delegates somewhere else: " ++
42 (join " " (map show leftovers))
44 clean :: [Domain] -- ^ List of delegates, @ds@
47 clean _ p@(_, Nothing) = p
48 clean delgts (d, Just targets) =
49 (d, Just $ targets \\ delgts)
58 input <- BS.getContents
60 -- Split the input on any whitespace characters.
61 let raw_domains = BS.words input
63 -- Convert these to ByteStrings.
64 let raw_delegates = map BS.pack (delegates cfg)
66 -- Normalize the given names and delegates
67 let nrml_domains = map normalize raw_domains
68 let nrml_delegates = map normalize raw_delegates
70 rc <- case (server cfg) of
71 Nothing -> return defaultResolvConf
73 s' <- resolve_address s
76 hPutStrLn stderr ("Bad DNS server or lookup error: " ++ s)
77 exitWith (ExitFailure exit_bad_server)
79 return $ defaultResolvConf { resolvInfo =
80 RCHostName (show s'') }
82 rs <- makeResolvSeed rc
84 let lookup_function = case cfg of
88 _ <- withResolver rs $ \resolver -> do
89 -- Bad stuff happens if we try to run these lookups in parallel
90 -- instead of the reports.
91 records <- mapM (lookup_function resolver) nrml_domains
92 let cleaned_records = map (clean nrml_delegates) records
93 parallel (map report cleaned_records)