4da383352360ee4a37a552805a5da88897c27c4f
[haeredes.git] / src / Main.hs
1 module Main
2 where
3
4 import Control.Concurrent.ParallelIO.Global (
5 parallel,
6 stopGlobalPool )
7 import Control.Monad (unless)
8 import qualified Data.ByteString.Char8 as BS (
9 getContents,
10 pack,
11 words )
12 import Data.List ((\\))
13 import Data.String.Utils (join)
14
15 import Network.DNS (
16 Domain,
17 FileOrNumericHost(RCHostName),
18 ResolvConf(resolvInfo),
19 defaultResolvConf,
20 makeResolvSeed,
21 withResolver )
22
23 import CommandLine (Args(..), get_args)
24 import DNS (
25 LookupResult,
26 lookupMX',
27 lookupNS',
28 normalize )
29
30 report :: (Domain, Maybe [Domain]) -> IO ()
31 report (d, Nothing) =
32 putStrLn $ "Domain " ++ (show d) ++ " not delegated."
33 report (d, Just leftovers) =
34 unless (null leftovers) $
35 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