X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FMain.hs;h=70fa2f57c842ebb34c96e2e268070065b2488530;hp=a5dc79466067f0dc70fc529169f55d111ae13b96;hb=e862342c38e41176a7ab300b6d7ed03cf0ffd6b2;hpb=689bda2499ec821772b456cb7982527d6740649f diff --git a/src/Main.hs b/src/Main.hs index a5dc794..70fa2f5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,7 +2,7 @@ module Main where import Control.Concurrent.ParallelIO.Global ( - parallel, + parallelInterleaved, stopGlobalPool ) import Control.Monad (unless) import qualified Data.ByteString.Char8 as BS ( @@ -17,6 +17,8 @@ import Network.DNS ( ResolvConf(resolvInfo, resolvTimeout), defaultResolvConf, makeResolvSeed, + normalize, + normalizeCase, withResolver ) import System.Exit (ExitCode(..), exitWith) import System.IO (hPutStrLn, stderr) @@ -27,8 +29,6 @@ import DNS ( LookupResult, lookupMX', lookupNS', - normalize, - normalize_case, resolve_address ) import ExitCodes (exit_bad_server) import Timeout (Timeout(..)) @@ -81,7 +81,7 @@ main = do let normalize_function = if (no_append_root cfg) - then normalize_case + then normalizeCase else normalize -- Normalize the given names and delegates @@ -113,10 +113,17 @@ main = do NS{} -> lookupNS' MX{} -> lookupMX' - _ <- withResolver rs $ \resolver -> do - -- Bad stuff happens if we try to run these lookups in parallel - -- instead of the reports. - records <- mapM (lookup_function resolver) nrml_domains - parallel (map (report nrml_delegates) records) + let lookup' d = withResolver rs $ \resolver -> + lookup_function resolver d + + -- Construct a list of [IO whatever]. The withResolver calls + -- are the ones that should be run in parallel. + let actions = map lookup' nrml_domains + + -- Run the lookup actions in parallel. + results <- parallelInterleaved actions + + -- Output the results. + _ <- mapM (report nrml_delegates) results stopGlobalPool