From 942b8ef3bc5830ca0defa62342d55550aea59934 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 17 Aug 2013 17:25:52 -0400 Subject: [PATCH] Bump the version number to 0.0.4 in hath.cabal. Add two new modes: 'List' and 'Reversed' to list and perform a PTR lookup on a CIDR's addresses respectively. Add a .ghci file which loads some modules automatically. Add Bounded and Enum instances for Bit, Octet, IPv4Address. Add some tests for the new functionality. --- .ghci | 13 +++++ hath.cabal | 11 +++- src/Bit.hs | 13 ++++- src/Cidr.hs | 4 +- src/CommandLine.hs | 61 ++++++++++++++-------- src/DNS.hs | 49 ++++++++++++++++++ src/IPv4Address.hs | 125 ++++++++++++++++++++++++++++++++++++++------- src/Main.hs | 48 +++++++++++++---- src/Octet.hs | 42 ++++++++++----- test/TestSuite.hs | 3 +- 10 files changed, 304 insertions(+), 65 deletions(-) create mode 100644 .ghci create mode 100644 src/DNS.hs diff --git a/.ghci b/.ghci new file mode 100644 index 0000000..c292dc4 --- /dev/null +++ b/.ghci @@ -0,0 +1,13 @@ +-- Set the include path. +:set -isrc + +-- Load the stuff we want to play with. +:{ +:load src/Bit.hs + src/Octet.hs + src/IPv4Address.hs + src/Cidr.hs + src/DNS.hs +:} + +:set prompt "hath> " diff --git a/hath.cabal b/hath.cabal index 4266c92..f495f7b 100644 --- a/hath.cabal +++ b/hath.cabal @@ -1,5 +1,5 @@ name: hath -version: 0.0.3 +version: 0.0.4 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky @@ -63,9 +63,12 @@ description: executable hath build-depends: base == 4.*, + bytestring == 0.10.*, + dns == 0.3.*, HUnit == 1.2.*, QuickCheck == 2.6.*, MissingH == 1.2.*, + parallel-io == 0.3.*, split == 0.2.*, test-framework == 0.8.*, test-framework-hunit == 0.3.*, @@ -81,12 +84,13 @@ executable hath Bit Cidr CommandLine + DNS ExitCodes IPv4Address Maskable Maskbits Octet - + ghc-options: -Wall -fwarn-hi-shadowing @@ -116,9 +120,12 @@ test-suite testsuite main-is: TestSuite.hs build-depends: base == 4.*, + bytestring == 0.10.*, + dns == 0.3.*, HUnit == 1.2.*, QuickCheck == 2.6.*, MissingH == 1.2.*, + parallel-io == 0.3.*, split == 0.2.*, test-framework == 0.8.*, test-framework-hunit == 0.3.*, diff --git a/src/Bit.hs b/src/Bit.hs index 5c8c5aa..e3d90e4 100644 --- a/src/Bit.hs +++ b/src/Bit.hs @@ -11,7 +11,7 @@ import Test.QuickCheck ( data Bit = Zero | One - deriving (Eq) + deriving (Enum, Eq) instance Show Bit where show Zero = "0" @@ -22,6 +22,17 @@ instance Arbitrary Bit where arbitrary = elements [ Zero, One ] +instance Ord Bit where + Zero <= Zero = True + Zero <= One = True + One <= Zero = False + One <= One = True + +instance Bounded Bit where + minBound = Zero + maxBound = One + + -- | Convert a Bit to an Int. bit_to_int :: Bit -> Int bit_to_int Zero = 0 diff --git a/src/Cidr.hs b/src/Cidr.hs index cdfef9a..e23ae6c 100644 --- a/src/Cidr.hs +++ b/src/Cidr.hs @@ -8,6 +8,7 @@ module Cidr combine_all, contains, contains_proper, + enumerate, max_octet1, max_octet2, max_octet3, @@ -254,7 +255,8 @@ adjacent cidr1 cidr2 mbits2 = maskbits cidr2 - +enumerate :: Cidr -> [IPv4Address] +enumerate cidr = [(min_host cidr)..(max_host cidr)] -- HUnit Tests diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 181eb6f..8ed8597 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -21,13 +21,25 @@ lowercase :: String -> String lowercase = map toLower --- | The application currently has four modes. The default, Regex, +-- | The application currently has six modes. The default, Regex, -- will compute a regular expression matching the input --- CIDRs. Reduce, on the other hand, will combine any --- redundant/adjacent CIDR blocks into one. Dupe will show you what --- would be removed by Reduce, and Diff will show both additions and --- deletions in a diff-like format. -data Mode = Regex | Reduce | Dupe | Diff +-- CIDRs. +-- +-- Reduce, on the other hand, will combine any redundant/adjacent +-- CIDR blocks into one. +-- +-- Dupe will show you what would be removed by Reduce. +-- +-- Diff will show both additions and deletions in a diff-like +-- format. +-- +-- List will enumerate the IP addresses contained within the input +-- CIDRs. +-- +-- Reverse will perform a reverse DNS (PTR) lookup on each IP +-- address contained within the input CIDRs. +-- +data Mode = Regex | Reduce | Dupe | Diff | List | Reverse -- | A record containing values for all available options. @@ -58,7 +70,7 @@ options = -- | Takes an Options as an argument, and sets its opt_help member to -- True. set_help :: Options -> IO Options -set_help opts = +set_help opts = return opts { opt_help = True } @@ -73,7 +85,12 @@ set_input arg opts = -- | The usage header. usage :: String -usage = "Usage: hath [regexed|reduced|duped|diffed] [-h] [-i FILE] " +usage = + "Usage: hath " ++ + "[regexed|reduced|duped|diffed|listed|reversed] " ++ + "[-h] " ++ + "[-i FILE] " ++ + "" -- | The usage header, and all available flags (as generated by GetOpt). @@ -100,21 +117,25 @@ parse_mode :: IO Mode parse_mode = do argv <- getArgs let (_, non_options, _) = getOpt Permute options argv - case non_options of + return $ case non_options of -- Default - [] -> return Regex - -- Some non-option was given, but were any of them modes? + [] -> Regex + -- Some non-option was given, but were any of them modes? (x:_) -> case (lowercase x) of - "regex" -> return Regex - "regexed" -> return Regex - "reduce" -> return Reduce - "reduced" -> return Reduce - "dupe" -> return Dupe - "duped" -> return Dupe - "diff" -> return Diff - "diffed" -> return Diff - _ -> return Regex + "regex" -> Regex + "regexed" -> Regex + "reduce" -> Reduce + "reduced" -> Reduce + "dupe" -> Dupe + "duped" -> Dupe + "diff" -> Diff + "diffed" -> Diff + "list" -> List + "listed" -> List + "reverse" -> Reverse + "reversed" -> Reverse + _ -> Regex diff --git a/src/DNS.hs b/src/DNS.hs new file mode 100644 index 0000000..e1c4e51 --- /dev/null +++ b/src/DNS.hs @@ -0,0 +1,49 @@ +-- | Helpers to perform DNS queries. +module DNS ( + Domain, + lookup_ptrs + ) +where + +import qualified Data.ByteString.Char8 as BS ( + append, + intercalate, + pack, + split ) +import Network.DNS ( + Domain, + ResolvConf(..), + defaultResolvConf, + lookupPTR, + makeResolvSeed, + withResolver + ) + + +-- | Convert the given IP address (as a ByteString) to the format +-- required for a PTR lookup. For example, "192.168.0.0" should be +-- converted to "0.0.168.192.in-addr.arpa". +ip_to_in_addr_arpa :: Domain -> Domain +ip_to_in_addr_arpa ip = + rev_ip `BS.append` suffix + where + dot = BS.pack "." + suffix = BS.pack ".in-addr.arpa" + rev_ip = BS.intercalate dot (reverse (BS.split '.' ip)) + +-- | Take the default ResolvConf and increase the timeout to 15 +-- seconds. +our_resolv_conf :: ResolvConf +our_resolv_conf = + defaultResolvConf { resolvTimeout = 15*1000*1000 } -- 15s + + +-- | 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 ips = do + rs <- makeResolvSeed our_resolv_conf + withResolver rs $ \resolver -> + mapM (lookupPTR resolver) in_addrs + where + in_addrs = map ip_to_in_addr_arpa ips diff --git a/src/IPv4Address.hs b/src/IPv4Address.hs index dac7dda..7c44367 100644 --- a/src/IPv4Address.hs +++ b/src/IPv4Address.hs @@ -1,8 +1,7 @@ -module IPv4Address -( ipv4address_tests, +module IPv4Address( + ipv4address_properties, + ipv4address_tests, IPv4Address(..), - max_address, - min_address, most_sig_bit_different, ) where @@ -10,7 +9,8 @@ import Data.Maybe (fromJust) import Test.HUnit (assertEqual) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) -import Test.QuickCheck (Arbitrary(..), Gen) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>)) import Maskable import Maskbits @@ -165,18 +165,64 @@ instance Maskable IPv4Address where new_addr3 { octet1 = (apply_mask oct1 Zero bit) } +instance Bounded IPv4Address where + -- | The minimum possible IPv4 address, 0.0.0.0. + minBound = IPv4Address minBound minBound minBound minBound --- | The minimum possible IPv4 address, 0.0.0.0. -min_address :: IPv4Address -min_address = - IPv4Address min_octet min_octet min_octet min_octet + -- | The maximum possible IPv4 address, 255.255.255.255. + maxBound = IPv4Address maxBound maxBound maxBound maxBound --- | The maximum possible IPv4 address, 255.255.255.255. -max_address :: IPv4Address -max_address = - IPv4Address max_octet max_octet max_octet max_octet +-- | Convert @addr@ to an 'Int' by converting each octet to an 'Int' +-- and shifting the result to the left by 0,8.16, or 24 bits. +ipv4address_to_int :: IPv4Address -> Int +ipv4address_to_int addr = + (shifted_oct1) + (shifted_oct2) + (shifted_oct3) + oct4 + where + oct1 = octet_to_int (octet1 addr) + oct2 = octet_to_int (octet2 addr) + oct3 = octet_to_int (octet3 addr) + oct4 = octet_to_int (octet4 addr) + + shifted_oct1 = oct1 * 2^(24 :: Integer) + shifted_oct2 = oct2 * 2^(16 :: Integer) + shifted_oct3 = oct3 * 2^(8 :: Integer) + + + +-- | Convert an 'Int' @x@ to an 'IPv4Address'. Each octet of @x@ is +-- right-shifted by the appropriate number of bits, and the fractional +-- part is dropped. +ipv4address_from_int :: Int -> Maybe IPv4Address +ipv4address_from_int x + | (x < 0) || (x > 2^(32 :: Integer) - 1) = Nothing + | otherwise = do + -- If the algebra is right, none of these octet_from_int calls + -- below can fail since 0 <= x <= 2^32 - 1. + oct1 <- octet_from_int shifted_x1 + oct2 <- octet_from_int shifted_x2 + oct3 <- octet_from_int shifted_x3 + oct4 <- octet_from_int x4 + return $ IPv4Address oct1 oct2 oct3 oct4 + where + -- Chop off the higher octets. x1 = x `mod` 2^32, would be + -- redundant. + x2 = x `mod` 2^(24 :: Integer) + x3 = x `mod` 2^(16 :: Integer) + x4 = x `mod` 2^(8 :: Integer) + -- Perform right-shifts. x4 doesn't need a shift. + shifted_x1 = x `quot` 2^(24 :: Integer) + shifted_x2 = x2 `quot` 2^(16 :: Integer) + shifted_x3 = x3 `quot` 2^(8 :: Integer) + + +instance Enum IPv4Address where + -- We're supposed to throw a runtime error if you call (succ + -- maxBound), so the fromJust here doesn't introduce any additional + -- badness. + toEnum = fromJust . ipv4address_from_int + fromEnum = ipv4address_to_int -- | Given two addresses, find the number of the most significant bit -- where they differ. If the addresses are the same, return @@ -292,6 +338,29 @@ most_sig_bit_different addr1 addr2 oct4b = (octet4 addr2) +-- Test lists. +ipv4address_tests :: Test +ipv4address_tests = + testGroup "IPv4 Address Tests" [ + test_enum, + test_maxBound, + test_minBound, + test_most_sig_bit_different1, + test_most_sig_bit_different2 ] + +ipv4address_properties :: Test +ipv4address_properties = + testGroup + "IPv4 Address Properties " + [ testProperty + "fromEnum/toEnum are inverses" + prop_from_enum_to_enum_inverses ] + +-- QuickCheck properties +prop_from_enum_to_enum_inverses :: Int -> Property +prop_from_enum_to_enum_inverses x = + (0 <= x) && (x <= 2^(32 :: Integer) - 1) ==> + fromEnum (toEnum x :: IPv4Address) == x -- HUnit Tests mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address @@ -303,6 +372,31 @@ mk_testaddr a b c d = oct3 = fromJust $ octet_from_int c oct4 = fromJust $ octet_from_int d +test_minBound :: Test +test_minBound = + testCase desc $ assertEqual desc expected actual + where + desc = "minBound should be 0.0.0.0" + expected = mk_testaddr 0 0 0 0 + actual = minBound :: IPv4Address + +test_maxBound :: Test +test_maxBound = + testCase desc $ assertEqual desc expected actual + where + desc = "maxBound should be 255.255.255.255" + expected = mk_testaddr 255 255 255 255 + actual = maxBound :: IPv4Address + +test_enum :: Test +test_enum = + testCase desc $ assertEqual desc expected actual + where + desc = "enumerating a /24 gives the correct addresses" + expected = ["192.168.0." ++ (show x) | x <- [0..255::Int] ] + lb = mk_testaddr 192 168 0 0 + ub = mk_testaddr 192 168 0 255 + actual = map show [lb..ub] test_most_sig_bit_different1 :: Test test_most_sig_bit_different1 = @@ -329,8 +423,3 @@ test_most_sig_bit_different2 = bit = most_sig_bit_different addr1 addr2 -ipv4address_tests :: Test -ipv4address_tests = - testGroup "IPv4 Address Tests" [ - test_most_sig_bit_different1, - test_most_sig_bit_different2 ] diff --git a/src/Main.hs b/src/Main.hs index 12511b6..d8c7600 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,8 @@ +import Control.Concurrent.ParallelIO.Global ( + parallel, + stopGlobalPool ) import Control.Monad (unless, when) +import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack) import Data.List ((\\), intercalate) import Data.Maybe (catMaybes, isNothing) import Data.String.Utils (splitWs) @@ -8,6 +12,7 @@ import System.IO (stderr, hPutStrLn) import Cidr (Cidr(..), cidr_from_string, combine_all, + enumerate, max_octet1, max_octet2, max_octet3, @@ -24,9 +29,10 @@ import CommandLine (help_set, parse_errors, parse_mode) +import DNS (Domain, lookup_ptrs) import ExitCodes import Octet - + -- | A regular expression that matches a non-address character. non_addr_char :: String @@ -122,20 +128,42 @@ main = do Regex -> do let regexes = map cidr_to_regex valid_cidrs putStrLn $ alternate regexes - Reduce -> do - _ <- mapM print (combine_all valid_cidrs) - return () - Dupe -> do - _ <- mapM print dupes - return () + Reduce -> + mapM_ print (combine_all valid_cidrs) + Dupe -> + mapM_ print dupes where dupes = valid_cidrs \\ (combine_all valid_cidrs) Diff -> do - _ <- mapM putStrLn deletions - _ <- mapM putStrLn additions - return () + mapM_ putStrLn deletions + mapM_ putStrLn additions where dupes = valid_cidrs \\ (combine_all valid_cidrs) deletions = map (\s -> '-' : (show s)) dupes newcidrs = (combine_all valid_cidrs) \\ valid_cidrs additions = map (\s -> '+' : (show s)) newcidrs + List -> do + let combined_cidrs = combine_all valid_cidrs + let addrs = concatMap enumerate combined_cidrs + mapM_ print addrs + Reverse -> do + let combined_cidrs = combine_all valid_cidrs + let addrs = concatMap enumerate combined_cidrs + 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 () + + stopGlobalPool + + where + show_pair :: (Domain, Maybe [Domain]) -> String + show_pair (s, mds) = + (BS.unpack s) ++ ": " ++ results + where + space = BS.pack " " + results = + case mds of + Nothing -> "" + Just ds -> BS.unpack $ BS.intercalate space ds diff --git a/src/Octet.hs b/src/Octet.hs index 78413e6..531d4d0 100644 --- a/src/Octet.hs +++ b/src/Octet.hs @@ -78,6 +78,36 @@ instance Maskable Octet where apply_mask oct _ _ = oct +instance Ord Octet where + (Octet x1 x2 x3 x4 x5 x6 x7 x8) <= (Octet y1 y2 y3 y4 y5 y6 y7 y8) + | x1 > y1 = False + | x2 > y2 = False + | x3 > y3 = False + | x4 > y4 = False + | x5 > y5 = False + | x6 > y6 = False + | x7 > y7 = False + | x8 > y8 = False + | otherwise = True + + +instance Bounded Octet where + -- | The octet with the least possible value. + minBound = + Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero + + -- | The octet with the greatest possible value. + maxBound = + Octet B.One B.One B.One B.One B.One B.One B.One B.One + + +instance Enum Octet where + -- We're supposed to throw a runtime error if you call (succ + -- maxBound), so the fromJust here doesn't introduce any additional + -- badness. + toEnum = fromJust . octet_from_int + fromEnum = octet_to_int + -- | Convert each bit to its integer value, and multiply by the -- appropriate power of two. Sum them up, and we should get an integer -- between 0 and 255. @@ -116,18 +146,6 @@ octet_from_string s = x:_ -> octet_from_int (fst x) --- | The octet with the least possible value. -min_octet :: Octet -min_octet = - Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero - - --- | The octet with the greatest possible value. -max_octet :: Octet -max_octet = - Octet B.One B.One B.One B.One B.One B.One B.One B.One - - -- HUnit Tests test_octet_from_int1 :: Test diff --git a/test/TestSuite.hs b/test/TestSuite.hs index 406fec5..69bae3c 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -9,12 +9,13 @@ import Test.Framework.Runners.Options import Cidr (cidr_properties, cidr_tests) -import IPv4Address (ipv4address_tests) +import IPv4Address (ipv4address_properties, ipv4address_tests) import Octet (octet_tests) tests :: [Test.Framework.Test] tests = [ cidr_properties, cidr_tests, + ipv4address_properties, ipv4address_tests, octet_tests ] -- 2.43.2