From: Michael Orlitzky Date: Tue, 8 Oct 2013 02:42:33 +0000 (-0400) Subject: Bump dns dependency to 1.*, and update DNS module. X-Git-Tag: 0.0.5 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=fc58ff96c81d448e2c88376a2bc83cdfae1ccdc0;p=hath.git Bump dns dependency to 1.*, and update DNS module. Fix parallelism so that it actually happens. Bump version to 0.0.5. --- diff --git a/hath.cabal b/hath.cabal index 5c2b9a2..e6f5395 100644 --- a/hath.cabal +++ b/hath.cabal @@ -1,5 +1,5 @@ name: hath -version: 0.0.4 +version: 0.0.5 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky @@ -98,7 +98,7 @@ executable hath build-depends: base >= 4.6 && < 4.7, bytestring == 0.10.*, - dns == 0.3.*, + dns == 1.*, HUnit == 1.2.*, QuickCheck == 2.6.*, MissingH == 1.2.*, @@ -155,7 +155,7 @@ test-suite testsuite build-depends: base >= 4.6 && < 4.7, bytestring == 0.10.*, - dns == 0.3.*, + dns == 1.*, HUnit == 1.2.*, QuickCheck == 2.6.*, MissingH == 1.2.*, diff --git a/src/DNS.hs b/src/DNS.hs index e1c4e51..041eeeb 100644 --- a/src/DNS.hs +++ b/src/DNS.hs @@ -1,10 +1,11 @@ -- | Helpers to perform DNS queries. module DNS ( Domain, - lookup_ptrs - ) + PTRResult, + lookup_ptrs ) where +import Control.Concurrent.ParallelIO.Global ( parallel ) import qualified Data.ByteString.Char8 as BS ( append, intercalate, @@ -12,12 +13,16 @@ import qualified Data.ByteString.Char8 as BS ( split ) import Network.DNS ( Domain, + DNSError, ResolvConf(..), defaultResolvConf, lookupPTR, makeResolvSeed, - withResolver - ) + withResolver ) + + +-- The return type of lookupPTR. +type PTRResult = Either DNSError [Domain] -- | Convert the given IP address (as a ByteString) to the format @@ -40,10 +45,13 @@ our_resolv_conf = -- | Takes a list of IP addresses (as ByteStrings) and performs -- reverse (PTR) lookups on each of them. -lookup_ptrs :: [Domain] -> IO [Maybe [Domain]] +lookup_ptrs :: [Domain] -> IO [PTRResult] lookup_ptrs ips = do rs <- makeResolvSeed our_resolv_conf - withResolver rs $ \resolver -> - mapM (lookupPTR resolver) in_addrs + let lookup' addr = withResolver rs $ \resolver -> + lookupPTR resolver addr + + parallel $ map lookup' in_addrs + where in_addrs = map ip_to_in_addr_arpa ips diff --git a/src/Main.hs b/src/Main.hs index f567400..5afadcd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,9 +1,7 @@ module Main where -import Control.Concurrent.ParallelIO.Global ( - parallel, - stopGlobalPool ) +import Control.Concurrent.ParallelIO.Global ( stopGlobalPool ) import Control.Monad (unless, when) import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack) import Data.List ((\\), intercalate) @@ -32,7 +30,7 @@ import CommandLine ( Mode(..), parse_errors, parse_mode ) -import DNS (Domain, lookup_ptrs) +import DNS (Domain, PTRResult, lookup_ptrs) import ExitCodes ( exit_args_parse_failed, exit_invalid_cidr ) import Octet () @@ -58,6 +56,7 @@ addr_barrier x = non_addr_char ++ x ++ non_addr_char -- max values. -- 4. Join the regexes from step 3 with regexes matching periods. -- 5. Stick an address boundary on either side of the result. +-- cidr_to_regex :: Cidr.Cidr -> String cidr_to_regex cidr = addr_barrier (intercalate "\\." [range1, range2, range3, range4]) @@ -155,18 +154,17 @@ main = do let addr_bytestrings = map (BS.pack . show) addrs ptrs <- lookup_ptrs addr_bytestrings let pairs = zip addr_bytestrings ptrs - _ <- parallel (map (putStrLn . show_pair) pairs) - return () + mapM_ (putStrLn . show_pair) pairs stopGlobalPool where - show_pair :: (Domain, Maybe [Domain]) -> String - show_pair (s, mds) = + show_pair :: (Domain, PTRResult) -> String + show_pair (s, eds) = (BS.unpack s) ++ ": " ++ results where space = BS.pack " " results = - case mds of - Nothing -> "" - Just ds -> BS.unpack $ BS.intercalate space ds + case eds of + Left err -> "ERROR (" ++ (show err) ++ ")" + Right ds -> BS.unpack $ BS.intercalate space ds