X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FMain.hs;h=89d2cd56d1a2aeaca07420d403e2e29da1e7abfe;hp=70fa2f57c842ebb34c96e2e268070065b2488530;hb=8107db78784648b609c70f1d448764fc6c22f0ef;hpb=e862342c38e41176a7ab300b6d7ed03cf0ffd6b2 diff --git a/src/Main.hs b/src/Main.hs index 70fa2f5..89d2cd5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,4 @@ -module Main +module Main (main) where import Control.Concurrent.ParallelIO.Global ( @@ -9,8 +9,7 @@ import qualified Data.ByteString.Char8 as BS ( getContents, pack, words ) -import Data.List ((\\)) -import Data.String.Utils (join) +import Data.List ( (\\), intersperse ) import Network.DNS ( Domain, FileOrNumericHost(RCHostName), @@ -20,50 +19,63 @@ import Network.DNS ( normalize, normalizeCase, withResolver ) -import System.Exit (ExitCode(..), exitWith) +import System.Exit (ExitCode(ExitFailure), exitWith) import System.IO (hPutStrLn, stderr) - -import CommandLine (Args(..), get_args) +import CommandLine ( + Args(NS,MX,delegates,no_append_root,server,timeout), + get_args) import DNS ( LookupResult, lookupMX', lookupNS', resolve_address ) import ExitCodes (exit_bad_server) -import Timeout (Timeout(..)) +import Timeout (Timeout(seconds)) -- | Given a list of delegates, report results for this --- LookupResult. +-- 'LookupResult'. -- -- If there's an empty list in the second component, there were no -- query results, so we report that the domain was not delegated. If -- there were some results and there are leftovers (after removing -- the delegates), we report those as well. -- +-- Before processing, all names are normalized using the supplied +-- function @normalize_function@. Ideally this should be the same +-- function applied to the user-input names. +-- report :: [Domain] -- ^ The list of @delgts@ + -> (Domain -> Domain) -- ^ Domain name normalization function, + -- @normalize_function@. -> LookupResult -> IO () -- If the lookup resulted in a DNS error, we just ignore the whole -- thing. -report _ (_, Left _) = return () +report _ _ (_, Left _) = return () -- If the lookup succeeded but there were no results, report that the -- domain is not delegated. -report _ (d, Right []) = +report _ _ (d, Right []) = putStrLn $ "Domain " ++ (show d) ++ " not delegated." -- Otherwise, subtract our delegates from the list of results and -- report the leftovers. -report delgts (d, Right hosts) = do - let leftovers = hosts \\ delgts +report delgts normalize_function (d, Right raw_hosts) = do + let nrml_hosts = map normalize_function raw_hosts + let leftovers = nrml_hosts \\ delgts unless (null leftovers) $ putStrLn $ "Domain " ++ (show d) ++ " delegates somewhere else: " ++ (join " " (map show leftovers)) + where + -- Create one big string by joining together a list of smaller + -- strings and placing a delimiter between them. + join :: String -> [String] -> String + join delimiter strings = concat (intersperse delimiter strings) main :: IO () @@ -106,7 +118,8 @@ main = do -- Set the timeout from the command line. The resolvTimeout field is -- in microseconds, so we multiply by one million. - let rc = rc' { resolvTimeout = 1000 * 1000 * seconds (timeout cfg) } + let a_million = 1000 * 1000 :: Int + let rc = rc' { resolvTimeout = a_million * seconds (timeout cfg) } rs <- makeResolvSeed rc let lookup_function = case cfg of @@ -124,6 +137,6 @@ main = do results <- parallelInterleaved actions -- Output the results. - _ <- mapM (report nrml_delegates) results + _ <- mapM (report nrml_delegates normalize_function) results stopGlobalPool