]> gitweb.michael.orlitzky.com - hath.git/blob - src/hath.hs
Commented each function.
[hath.git] / 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 main :: IO ()
203 main = do
204 line <- getLine
205
206 if (is_valid_cidr line)
207 then do
208 putStrLn (cidr_to_regex line)
209 else do
210 putStrLn "Error: not valid CIDR notation."
211 exitFailure
212