1 -- | The CIDR modules contains most of the functions used for working
20 prop_all_cidrs_contain_themselves,
21 prop_contains_proper_intransitive
24 import Data.List (nubBy)
25 import Data.List.Split (splitOneOf)
26 import Data.Maybe (catMaybes, fromJust, mapMaybe)
28 import Test.HUnit (assertEqual)
29 import Test.Framework (Test, testGroup)
30 import Test.Framework.Providers.HUnit (testCase)
31 import Test.Framework.Providers.QuickCheck2 (testProperty)
32 import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
34 import qualified Bit as B
41 data Cidr = Cidr { ipv4address :: IPv4Address,
42 maskbits :: Maskbits }
46 instance Show Cidr where
47 show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
50 instance Arbitrary Cidr where
52 ipv4 <- arbitrary :: Gen IPv4Address
53 mask <- arbitrary :: Gen Maskbits
54 return (Cidr ipv4 mask)
57 instance Eq Cidr where
58 cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
61 -- | Two CIDR ranges are equivalent if they have the same network bits
62 -- and the masks are the same.
63 equivalent :: Cidr -> Cidr -> Bool
64 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
65 (mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
67 -- | Returns the mask portion of a CIDR address. That is, everything
68 -- after the trailing slash.
69 maskbits_from_cidr_string :: String -> Maybe Maskbits
70 maskbits_from_cidr_string s
71 | length partlist == 2 = maskbits_from_string (partlist !! 1)
74 partlist = splitOneOf "/" s
77 -- | Takes an IP address String in CIDR notation, and returns a list
78 -- of its octets (as Ints).
79 octets_from_cidr_string :: String -> [Octet]
80 octets_from_cidr_string s =
81 mapMaybe octet_from_string (take 4 (splitOneOf "./" s))
84 -- | Return Nothing if we can't parse both maskbits and octets from
86 cidr_from_string :: String -> Maybe Cidr
88 case (octets_from_cidr_string s) of
89 [oct1, oct2, oct3, oct4] ->
90 case (maskbits_from_cidr_string s) of
92 Just $ Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits
98 -- | Given a CIDR, return the minimum valid IPv4 address contained
100 min_host :: Cidr -> IPv4Address
101 min_host (Cidr addr mask) = apply_mask addr mask B.Zero
103 -- | Given a CIDR, return the maximum valid IPv4 address contained
105 max_host :: Cidr -> IPv4Address
106 max_host (Cidr addr mask) = apply_mask addr mask B.One
108 -- | Given a CIDR, return the first octet of the minimum valid IPv4
109 -- address contained within it.
110 min_octet1 :: Cidr -> Octet
111 min_octet1 cidr = octet1 (min_host cidr)
113 -- | Given a CIDR, return the second octet of the minimum valid IPv4
114 -- address contained within it.
115 min_octet2 :: Cidr -> Octet
116 min_octet2 cidr = octet2 (min_host cidr)
118 -- | Given a CIDR, return the third octet of the minimum valid IPv4
119 -- address contained within it.
120 min_octet3 :: Cidr -> Octet
121 min_octet3 cidr = octet3 (min_host cidr)
123 -- | Given a CIDR, return the fourth octet of the minimum valid IPv4
124 -- address contained within it.
125 min_octet4 :: Cidr -> Octet
126 min_octet4 cidr = octet4 (min_host cidr)
128 -- | Given a CIDR, return the first octet of the maximum valid IPv4
129 -- address contained within it.
130 max_octet1 :: Cidr -> Octet
131 max_octet1 cidr = octet1 (max_host cidr)
133 -- | Given a CIDR, return the second octet of the maximum valid IPv4
134 -- address contained within it.
135 max_octet2 :: Cidr -> Octet
136 max_octet2 cidr = octet2 (max_host cidr)
138 -- | Given a CIDR, return the third octet of the maximum valid IPv4
139 -- address contained within it.
140 max_octet3 :: Cidr -> Octet
141 max_octet3 cidr = octet3 (max_host cidr)
143 -- | Given a CIDR, return the fourth octet of the maximum valid IPv4
144 -- address contained within it.
145 max_octet4 :: Cidr -> Octet
146 max_octet4 cidr = octet4 (max_host cidr)
150 -- | Return true if the first argument (a CIDR range) contains the
151 -- second (another CIDR range). There are a lot of ways we can be
152 -- fed junk here. For lack of a better alternative, just return
153 -- False when we are given nonsense.
155 -- If the number of bits in the network part of the first address is
156 -- larger than the number of bits in the second, there is no way
157 -- that the first range can contain the second. For, if the number
158 -- of network bits is larger, then the number of host bits must be
159 -- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
160 -- certainly does not contain cidr2.
162 -- On the other hand, if the first argument (cidr1) has fewer (or
163 -- the same number of) network bits as the second, it can contain
164 -- the second. In this case, we need to check that every host in
165 -- cidr2 is contained in cidr1. If a host in cidr2 is contained in
166 -- cidr1, then at least mbits1 of an address in cidr2 will match
167 -- cidr1. For example,
169 -- cidr1 = 192.168.1.0\/23, cidr2 = 192.168.1.100\/24
171 -- Here, cidr2 contains all of 192.168.1.0 through
172 -- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
173 -- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
174 -- what we want to check is that cidr2 "begins with" something that
175 -- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
176 -- cidr2 DOES, cidr1 contains cidr2..
178 -- The way that we check this is to apply cidr1's mask to cidr2's
179 -- address and see if the result is the same as cidr1's mask applied
180 -- to cidr1's address.
182 contains :: Cidr -> Cidr -> Bool
183 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
184 | mbits1 > mbits2 = False
185 | otherwise = addr1masked == addr2masked
187 addr1masked = apply_mask addr1 mbits1 B.Zero
188 addr2masked = apply_mask addr2 mbits1 B.Zero
191 -- | Contains but is not equal to.
192 contains_proper :: Cidr -> Cidr -> Bool
193 contains_proper cidr1 cidr2 =
194 (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
197 -- | A CIDR range is redundant (with respect to the given list) if
198 -- another CIDR range in that list properly contains it.
199 redundant :: [Cidr] -> Cidr -> Bool
200 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
203 -- | First, we look at all possible pairs of cidrs, and combine the
204 -- adjacent ones in to a new list. Then, we concatenate that list
205 -- with the original one, and filter out all of the redundancies. If
206 -- two adjacent Cidrs are combined into a larger one, they will be
207 -- removed in the second step since the larger Cidr must contain the
210 -- Once this is done, we see whether or not the result is different
211 -- than the argument that was passed in. If nothing changed, we're
212 -- done and return the list that was passed to us. However, if
213 -- something changed, we recurse and try to combine the list again.
214 combine_all :: [Cidr] -> [Cidr]
216 | cidrs == (combine_contained unique_cidrs) = cidrs
217 | otherwise = combine_all (combine_contained unique_cidrs)
219 unique_cidrs = nubBy equivalent cidr_combinations
221 cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
224 -- | Take a list of CIDR ranges and filter out all of the ones that
225 -- are contained entirelt within some other range in the list.
226 combine_contained :: [Cidr] -> [Cidr]
227 combine_contained cidrs =
228 filter (not . (redundant cidrs)) cidrs
231 -- | If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
232 -- decrement the maskbits of cidr1 and return that; it will contain
233 -- both cidr1 and cidr2.
234 combine_adjacent :: Cidr -> Cidr -> Maybe Cidr
235 combine_adjacent cidr1 cidr2
236 | not (adjacent cidr1 cidr2) = Nothing
237 | (maskbits cidr1 == Zero) = Nothing
238 | otherwise = Just $ cidr1 { maskbits = decrement (maskbits cidr1) }
242 -- | Determine whether or not two CIDR ranges are adjacent. If two
243 -- ranges lie consecutively within the IP space, they can be
244 -- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
245 -- and can be combined in to 10.1.0.0/23.
246 adjacent :: Cidr -> Cidr -> Bool
248 | mbits1 /= mbits2 = False
249 | mbits1 == Maskbits.Zero = False -- They're equal.
250 | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
252 addr1 = ipv4address cidr1
253 addr2 = ipv4address cidr2
254 mbits1 = maskbits cidr1
255 mbits2 = maskbits cidr2
258 enumerate :: Cidr -> [IPv4Address]
259 enumerate cidr = [(min_host cidr)..(max_host cidr)]
264 test_min_host1 :: Test
271 desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
272 actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24")
273 expected = "10.0.0.0"
276 test_max_host1 :: Test
283 desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
284 actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24")
285 expected = "10.0.0.255"
288 test_equality1 :: Test
296 desc = "10.1.1.0/23 equals itself"
297 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
300 test_contains1 :: Test
306 (cidr1 `contains` cidr2)
308 desc = "10.1.1.0/23 contains 10.1.1.0/24"
309 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
310 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
313 test_contains2 :: Test
319 (cidr1 `contains` cidr1)
321 desc = "10.1.1.0/23 contains itself"
322 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
325 test_contains_proper1 :: Test
326 test_contains_proper1 =
331 (cidr1 `contains_proper` cidr2)
333 desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
334 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
335 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
338 test_contains_proper2 :: Test
339 test_contains_proper2 =
344 (cidr1 `contains_proper` cidr1)
346 desc = "10.1.1.0/23 does not contain itself properly"
347 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
350 test_adjacent1 :: Test
356 (cidr1 `adjacent` cidr2)
358 desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
359 cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
360 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
363 test_adjacent2 :: Test
369 (cidr1 `adjacent` cidr2)
371 desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
372 cidr1 = fromJust $ cidr_from_string "10.1.0.0/23"
373 cidr2 = fromJust $ cidr_from_string "10.1.0.0/24"
376 test_adjacent3 :: Test
382 (cidr1 `adjacent` cidr2)
384 desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
385 cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
386 cidr2 = fromJust $ cidr_from_string "10.2.5.0/24"
389 test_adjacent4 :: Test
395 (cidr1 `adjacent` cidr2)
397 desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
398 cidr1 = fromJust $ cidr_from_string "10.1.1.0/24"
399 cidr2 = fromJust $ cidr_from_string "10.1.2.0/24"
402 test_combine_contained1 :: Test
403 test_combine_contained1 =
408 (combine_contained test_cidrs)
410 desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
411 cidr1 = fromJust $ cidr_from_string "10.0.0.0/8"
412 cidr2 = fromJust $ cidr_from_string "10.1.0.0/16"
413 cidr3 = fromJust $ cidr_from_string "10.1.1.0/24"
414 expected_cidrs = [cidr1]
415 test_cidrs = [cidr1, cidr2, cidr3]
418 test_combine_contained2 :: Test
419 test_combine_contained2 =
424 (combine_contained [cidr1, cidr2])
426 desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
427 cidr1 = fromJust $ cidr_from_string "192.168.3.0/23"
428 cidr2 = fromJust $ cidr_from_string "192.168.1.0/24"
431 test_combine_all1 :: Test
437 (combine_all test_cidrs)
439 desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
440 ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
441 cidr1 = fromJust $ cidr_from_string "10.0.0.0/24"
442 cidr2 = fromJust $ cidr_from_string "10.0.1.0/24"
443 cidr3 = fromJust $ cidr_from_string "10.0.2.0/24"
444 cidr4 = fromJust $ cidr_from_string "10.0.3.0/23"
445 cidr5 = fromJust $ cidr_from_string "10.0.0.0/23"
446 expected_cidrs = [fromJust $ cidr_from_string "10.0.0.0/22"]
447 test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
450 test_combine_all2 :: Test
456 (combine_all test_cidrs)
458 desc = "127.0.0.1/32 combines with itself recursively"
459 cidr1 = fromJust $ cidr_from_string "127.0.0.1/32"
460 expected_cidrs = [cidr1]
461 test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
464 test_combine_all3 :: Test
470 (combine_all test_cidrs)
472 desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
473 ++ "10.0.0.19 get combined into 10.0.0.16/30"
474 cidr1 = fromJust $ cidr_from_string "10.0.0.16/32"
475 cidr2 = fromJust $ cidr_from_string "10.0.0.17/32"
476 cidr3 = fromJust $ cidr_from_string "10.0.0.18/32"
477 cidr4 = fromJust $ cidr_from_string "10.0.0.19/32"
478 expected_cidrs = [fromJust $ cidr_from_string "10.0.0.16/30"]
479 test_cidrs = [cidr1, cidr2, cidr3, cidr4]
484 testGroup "CIDR Tests" [
490 test_contains_proper1,
491 test_contains_proper2,
496 test_combine_contained1,
497 test_combine_contained2,
504 prop_all_cidrs_contain_themselves :: Cidr -> Bool
505 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
508 -- If cidr1 properly contains cidr2, then by definition cidr2
509 -- does not properly contain cidr1.
510 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
511 prop_contains_proper_intransitive cidr1 cidr2 =
512 (cidr1 `contains_proper` cidr2) ==>
513 (not (cidr2 `contains_proper` cidr1))
515 cidr_properties :: Test
517 testGroup "CIDR Properties" [
519 "All CIDRs contain themselves"
520 prop_all_cidrs_contain_themselves,
523 "contains_proper is intransitive"
524 prop_contains_proper_intransitive