Fix parallelism so that it actually happens.
Bump version to 0.0.5.
cabal-version: >= 1.8
author: Michael Orlitzky
maintainer: Michael Orlitzky <michael@orlitzky.com>
cabal-version: >= 1.8
author: Michael Orlitzky
maintainer: Michael Orlitzky <michael@orlitzky.com>
build-depends:
base >= 4.6 && < 4.7,
bytestring == 0.10.*,
build-depends:
base >= 4.6 && < 4.7,
bytestring == 0.10.*,
HUnit == 1.2.*,
QuickCheck == 2.6.*,
MissingH == 1.2.*,
HUnit == 1.2.*,
QuickCheck == 2.6.*,
MissingH == 1.2.*,
build-depends:
base >= 4.6 && < 4.7,
bytestring == 0.10.*,
build-depends:
base >= 4.6 && < 4.7,
bytestring == 0.10.*,
HUnit == 1.2.*,
QuickCheck == 2.6.*,
MissingH == 1.2.*,
HUnit == 1.2.*,
QuickCheck == 2.6.*,
MissingH == 1.2.*,
-- | Helpers to perform DNS queries.
module DNS (
Domain,
-- | Helpers to perform DNS queries.
module DNS (
Domain,
+ PTRResult,
+ lookup_ptrs )
+import Control.Concurrent.ParallelIO.Global ( parallel )
import qualified Data.ByteString.Char8 as BS (
append,
intercalate,
import qualified Data.ByteString.Char8 as BS (
append,
intercalate,
split )
import Network.DNS (
Domain,
split )
import Network.DNS (
Domain,
ResolvConf(..),
defaultResolvConf,
lookupPTR,
makeResolvSeed,
ResolvConf(..),
defaultResolvConf,
lookupPTR,
makeResolvSeed,
+ withResolver )
+
+
+-- The return type of lookupPTR.
+type PTRResult = Either DNSError [Domain]
-- | Convert the given IP address (as a ByteString) to the format
-- | Convert the given IP address (as a ByteString) to the format
-- | Takes a list of IP addresses (as ByteStrings) and performs
-- reverse (PTR) lookups on each of them.
-- | 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
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
where
in_addrs = map ip_to_in_addr_arpa ips
-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)
import Control.Monad (unless, when)
import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack)
import Data.List ((\\), intercalate)
Mode(..),
parse_errors,
parse_mode )
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 ()
import ExitCodes ( exit_args_parse_failed, exit_invalid_cidr )
import Octet ()
-- max values.
-- 4. Join the regexes from step 3 with regexes matching periods.
-- 5. Stick an address boundary on either side of the result.
-- 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])
cidr_to_regex :: Cidr.Cidr -> String
cidr_to_regex cidr =
addr_barrier (intercalate "\\." [range1, range2, range3, range4])
let addr_bytestrings = map (BS.pack . show) addrs
ptrs <- lookup_ptrs addr_bytestrings
let pairs = zip addr_bytestrings ptrs
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
- 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 =
(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