From a2fe46950a637e64fb5056fce091bf398b983a79 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sun, 13 Oct 2013 22:11:09 -0400 Subject: [PATCH] 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. --- hath.cabal | 111 ++++++++++++++++-- src/CommandLine.hs | 287 ++++++++++++++++++++------------------------- src/ExitCodes.hs | 8 +- src/Main.hs | 76 +++++------- 4 files changed, 258 insertions(+), 224 deletions(-) diff --git a/hath.cabal b/hath.cabal index 8eb569f..723c644 100644 --- a/hath.cabal +++ b/hath.cabal @@ -1,5 +1,5 @@ name: hath -version: 0.0.5 +version: 0.0.6 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky @@ -108,18 +108,6 @@ description: @ 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 @@ -138,6 +126,20 @@ executable hath 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 @@ -165,9 +167,11 @@ test-suite testsuite type: exitcode-stdio-1.0 hs-source-dirs: src test main-is: TestSuite.hs + build-depends: base >= 4.6 && < 4.7, bytestring == 0.10.*, + cmdargs == 0.10.*, dns == 1.*, HUnit == 1.2.*, QuickCheck == 2.6.*, @@ -196,6 +200,87 @@ test-suite testsuite -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 diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 430743f..789f76c 100644 --- 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. -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] " ++ - "" - - --- | 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 ef5d73f..62a561d 100644 --- a/src/ExitCodes.hs +++ b/src/ExitCodes.hs @@ -1,14 +1,8 @@ -- | 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 - --- | 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 5afadcd..45705be 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,12 +2,12 @@ module Main 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 System.Exit (ExitCode(..), exitSuccess, exitWith) +import System.Exit (ExitCode(..), exitWith) import System.IO (stderr, hPutStrLn) import Text.Read (readMaybe) @@ -23,15 +23,9 @@ import Cidr ( 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 ExitCodes ( exit_args_parse_failed, exit_invalid_cidr ) +import ExitCodes ( exit_invalid_cidr ) 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'. -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 @@ -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. -- -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 @@ -94,49 +89,40 @@ numeric_range x y = 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 - 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 - -- 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 - Reduce -> + Reduced{} -> mapM_ print (combine_all valid_cidrs) - Dupe -> + Duped{} -> mapM_ print dupes where dupes = valid_cidrs \\ (combine_all valid_cidrs) - Diff -> do + Diffed{} -> do 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 - List -> do + Listed{} -> do 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 -- 2.43.2