Switch from test-framework to tasty.

[hath.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index 5b034ba5119bf336721c334a3c1fe69f1518fd83..2bb586980f5a06bf2de39a54dfdab580c3cda21d 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,20 +1,19 @@
 module Main
 where
 
 module Main
 where
 

-import Control.Concurrent.ParallelIO.Global (
-  parallel,
-  stopGlobalPool )
-import Control.Monad (unless, when)
+import Control.Concurrent.ParallelIO.Global ( stopGlobalPool )
+import Control.Monad (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)
 import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack)
 import Data.List ((\\), intercalate)
 import Data.Maybe (catMaybes, isNothing)
 import Data.String.Utils (splitWs)

-import System.Exit (ExitCode(..), exitSuccess, exitWith)
+import Network.DNS.Types ( DNSError (NameError) )
+import System.Exit (ExitCode(..), exitWith)

 import System.IO (stderr, hPutStrLn)
 import System.IO (stderr, hPutStrLn)

+import Text.Read (readMaybe)

 
 import Cidr (
   Cidr(..),
 
 import Cidr (
   Cidr(..),

-  cidr_from_string,

   combine_all,
   enumerate,
   max_octet1,
   combine_all,
   enumerate,
   max_octet1,


@@ -25,15 +24,9 @@ import Cidr (
   min_octet2,
   min_octet3,
   min_octet4 )
   min_octet2,
   min_octet3,
   min_octet4 )

-import CommandLine (
-  help_set,
-  help_text,
-  input_function,
-  Mode(..),
-  parse_errors,
-  parse_mode )
-import DNS (Domain, lookup_ptrs)
-import ExitCodes ( exit_args_parse_failed, exit_invalid_cidr )
+import CommandLine (Args(..), get_args)
+import DNS (Domain, PTRResult, lookup_ptrs)
+import ExitCodes ( exit_invalid_cidr )

 import Octet ()
 
 
 import Octet ()
 
 


@@ -45,8 +38,8 @@ non_addr_char = "[^\\.0-9]"
 -- | Add non_addr_chars on either side of the given String. This
 --   prevents (for example) the regex '127.0.0.1' from matching
 --   '127.0.0.100'.
 -- | Add non_addr_chars on either side of the given String. This
 --   prevents (for example) the regex '127.0.0.1' from matching
 --   '127.0.0.100'.

-addr_barrier :: String -> String
-addr_barrier x = non_addr_char ++ x ++ non_addr_char
+add_barriers :: String -> String
+add_barriers x = non_addr_char ++ x ++ non_addr_char

 
 
 -- | The magic happens here. We take a CIDR String as an argument, and
 
 
 -- | The magic happens here. We take a CIDR String as an argument, and


@@ -57,10 +50,13 @@ addr_barrier x = non_addr_char ++ x ++ non_addr_char
 --   3. Generate a regex matching every value between those min and
 --      max values.
 --   4. Join the regexes from step 3 with regexes matching periods.
 --   3. Generate a regex matching every value between those min and
 --      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])
+--   5. Stick an address boundary on either side of the result if
+--      use_barriers is True.
+--
+cidr_to_regex :: Bool -> Cidr.Cidr -> String
+cidr_to_regex use_barriers cidr =
+    let f = if use_barriers then add_barriers else id in
+      f (intercalate "\\." [range1, range2, range3, range4])

     where
       range1 = numeric_range min1 max1
       range2 = numeric_range min2 max2
     where
       range1 = numeric_range min1 max1
       range2 = numeric_range min2 max2


@@ -85,9 +81,15 @@ alternate terms = "(" ++ (intercalate "|" terms) ++ ")"
 
 -- | Take two Ints as parameters, and return a regex matching any
 --   integer between them (inclusive).
 
 -- | Take two Ints as parameters, and return a regex matching any
 --   integer between them (inclusive).

+--
+--   IMPORTANT: we match from max to min so that if e.g. the last
+--   octet is '255', we want '255' to match before '2' in the regex
+--   (255|254|...|3|2|1) which does not happen if we use
+--   (1|2|3|...|254|255).
+--

 numeric_range :: Int -> Int -> String
 numeric_range x y =
 numeric_range :: Int -> Int -> String
 numeric_range x y =

-    alternate (map show [lower..upper])
+    alternate (map show $ reverse [lower..upper])

      where
        lower = minimum [x,y]
        upper = maximum [x,y]
      where
        lower = minimum [x,y]
        upper = maximum [x,y]


@@ -95,49 +97,40 @@ numeric_range x y =
 
 main :: IO ()
 main = do
 
 main :: IO ()
 main = do

-  -- First, check for any errors that occurred while parsing
-  -- the command line options.
-  errors <- CommandLine.parse_errors
-  unless (null errors) $ do
-    hPutStrLn stderr (concat errors)
-    putStrLn CommandLine.help_text
-    exitWith (ExitFailure exit_args_parse_failed)
-
-  -- Next, check to see if the 'help' option was passed to the
-  -- program. If it was, display the help, and exit successfully.
-  help_opt_set <- CommandLine.help_set
-  when help_opt_set $ do
-    putStrLn CommandLine.help_text
-    exitSuccess
-
-  -- The input function we receive here should know what to read.
-  inputfunc <- (CommandLine.input_function)
-  input <- inputfunc
+  args <- get_args
+
+  -- This reads stdin.
+  input <- getContents

 
   let cidr_strings = splitWs input
 
   let cidr_strings = splitWs input

-  let cidrs = map cidr_from_string cidr_strings
+  let cidrs = map readMaybe cidr_strings

 
   when (any isNothing cidrs) $ do
 
   when (any isNothing cidrs) $ do

-    putStrLn "Error: not valid CIDR notation."
+    hPutStrLn stderr "ERROR: not valid CIDR notation:"
+
+    -- Output the bad lines, safely.
+    let pairs = zip cidr_strings cidrs
+    let print_pair (x, Nothing) = hPutStrLn stderr ("  * " ++ x)
+        print_pair (_, _) = return ()
+
+    mapM_ print_pair pairs

     exitWith (ExitFailure exit_invalid_cidr)
 
   -- Filter out only the valid ones.
   let valid_cidrs = catMaybes cidrs
 
     exitWith (ExitFailure exit_invalid_cidr)
 
   -- Filter out only the valid ones.
   let valid_cidrs = catMaybes cidrs
 

-  -- Get the mode of operation.
-  mode <- CommandLine.parse_mode
-
-  case mode of
-    Regex -> do
-      let regexes = map cidr_to_regex valid_cidrs
+  case args of
+    Regexed{} -> do
+      let cidrs' = combine_all valid_cidrs
+      let regexes = map (cidr_to_regex (barriers args)) cidrs'

       putStrLn $ alternate regexes
       putStrLn $ alternate regexes

-    Reduce ->
+    Reduced{} ->

       mapM_ print (combine_all valid_cidrs)
       mapM_ print (combine_all valid_cidrs)

-    Dupe ->
+    Duped{} ->

        mapM_ print dupes
        where
          dupes = valid_cidrs \\ (combine_all valid_cidrs)
        mapM_ print dupes
        where
          dupes = valid_cidrs \\ (combine_all valid_cidrs)

-    Diff -> do
+    Diffed{} -> do

        mapM_ putStrLn deletions
        mapM_ putStrLn additions
        where
        mapM_ putStrLn deletions
        mapM_ putStrLn additions
        where


@@ -145,28 +138,29 @@ main = do
          deletions = map (\s -> '-' : (show s)) dupes
          newcidrs = (combine_all valid_cidrs) \\ valid_cidrs
          additions = map (\s -> '+' : (show s)) newcidrs
          deletions = map (\s -> '-' : (show s)) dupes
          newcidrs = (combine_all valid_cidrs) \\ valid_cidrs
          additions = map (\s -> '+' : (show s)) newcidrs

-    List -> do
+    Listed{} -> do

       let combined_cidrs = combine_all valid_cidrs
       let addrs = concatMap enumerate combined_cidrs
       mapM_ print addrs
       let combined_cidrs = combine_all valid_cidrs
       let addrs = concatMap enumerate combined_cidrs
       mapM_ print addrs

-    Reverse -> do
+    Reversed{} -> 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
       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 ()
+      mapM_ (putStrLn . show_pair) pairs

 
   stopGlobalPool
 
   where
 
   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 =
       (BS.unpack s) ++ ": " ++ results
       where
         space = BS.pack " "
         results =

-          case mds of
-            Nothing -> ""
-            Just ds -> BS.unpack $ BS.intercalate space ds
+          case eds of
+            -- NameError simply means "not found" so we output nothing.
+            Left NameError -> ""
+            Left err -> "ERROR (" ++ (show err) ++ ")"
+            Right ds -> BS.unpack $ BS.intercalate space ds