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 splitWith :: (a -> Bool) -> [a] -> [[a]]
   8 splitWith p xs =
   9     ys : case zs of
  10            []   -> []
  11            _:ws -> splitWith p ws
  12     where (ys,zs) = break p xs
  13
  14
  15 octets :: String -> [Int]
  16 octets cidr = map read (take 4 (splitWith (`elem` "./") cidr))
  17
  18 maskbits :: String -> Int
  19 maskbits cidr = read ((splitWith (`elem` "/") cidr) !! 1)
  20
  21
  22 pad_left_to :: Int -> a -> [a] -> [a]
  23 pad_left_to len pad_elem xs =
  24      if (length xs) >= len then
  25          xs
  26      else
  27          (replicate padcount pad_elem) ++ xs
  28          where
  29            padcount = len - (length xs)
  30
  31 pad_right_to :: Int -> a -> [a] -> [a]
  32 pad_right_to len pad_elem xs =
  33      if (length xs) >= len then
  34          xs
  35      else
  36          xs ++ (replicate padcount pad_elem)
  37          where
  38            padcount = len - (length xs)
  39
  40
  41 base_two :: Int -> String
  42 base_two n = N.showIntAtBase 2 DC.intToDigit n ""
  43
  44 ip_base_two :: [Int] -> String
  45 ip_base_two octet_list =
  46     DL.concatMap ((pad_left_to 8 '0') .base_two) octet_list
  47
  48 min_base_two_address :: String -> String
  49 min_base_two_address cidr =
  50     pad_right_to 32 '0' netpart
  51     where
  52       netpart = take (maskbits cidr) (ip_base_two (octets cidr))
  53
  54 max_base_two_address :: String -> String
  55 max_base_two_address cidr =
  56     pad_right_to 32 '1' netpart
  57     where
  58       netpart = take (maskbits cidr) (ip_base_two (octets cidr))
  59
  60 min_base_two_octets :: String -> [String]
  61 min_base_two_octets cidr =
  62     [octet1, octet2, octet3, octet4]
  63     where
  64       addr   = min_base_two_address cidr
  65       octet1 = fst (DL.splitAt 8 addr)
  66       octet2 = fst (DL.splitAt 8 (snd (DL.splitAt 8 addr)))
  67       octet3 = fst (DL.splitAt 8 (snd (DL.splitAt 16 addr)))
  68       octet4 = snd (DL.splitAt 24 addr)
  69
  70 max_base_two_octets :: String -> [String]
  71 max_base_two_octets cidr =
  72     [octet1, octet2, octet3, octet4]
  73     where
  74       addr   = max_base_two_address cidr
  75       octet1 = fst (DL.splitAt 8 addr)
  76       octet2 = fst (DL.splitAt 8 (snd (DL.splitAt 8 addr)))
  77       octet3 = fst (DL.splitAt 8 (snd (DL.splitAt 16 addr)))
  78       octet4 = snd (DL.splitAt 24 addr)
  79
  80
  81 min_octets :: String -> [Int]
  82 min_octets cidr =
  83     map base_two_to_base_ten (min_base_two_octets cidr)
  84
  85 max_octets :: String -> [Int]
  86 max_octets cidr =
  87     map base_two_to_base_ten (max_base_two_octets cidr)
  88
  89 is_binary_digit :: Char -> Bool
  90 is_binary_digit c =
  91     if c `elem` ['0','1'] then
  92         True
  93     else
  94         False
  95
  96 base_two_to_base_ten :: String -> Int
  97 base_two_to_base_ten s =
  98     if (length parsed) == 0 then
  99         0
 100     else
 101         fst (parsed !! 0)
 102     where
 103       parsed = N.readInt 2 is_binary_digit DC.digitToInt s
 104
 105
 106 cidr_to_regex :: String -> String
 107 cidr_to_regex cidr =
 108     range1 ++ "\\." ++ range2 ++ "\\." ++ range3 ++ "\\." ++ range4
 109     where
 110       range1 = numeric_range min1 max1
 111       range2 = numeric_range min2 max2
 112       range3 = numeric_range min3 max3
 113       range4 = numeric_range min4 max4
 114       min1   = (min_octets cidr) !! 0
 115       min2   = (min_octets cidr) !! 1
 116       min3   = (min_octets cidr) !! 2
 117       min4   = (min_octets cidr) !! 3
 118       max1   = (max_octets cidr) !! 0
 119       max2   = (max_octets cidr) !! 1
 120       max3   = (max_octets cidr) !! 2
 121       max4   = (max_octets cidr) !! 3
 122
 123
 124 is_valid_cidr :: String -> Bool
 125 is_valid_cidr cidr = cidr =~ "([0-9]{1,3}\\.){3}[0-9]{1,3}/[0-9]{1,2}"
 126
 127 alternate :: [String] -> String
 128 alternate terms = "(" ++ (concat (DL.intersperse "|" terms)) ++ ")"
 129
 130 numeric_range :: Int -> Int -> String
 131 numeric_range x y =
 132     alternate (map show [lower..upper])
 133      where
 134        lower = minimum [x,y]
 135        upper = maximum [x,y]
 136
 137 main :: IO ()
 138 main = do
 139   line <- getLine
 140
 141   if (is_valid_cidr line)
 142     then do
 143         putStrLn (cidr_to_regex line)
 144     else do
 145         putStrLn "Error: not valid CIDR notation."
 146         exitFailure
 147