name: hath
-version: 0.0.5
+version: 0.0.6
cabal-version: >= 1.8
author: Michael Orlitzky
maintainer: Michael Orlitzky <michael@orlitzky.com>
@
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
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
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.*,
-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
+{-# 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] " ++
- "<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
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)
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 ()
-- | 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
-- 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
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
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
projects / hath.git / commitdiff