X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FMain.hs;h=c93697a0c7d565e431201a56c7d851e10d1f4f2e;hp=3e8d8c09c92021dcd05210a336e46703eb9a552f;hb=3f25fc286646f24a1f40e0acda74a6907d2f08f9;hpb=80ae5c930e028d0fd5ec1afb76cf10327ab6bd0e diff --git a/src/Main.hs b/src/Main.hs index 3e8d8c0..c93697a 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,9 +9,9 @@ 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 ( + DNSError(NameError), Domain, FileOrNumericHost(RCHostName), ResolvConf(resolvInfo, resolvTimeout), @@ -20,18 +20,19 @@ 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 @@ -52,15 +53,18 @@ report :: [Domain] -- ^ The list of @delgts@ -> LookupResult -> IO () --- If the lookup resulted in a DNS error, we just ignore the whole --- thing. -report _ _ (_, Left _) = return () - -- If the lookup succeeded but there were no results, report that the --- domain is not delegated. -report _ _ (d, Right []) = +-- domain is not delegated. Note that the behavior of the DNS library +-- changed with regard to this at some point: we used to get back +-- a "success," but with an empty list of results. Now a NameError +-- (which is not actually an error!) is returned. +report _ _ (d, Left NameError) = putStrLn $ "Domain " ++ (show d) ++ " not delegated." +-- If the lookup resulted in some other DNS error, we just ignore the +-- whole thing. +report _ _ (_, Left _) = return () + -- Otherwise, subtract our delegates from the list of results and -- report the leftovers. report delgts normalize_function (d, Right raw_hosts) = do @@ -71,6 +75,11 @@ report delgts normalize_function (d, Right raw_hosts) = do (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 () @@ -113,7 +122,7 @@ main = do -- Set the timeout from the command line. The resolvTimeout field is -- in microseconds, so we multiply by one million. - let a_million = 1000 * 1000 + let a_million = 1000 * 1000 :: Int let rc = rc' { resolvTimeout = a_million * seconds (timeout cfg) } rs <- makeResolvSeed rc