src/Main.hs

   1 import Control.Concurrent.ParallelIO.Global (
   2   parallel,
   3   stopGlobalPool )
   4 import Control.Monad (unless, when)
   5 import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack)
   6 import Data.List ((\\), intercalate)
   7 import Data.Maybe (catMaybes, isNothing)
   8 import Data.String.Utils (splitWs)
   9 import System.Exit (ExitCode(..), exitSuccess, exitWith)
  10 import System.IO (stderr, hPutStrLn)
  11
  12 import Cidr (Cidr(..),
  13              cidr_from_string,
  14              combine_all,
  15              enumerate,
  16              max_octet1,
  17              max_octet2,
  18              max_octet3,
  19              max_octet4,
  20              min_octet1,
  21              min_octet2,
  22              min_octet3,
  23              min_octet4 )
  24
  25 import CommandLine (help_set,
  26                     help_text,
  27                     input_function,
  28                     Mode(..),
  29                     parse_errors,
  30                     parse_mode)
  31
  32 import DNS (Domain, lookup_ptrs)
  33 import ExitCodes ( exit_args_parse_failed, exit_invalid_cidr )
  34 import Octet ()
  35
  36
  37 -- | A regular expression that matches a non-address character.
  38 non_addr_char :: String
  39 non_addr_char = "[^\\.0-9]"
  40
  41
  42 -- | Add non_addr_chars on either side of the given String. This
  43 --   prevents (for example) the regex '127.0.0.1' from matching
  44 --   '127.0.0.100'.
  45 addr_barrier :: String -> String
  46 addr_barrier x = non_addr_char ++ x ++ non_addr_char
  47
  48
  49 -- | The magic happens here. We take a CIDR String as an argument, and
  50 --   return the equivalent regular expression. We do this as follows:
  51 --
  52 --   1. Compute the minimum possible value of each octet.
  53 --   2. Compute the maximum possible value of each octet.
  54 --   3. Generate a regex matching every value between those min and
  55 --      max values.
  56 --   4. Join the regexes from step 3 with regexes matching periods.
  57 --   5. Stick an address boundary on either side of the result.
  58 cidr_to_regex :: Cidr.Cidr -> String
  59 cidr_to_regex cidr =
  60     addr_barrier (intercalate "\\." [range1, range2, range3, range4])
  61     where
  62       range1 = numeric_range min1 max1
  63       range2 = numeric_range min2 max2
  64       range3 = numeric_range min3 max3
  65       range4 = numeric_range min4 max4
  66       min1   = fromEnum (min_octet1 cidr)
  67       min2   = fromEnum (min_octet2 cidr)
  68       min3   = fromEnum (min_octet3 cidr)
  69       min4   = fromEnum (min_octet4 cidr)
  70       max1   = fromEnum (max_octet1 cidr)
  71       max2   = fromEnum (max_octet2 cidr)
  72       max3   = fromEnum (max_octet3 cidr)
  73       max4   = fromEnum (max_octet4 cidr)
  74
  75
  76
  77 -- | Take a list of Strings, and return a regular expression matching
  78 --   any of them.
  79 alternate :: [String] -> String
  80 alternate terms = "(" ++ (intercalate "|" terms) ++ ")"
  81
  82
  83 -- | Take two Ints as parameters, and return a regex matching any
  84 --   integer between them (inclusive).
  85 numeric_range :: Int -> Int -> String
  86 numeric_range x y =
  87     alternate (map show [lower..upper])
  88      where
  89        lower = minimum [x,y]
  90        upper = maximum [x,y]
  91
  92
  93 main :: IO ()
  94 main = do
  95   -- First, check for any errors that occurred while parsing
  96   -- the command line options.
  97   errors <- CommandLine.parse_errors
  98   unless (null errors) $ do
  99     hPutStrLn stderr (concat errors)
 100     putStrLn CommandLine.help_text
 101     exitWith (ExitFailure exit_args_parse_failed)
 102
 103   -- Next, check to see if the 'help' option was passed to the
 104   -- program. If it was, display the help, and exit successfully.
 105   help_opt_set <- CommandLine.help_set
 106   when help_opt_set $ do
 107     putStrLn CommandLine.help_text
 108     exitSuccess
 109
 110   -- The input function we receive here should know what to read.
 111   inputfunc <- (CommandLine.input_function)
 112   input <- inputfunc
 113
 114   let cidr_strings = splitWs input
 115   let cidrs = map cidr_from_string cidr_strings
 116
 117   when (any isNothing cidrs) $ do
 118     putStrLn "Error: not valid CIDR notation."
 119     exitWith (ExitFailure exit_invalid_cidr)
 120
 121   -- Filter out only the valid ones.
 122   let valid_cidrs = catMaybes cidrs
 123
 124   -- Get the mode of operation.
 125   mode <- CommandLine.parse_mode
 126
 127   case mode of
 128     Regex -> do
 129       let regexes = map cidr_to_regex valid_cidrs
 130       putStrLn $ alternate regexes
 131     Reduce ->
 132       mapM_ print (combine_all valid_cidrs)
 133     Dupe ->
 134        mapM_ print dupes
 135        where
 136          dupes = valid_cidrs \\ (combine_all valid_cidrs)
 137     Diff -> do
 138        mapM_ putStrLn deletions
 139        mapM_ putStrLn additions
 140        where
 141          dupes = valid_cidrs \\ (combine_all valid_cidrs)
 142          deletions = map (\s -> '-' : (show s)) dupes
 143          newcidrs = (combine_all valid_cidrs) \\ valid_cidrs
 144          additions = map (\s -> '+' : (show s)) newcidrs
 145     List -> do
 146       let combined_cidrs = combine_all valid_cidrs
 147       let addrs = concatMap enumerate combined_cidrs
 148       mapM_ print addrs
 149     Reverse -> do
 150       let combined_cidrs = combine_all valid_cidrs
 151       let addrs = concatMap enumerate combined_cidrs
 152       let addr_bytestrings = map (BS.pack . show) addrs
 153       ptrs <- lookup_ptrs addr_bytestrings
 154       let pairs = zip addr_bytestrings ptrs
 155       _ <- parallel (map (putStrLn . show_pair) pairs)
 156       return ()
 157
 158   stopGlobalPool
 159
 160   where
 161     show_pair :: (Domain, Maybe [Domain]) -> String
 162     show_pair (s, mds) =
 163       (BS.unpack s) ++ ": " ++ results
 164       where
 165         space = BS.pack " "
 166         results =
 167           case mds of
 168             Nothing -> ""
 169             Just ds -> BS.unpack $ BS.intercalate space ds