0c215b758a59501b6d4c8bd049a5dd4cab53e9ee
[haeredes.git] / src / Main.hs
1 module Main
2 where
3
4 import Control.Concurrent.ParallelIO.Global (
5 parallel,
6 stopGlobalPool )
7 import qualified Data.ByteString.Char8 as BS (
8 getContents,
9 pack,
10 words )
11 import Data.List ((\\))
12 import Data.String.Utils (join)
13
14 import Network.DNS (
15 Domain,
16 FileOrNumericHost(RCHostName),
17 ResolvConf(resolvInfo),
18 defaultResolvConf,
19 makeResolvSeed,
20 withResolver )
21
22 import CommandLine (Args(..), get_args)
23 import DNS (
24 LookupResult,
25 lookupMX',
26 lookupNS',
27 normalize )
28
29 report :: (Domain, Maybe [Domain]) -> IO ()
30 report (d, Nothing) =
31 putStrLn $ "Domain " ++ (show d) ++ " not delegated."
32 report (d, Just leftovers) =
33 if null leftovers
34 then return ()
35 else putStrLn $ "Domain " ++
36 (show d) ++
37 " delegates somewhere else: " ++
38 (join " " (map show leftovers))
39
40 clean :: [Domain] -- ^ List of delegates, @ds@
41 -> LookupResult
42 -> LookupResult
43 clean _ p@(_, Nothing) = p
44 clean delgts (d, Just targets) =
45 (d, Just $ targets \\ delgts)
46
47
48
49 main :: IO ()
50 main = do
51 cfg <- get_args
52
53 -- This reads stdin.
54 input <- BS.getContents
55
56 -- Split the input on any whitespace characters.
57 let raw_domains = BS.words input
58
59 -- Convert these to ByteStrings.
60 let raw_delegates = map BS.pack (delegates cfg)
61
62 -- Normalize the given names and delegates
63 let nrml_domains = map normalize raw_domains
64 let nrml_delegates = map normalize raw_delegates
65
66 let rc = case (server cfg) of
67 Nothing -> defaultResolvConf
68 Just s -> defaultResolvConf { resolvInfo = RCHostName s }
69
70 rs <- makeResolvSeed rc
71
72 let lookup_function = case cfg of
73 (NS _ _) -> lookupNS'
74 (MX _ _) -> lookupMX'
75
76 _ <- withResolver rs $ \resolver -> do
77 -- Bad stuff happens if we try to run these lookups in parallel
78 -- instead of the reports.
79 records <- mapM (lookup_function resolver) nrml_domains
80 let cleaned_records = map (clean nrml_delegates) records
81 parallel (map report cleaned_records)
82
83 stopGlobalPool