src/hath.hs

   1 import qualified Data.Char as DC
   2 import qualified Data.List as DL
   3 import qualified Numeric as N
   4 import System.Exit (exitFailure)
   5 import Text.Regex.Posix
   6
   7
   8 -- Stolen from ByteString. Splits a list at each element satisfying
   9 -- the predicate p.
  10 splitWith :: (a -> Bool) -> [a] -> [[a]]
  11 splitWith p xs =
  12     ys : case zs of
  13            []   -> []
  14            _:ws -> splitWith p ws
  15     where (ys,zs) = break p xs
  16
  17
  18 -- Takes an IP address in CIDR notation, and returns a list of its
  19 -- octets (converted to Int).
  20 octets :: String -> [Int]
  21 octets cidr = map read (take 4 (splitWith (`elem` "./") cidr))
  22
  23
  24 -- Returns the mask portion of a CIDR address. That is, everything
  25 -- after the trailing slash.
  26 maskbits :: String -> Int
  27 maskbits cidr = read ((splitWith (`elem` "/") cidr) !! 1)
  28
  29
  30 -- Pads a list (on the left) to length len by prepending pad_elem.
  31 pad_left_to :: Int -> a -> [a] -> [a]
  32 pad_left_to len pad_elem xs =
  33      if (length xs) >= len then
  34          xs
  35      else
  36          (replicate padcount pad_elem) ++ xs
  37          where
  38            padcount = len - (length xs)
  39
  40
  41 -- Pads a list (on the right) to length len by appending pad_elem.
  42 pad_right_to :: Int -> a -> [a] -> [a]
  43 pad_right_to len pad_elem xs =
  44      if (length xs) >= len then
  45          xs
  46      else
  47          xs ++ (replicate padcount pad_elem)
  48          where
  49            padcount = len - (length xs)
  50
  51
  52 -- Takes an Int, and returns its base-two representation as a String.
  53 base_two :: Int -> String
  54 base_two n = N.showIntAtBase 2 DC.intToDigit n ""
  55
  56
  57 -- Takes a set of octets, and converts them to base-two
  58 -- individually. The results are then zero-padded on the left to 8
  59 -- characters, and concatenated together.
  60 octets_base_two :: [Int] -> String
  61 octets_base_two octet_list =
  62     DL.concatMap ((pad_left_to 8 '0') .base_two) octet_list
  63
  64
  65 -- Returns the minimum address (as a base-two string) satisfying the
  66 -- given CIDR string.
  67 min_base_two_address :: String -> String
  68 min_base_two_address cidr =
  69     pad_right_to 32 '0' netpart
  70     where
  71       netpart = take (maskbits cidr) (octets_base_two (octets cidr))
  72
  73
  74 -- Returns the maximum address (as a base-two string) satisfying the
  75 -- given CIDR string.
  76 max_base_two_address :: String -> String
  77 max_base_two_address cidr =
  78     pad_right_to 32 '1' netpart
  79     where
  80       netpart = take (maskbits cidr) (octets_base_two (octets cidr))
  81
  82
  83 -- The octet components of min_base_two_address, as a base-two String.
  84 min_base_two_octets :: String -> [String]
  85 min_base_two_octets cidr =
  86     [octet1, octet2, octet3, octet4]
  87     where
  88       addr   = min_base_two_address cidr
  89       octet1 = fst (DL.splitAt 8 addr)
  90       octet2 = fst (DL.splitAt 8 (snd (DL.splitAt 8 addr)))
  91       octet3 = fst (DL.splitAt 8 (snd (DL.splitAt 16 addr)))
  92       octet4 = snd (DL.splitAt 24 addr)
  93
  94
  95 -- The octet components of max_base_two_address, as a base-two String.
  96 max_base_two_octets :: String -> [String]
  97 max_base_two_octets cidr =
  98     [octet1, octet2, octet3, octet4]
  99     where
 100       addr   = max_base_two_address cidr
 101       octet1 = fst (DL.splitAt 8 addr)
 102       octet2 = fst (DL.splitAt 8 (snd (DL.splitAt 8 addr)))
 103       octet3 = fst (DL.splitAt 8 (snd (DL.splitAt 16 addr)))
 104       octet4 = snd (DL.splitAt 24 addr)
 105
 106
 107 -- The octet components of min_base_two_address, as Ints.
 108 min_octets :: String -> [Int]
 109 min_octets cidr =
 110     map base_two_to_base_ten (min_base_two_octets cidr)
 111
 112
 113 -- The octet components of max_base_two_address, as Ints.
 114 max_octets :: String -> [Int]
 115 max_octets cidr =
 116     map base_two_to_base_ten (max_base_two_octets cidr)
 117
 118
 119 -- The base_two_to_base_ten function requires a way to determine
 120 -- whether or not the character it's currently parsing is valid. This
 121 -- should do it.
 122 is_binary_digit :: Char -> Bool
 123 is_binary_digit c =
 124     if c `elem` ['0','1'] then
 125         True
 126     else
 127         False
 128
 129
 130 -- Convert a base-two String to an Int.
 131 base_two_to_base_ten :: String -> Int
 132 base_two_to_base_ten s =
 133     if (length parsed) == 0 then
 134         0
 135     else
 136         fst (parsed !! 0)
 137     where
 138       parsed = N.readInt 2 is_binary_digit DC.digitToInt s
 139
 140
 141 -- A regular expression that matches a non-address character.
 142 non_addr_char :: String
 143 non_addr_char = "[^\\.0-9]"
 144
 145
 146 -- Add non_addr_chars on either side of the given String. This
 147 -- prevents (for example) the regex '127.0.0.1' from matching
 148 -- '127.0.0.100'.
 149 addr_barrier :: String -> String
 150 addr_barrier x = non_addr_char ++ x ++ non_addr_char
 151
 152
 153 -- The magic happens here. We take a CIDR String as an argument, and
 154 -- return the equivalent regular expression. We do this as follows:
 155 --
 156 -- 1. Compute the minimum possible value of each octet.
 157 -- 2. Compute the maximum possible value of each octet.
 158 -- 3. Generate a regex matching every value between those min and
 159 --    max values.
 160 -- 4. Join the regexes from step 3 with regexes matching periods.
 161 -- 5. Stick an address boundary on either side of the result.
 162 cidr_to_regex :: String -> String
 163 cidr_to_regex cidr =
 164     addr_barrier (DL.intercalate "\\." [range1, range2, range3, range4])
 165     where
 166       range1 = numeric_range min1 max1
 167       range2 = numeric_range min2 max2
 168       range3 = numeric_range min3 max3
 169       range4 = numeric_range min4 max4
 170       min1   = (min_octets cidr) !! 0
 171       min2   = (min_octets cidr) !! 1
 172       min3   = (min_octets cidr) !! 2
 173       min4   = (min_octets cidr) !! 3
 174       max1   = (max_octets cidr) !! 0
 175       max2   = (max_octets cidr) !! 1
 176       max3   = (max_octets cidr) !! 2
 177       max4   = (max_octets cidr) !! 3
 178
 179
 180 -- Will return True if the passed String is in CIDR notation, False
 181 -- otherwise.
 182 is_valid_cidr :: String -> Bool
 183 is_valid_cidr cidr = cidr =~ "([0-9]{1,3}\\.){3}[0-9]{1,3}/[0-9]{1,2}"
 184
 185
 186 -- Take a list of Strings, and return a regular expression matching
 187 -- any of them.
 188 alternate :: [String] -> String
 189 alternate terms = "(" ++ (concat (DL.intersperse "|" terms)) ++ ")"
 190
 191
 192 -- Take two Ints as parameters, and return a regex matching any
 193 -- integer between them (inclusive).
 194 numeric_range :: Int -> Int -> String
 195 numeric_range x y =
 196     alternate (map show [lower..upper])
 197      where
 198        lower = minimum [x,y]
 199        upper = maximum [x,y]
 200
 201
 202 -- Take a CIDR String, and exitFailure if it's invalid.
 203 validate_or_die :: String -> IO ()
 204 validate_or_die cidr = do
 205   if (is_valid_cidr cidr)
 206     then do
 207       return ()
 208     else do
 209         putStrLn "Error: not valid CIDR notation."
 210         exitFailure
 211
 212
 213 main :: IO ()
 214 main = do
 215   input <- getContents
 216   let cidrs = lines input
 217   mapM validate_or_die cidrs
 218   let regexes = map cidr_to_regex cidrs
 219   putStrLn $ alternate regexes
 220