Rewrite command-line parsing to use cmdargs.

Make the regexp barriers optional via --barriers.
Bump to version 0.0.6.
Add two new test suites (shelltestrunner) for Cabal.

diff --git a/hath.cabal b/hath.cabal
index 8eb569f410238a9c8ab9aed7c632f5e41e353d32..723c644cc56bdd5ce492591ca83aea0be64c0f37 100644 (file)
--- a/hath.cabal
+++ b/hath.cabal
@@ -1,5 +1,5 @@
 name:           hath
 name:           hath

-version:        0.0.5
+version:        0.0.6

 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>


@@ -108,18 +108,6 @@ description:
   @
 
 executable hath
   @
 
 executable hath

-  build-depends:
-    base                        >= 4.6 && < 4.7,
-    bytestring                  == 0.10.*,
-    dns                         == 1.*,
-    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.*,
-    test-framework-quickcheck2  == 0.3.*

 
   main-is:
     Main.hs
 
   main-is:
     Main.hs


@@ -138,6 +126,20 @@ executable hath
     Maskbits
     Octet
 
     Maskbits
     Octet
 

+  build-depends:
+    base                        >= 4.6 && < 4.7,
+    bytestring                  == 0.10.*,
+    cmdargs                     == 0.10.*,
+    dns                         == 1.*,
+    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.*,
+    test-framework-quickcheck2  == 0.3.*
+

   ghc-options:
     -Wall
     -fwarn-hi-shadowing
   ghc-options:
     -Wall
     -fwarn-hi-shadowing


@@ -165,9 +167,11 @@ test-suite testsuite
   type: exitcode-stdio-1.0
   hs-source-dirs: src test
   main-is: TestSuite.hs
   type: exitcode-stdio-1.0
   hs-source-dirs: src test
   main-is: TestSuite.hs

+

   build-depends:
     base                        >= 4.6 && < 4.7,
     bytestring                  == 0.10.*,
   build-depends:
     base                        >= 4.6 && < 4.7,
     bytestring                  == 0.10.*,

+    cmdargs                     == 0.10.*,

     dns                         == 1.*,
     HUnit                       == 1.2.*,
     QuickCheck                  == 2.6.*,
     dns                         == 1.*,
     HUnit                       == 1.2.*,
     QuickCheck                  == 2.6.*,


@@ -196,6 +200,87 @@ test-suite testsuite
     -optc-march=native
     -O2
 
     -optc-march=native
     -O2
 

+
+-- These won't work without shelltestrunner installed in your
+-- $PATH. Maybe there is some way to tell Cabal that.
+test-suite shelltests
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: ShellTests.hs
+
+  build-depends:
+    base                        >= 4.6 && < 4.7,
+    bytestring                  == 0.10.*,
+    cmdargs                     == 0.10.*,
+    dns                         == 1.*,
+    HUnit                       == 1.2.*,
+    QuickCheck                  == 2.6.*,
+    MissingH                    == 1.2.*,
+    parallel-io                 == 0.3.*,
+    process                     == 1.1.*,
+    split                       == 0.2.*,
+    test-framework              == 0.8.*,
+    test-framework-hunit        == 0.3.*,
+    test-framework-quickcheck2  == 0.3.*
+
+  -- It's not entirely clear to me why I have to reproduce all of this.
+  ghc-options:
+    -Wall
+    -fwarn-hi-shadowing
+    -fwarn-missing-signatures
+    -fwarn-name-shadowing
+    -fwarn-orphans
+    -fwarn-type-defaults
+    -fwarn-tabs
+    -fwarn-incomplete-record-updates
+    -fwarn-monomorphism-restriction
+    -fwarn-unused-do-bind
+    -rtsopts
+    -threaded
+    -optc-O3
+    -optc-march=native
+    -O2
+
+
+test-suite shelltests-net
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: ShellTestsNet.hs
+
+  build-depends:
+    base                        >= 4.6 && < 4.7,
+    bytestring                  == 0.10.*,
+    cmdargs                     == 0.10.*,
+    dns                         == 1.*,
+    HUnit                       == 1.2.*,
+    QuickCheck                  == 2.6.*,
+    MissingH                    == 1.2.*,
+    parallel-io                 == 0.3.*,
+    process                     == 1.1.*,
+    split                       == 0.2.*,
+    test-framework              == 0.8.*,
+    test-framework-hunit        == 0.3.*,
+    test-framework-quickcheck2  == 0.3.*
+
+  -- It's not entirely clear to me why I have to reproduce all of this.
+  ghc-options:
+    -Wall
+    -fwarn-hi-shadowing
+    -fwarn-missing-signatures
+    -fwarn-name-shadowing
+    -fwarn-orphans
+    -fwarn-type-defaults
+    -fwarn-tabs
+    -fwarn-incomplete-record-updates
+    -fwarn-monomorphism-restriction
+    -fwarn-unused-do-bind
+    -rtsopts
+    -threaded
+    -optc-O3
+    -optc-march=native
+    -O2
+
+

 source-repository head
   type: git
   location: http://michael.orlitzky.com/git/hath.git
 source-repository head
   type: git
   location: http://michael.orlitzky.com/git/hath.git

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index 430743fab1116c66ed7815ee76f24ad9c95ff1cf..789f76c0addc7fa1281c9fd2ad711d9ac6fc073b 100644 (file)
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -1,168 +1,137 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+

 -- | The CommandLine module handles parsing of the command-line
 --   options.  It should more or less be a black box, providing Main
 --   with only the information it requires.
 -- | The CommandLine module handles parsing of the command-line
 --   options.  It should more or less be a black box, providing Main
 --   with only the information it requires.

-module CommandLine
-( help_set,
-  help_text,
-  input_function,
-  Mode(..),
-  parse_errors,
-  parse_mode)
-where
-
-import Data.Char (toLower)
-import System.Console.GetOpt (
-  ArgDescr(NoArg, ReqArg),
-  ArgOrder(Permute),
-  OptDescr(..),
-  getOpt,
-  usageInfo )
-import System.Environment (getArgs)
-
-
--- | Lowercase an entire string.
-lowercase :: String -> String
-lowercase = map toLower
-
-
--- | 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.

 --
 --

---   Diff will show both additions and deletions in a diff-like
---   format.
+--   Which is why we're allowed all of this unsafe voodoo.

 --
 --

---   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.
-data Options = Options { opt_help  :: Bool,
-                         opt_input :: IO String }
-
-
--- | This constructs an instance of Options, with each of its members
---   set to default values.
-default_options :: Options
-default_options = Options { opt_help = False,
-                            opt_input = getContents }
-
+module CommandLine (
+  Args(..),
+  get_args
+)
+where

 
 

--- | The options list that we construct associates a function with
---   each option. This function is responsible for updating an Options
---   record with the appropriate value.
+import System.Console.CmdArgs (
+  Ann,
+  Annotate( (:=) ),
+  Data,
+  Typeable,
+  (+=),
+  auto,
+  cmdArgs_,
+  def,
+  details,
+  explicit,
+  groupname,
+  help,
+  helpArg,
+  modes_,
+  name,
+  program,
+  record,
+  summary,
+  versionArg )
+
+-- Get the version from Cabal.
+import Paths_hath (version)
+import Data.Version (showVersion)
+
+-- | The name of our program.
+program_name :: String
+program_name = "hath"
+
+-- | A brief summary; displays the program name and version.
+my_summary :: String
+my_summary = program_name ++ "-" ++ (showVersion version)
+
+barriers_help :: String
+barriers_help =
+  "(regexed mode) place barriers in front/back of the regex " ++
+  "to prevent e.g. '127.0.0.1' from matching '127.0.0.100'"
+
+
+-- | The Args type represents the possible command-line options. The
+--   duplication here seems necessary; CmdArgs' magic requires us to
+--   define some things explicitly.

 --
 --

---   For more information and an example of this idiom, see,
+--   The application currently has six modes (if this number is wrong,
+--   it means I forgot to update the comment!), all of which take the
+--   same options and arguments.

 --
 --

---   http://www.haskell.org/haskellwiki/High-level_option_handling_with_GetOpt
+data Args =
+  Regexed { barriers :: Bool } |
+  Reduced { barriers :: Bool } |
+  Duped { barriers :: Bool } |
+  Diffed { barriers :: Bool } |
+  Listed { barriers :: Bool } |
+  Reversed { barriers :: Bool }
+  deriving (Data, Show, Typeable)
+
+-- | Description of the 'Regexed' mode.
+regexed_description :: String
+regexed_description =
+  "Compute a regular expression matching the input CIDRs."
+
+-- | Description of the 'Reduced' mode.
+reduced_description :: String
+reduced_description =
+  "Combine any redundant/adjacent CIDR blocks into one."
+
+-- | Description of the 'Duped' mode.
+duped_description :: String
+duped_description = "Display what would be removed by 'reduced'."
+
+-- | Description of the 'Diffed' mode.
+diffed_description :: String
+diffed_description =
+  "Display both additions and deletions in a diff-like format."
+
+-- | Description of the 'Listed' mode.
+listed_description :: String
+listed_description =
+  "Enumerate the IP addresses contained within the input CIDRs."
+
+-- | Description of the 'Reversed' mode.
+reversed_description :: String
+reversed_description =
+  "Perform a reverse DNS (PTR) lookup on each IP address " ++
+  "contained within the input CIDRs."
+
+
+-- | We use explicit annotation here because if we use the magic
+--   annotation, we have to duplicate the same argument definitions six
+--   times.

 --
 --

-options :: [OptDescr (Options -> IO Options)]
-options =
-  [ Option "h" ["help"] (NoArg set_help) "Prints this help message.",
-    Option "i" ["input"] (ReqArg set_input "FILE") "Read FILE instead of stdin." ]
-
--- | Takes an Options as an argument, and sets its opt_help member to
---   True.
-set_help :: Options -> IO Options
-set_help opts =
-  return opts { opt_help = True }
-
-
--- | If the input file option is set, this function will update the
---   passed Options record with a new function for opt_input. The
---   default opt_input is to read from stdin, but if this option is
---   set, we replace that with readFile.
-set_input :: String -> Options -> IO Options
-set_input arg opts =
-  return opts { opt_input = readFile arg }
-
-
--- | The usage header.
-usage :: String
-usage =
-  "Usage: hath " ++
-  "[regexed|reduced|duped|diffed|listed|reversed] " ++
-  "[-h] " ++
-  "[-i FILE] " ++
-  "<input>"
-
-
--- | The usage header, and all available flags (as generated by GetOpt).
-help_text :: String
-help_text = usageInfo usage options
-
-
--- | Return a list of options.
-parse_options :: IO Options
-parse_options = do
-  argv <- getArgs
-  let (actions, _, _) = getOpt Permute options argv
-
-  -- This will execute each of the functions contained in our options
-  -- list, one after another, on a default_options record. The end
-  -- result should be an Options instance with all of its members set
-  -- correctly.
-  foldl (>>=) (return default_options) actions
-
-
-
--- | Return the mode if one was given.
-parse_mode :: IO Mode
-parse_mode = do
-  argv <- getArgs
-  let (_, non_options, _) = getOpt Permute options argv
-  return $ case non_options of
-    -- Default
-    []    -> Regex
-    -- Some non-option was given, but were any of them modes?
-    (x:_) ->
-      case (lowercase x) of
-        "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
-
-
-
-
--- | Return a list of errors.
-parse_errors :: IO [String]
-parse_errors = do
-  argv <- getArgs
-  let (_, _, errors) = getOpt Permute options argv
-  return errors
-
-
-
--- | Is the help option set?
-help_set :: IO Bool
-help_set = do
-    opts <- parse_options
-    return (opt_help opts)
-
-
--- | Return our input function, getContents by default, or readFile if
---   the input file option was set.
-input_function :: IO (IO String)
-input_function = do
-    opts <- parse_options
-    return (opt_input opts)
+arg_spec :: Annotate Ann
+arg_spec =
+  modes_ [regexed += auto, reduced, duped, diffed, listed, reversed]
+    += program program_name
+    += summary my_summary
+    += helpArg [explicit,
+                name "help",
+                name "h",
+                groupname "Common flags"]
+    += versionArg [explicit,
+                   name "version",
+                   name "v",
+                   groupname "Common flags"]
+  where
+    make_mode :: (Bool -> Args) -> String -> (Annotate Ann)
+    make_mode ctor desc =
+      record (ctor def) [ barriers := def
+                            += groupname "Common flags"
+                            += help barriers_help ]
+                        += details ["  " ++ desc]
+
+    regexed  = make_mode Regexed regexed_description
+    reduced  = make_mode Reduced reduced_description
+    duped    = make_mode Duped duped_description
+    diffed   = make_mode Diffed diffed_description
+    listed   = make_mode Listed listed_description
+    reversed = make_mode Reversed reversed_description
+
+-- | This is the public interface; i.e. what main() should use to get
+--   the command-line arguments.
+get_args :: IO Args
+get_args = cmdArgs_ arg_spec

diff --git a/src/ExitCodes.hs b/src/ExitCodes.hs
index ef5d73f06a57398fd238bee92ed8a28f5ee46fd1..62a561d3264114a59e68be9bfd1db81ed18658c8 100644 (file)
--- a/src/ExitCodes.hs
+++ b/src/ExitCodes.hs
@@ -1,14 +1,8 @@
 -- | Some exit codes, used in the ExitFailure constructor.
 module ExitCodes (
 -- | Some exit codes, used in the ExitFailure constructor.
 module ExitCodes (

-  exit_args_parse_failed,
-  exit_invalid_cidr
-  )
+  exit_invalid_cidr )

 where
 
 -- | One of the CIDRs is invalid (malformed, not a CIDR at all, etc).
 exit_invalid_cidr :: Int
 exit_invalid_cidr = 1
 where
 
 -- | One of the CIDRs is invalid (malformed, not a CIDR at all, etc).
 exit_invalid_cidr :: Int
 exit_invalid_cidr = 1

-
--- | We were unable to parse the command-line arguments.
-exit_args_parse_failed :: Int
-exit_args_parse_failed = 2

diff --git a/src/Main.hs b/src/Main.hs
index 5afadcdfbc80e80fb1b4a2213afacce6fc836809..45705be673f087d76d8e64ea61f16c086ac98632 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,12 +2,12 @@ module Main
 where
 
 import Control.Concurrent.ParallelIO.Global ( stopGlobalPool )
 where
 
 import Control.Concurrent.ParallelIO.Global ( stopGlobalPool )

-import Control.Monad (unless, when)
+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 System.Exit (ExitCode(..), exitWith)

 import System.IO (stderr, hPutStrLn)
 import Text.Read (readMaybe)
 
 import System.IO (stderr, hPutStrLn)
 import Text.Read (readMaybe)
 


@@ -23,15 +23,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 CommandLine (Args(..), get_args)

 import DNS (Domain, PTRResult, lookup_ptrs)
 import DNS (Domain, PTRResult, lookup_ptrs)

-import ExitCodes ( exit_args_parse_failed, exit_invalid_cidr )
+import ExitCodes ( exit_invalid_cidr )

 import Octet ()
 
 
 import Octet ()
 
 


@@ -43,8 +37,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,9 +51,10 @@ addr_barrier x = non_addr_char ++ x ++ non_addr_char
 --   4. Join the regexes from step 3 with regexes matching periods.
 --   5. Stick an address boundary on either side of the result.
 --
 --   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 :: 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


@@ -94,49 +89,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 cidrs = map readMaybe cidr_strings
 
   when (any isNothing cidrs) $ do
 
   let cidr_strings = splitWs input
   let cidrs = map readMaybe cidr_strings
 
   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


@@ -144,11 +130,11 @@ 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
       let combined_cidrs = combine_all valid_cidrs
       let addrs = concatMap enumerate combined_cidrs
       let addr_bytestrings = map (BS.pack . show) addrs