Get it working for NS records.
[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 lookupNS,
20 makeResolvSeed,
21 withResolver )
22
23 import CommandLine (Args(..), get_args)
24 import DNS (normalize)
25
26 report :: (Domain, Maybe [Domain]) -> IO ()
27 report (d, Nothing) =
28 putStrLn $ "Domain " ++ (show d) ++ " not delegated."
29 report (d, Just leftovers) =
30 if null leftovers
31 then return ()
32 else putStrLn $ "Domain " ++
33 (show d) ++
34 " delegates somewhere else: " ++
35 (join " " (map show leftovers))
36
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)
43
44
45 main :: IO ()
46 main = do
47 cfg <- get_args
48
49 -- This reads stdin.
50 input <- BS.getContents
51
52 -- Split the input on any whitespace characters.
53 let raw_domains = BS.words input
54
55 -- Convert these to ByteStrings.
56 let raw_delegates = map BS.pack (delegates cfg)
57
58 -- Normalize the given names and delegates
59 let nrml_domains = map normalize raw_domains
60 let nrml_delegates = map normalize raw_delegates
61
62 let rc = case (server cfg) of
63 Nothing -> defaultResolvConf
64 Just s -> defaultResolvConf { resolvInfo = RCHostName s }
65
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))
70
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
75
76 _ <- case cfg of
77 (NS _ _) ->
78 -- We're only checking NS records, so report what we found.
79 parallel (map report cdns)
80 (MX _ _) ->
81 return [()]
82
83 stopGlobalPool