1 -- | The CIDR modules contains most of the functions used for working
19 prop_all_cidrs_contain_themselves,
20 prop_contains_proper_intransitive
23 import Data.List (nubBy)
24 import Data.List.Split (splitOneOf)
25 import Data.Maybe (catMaybes, fromJust)
27 import Test.HUnit (assertEqual)
28 import Test.Framework (Test, testGroup)
29 import Test.Framework.Providers.HUnit (testCase)
30 import Test.Framework.Providers.QuickCheck2 (testProperty)
31 import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
33 import qualified Bit as B
40 data Cidr = Cidr { ipv4address :: IPv4Address,
41 maskbits :: Maskbits }
45 instance Show Cidr where
46 show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
49 instance Arbitrary Cidr where
51 ipv4 <- arbitrary :: Gen IPv4Address
52 mask <- arbitrary :: Gen Maskbits
53 return (Cidr ipv4 mask)
56 instance Eq Cidr where
57 cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
60 -- | Two CIDR ranges are equivalent if they have the same network bits
61 -- and the masks are the same.
62 equivalent :: Cidr -> Cidr -> Bool
63 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
64 (mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
66 -- | Returns the mask portion of a CIDR address. That is, everything
67 -- after the trailing slash.
68 maskbits_from_cidr_string :: String -> Maybe Maskbits
69 maskbits_from_cidr_string s
70 | length partlist == 2 = maskbits_from_string (partlist !! 1)
73 partlist = splitOneOf "/" s
76 -- | Takes an IP address String in CIDR notation, and returns a list
77 -- of its octets (as Ints).
78 octets_from_cidr_string :: String -> [Octet]
79 octets_from_cidr_string s =
80 catMaybes $ map octet_from_string (take 4 (splitOneOf "./" s))
83 -- | Return Nothing if we can't parse both maskbits and octets from
85 cidr_from_string :: String -> Maybe Cidr
87 case (octets_from_cidr_string s) of
88 [oct1, oct2, oct3, oct4] ->
89 case (maskbits_from_cidr_string s) of
91 Just $ Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits
97 -- | Given a CIDR, return the minimum valid IPv4 address contained
99 min_host :: Cidr -> IPv4Address
100 min_host (Cidr addr mask) = apply_mask addr mask B.Zero
102 -- | Given a CIDR, return the maximum valid IPv4 address contained
104 max_host :: Cidr -> IPv4Address
105 max_host (Cidr addr mask) = apply_mask addr mask B.One
107 -- | Given a CIDR, return the first octet of the minimum valid IPv4
108 -- address contained within it.
109 min_octet1 :: Cidr -> Octet
110 min_octet1 cidr = octet1 (min_host cidr)
112 -- | Given a CIDR, return the second octet of the minimum valid IPv4
113 -- address contained within it.
114 min_octet2 :: Cidr -> Octet
115 min_octet2 cidr = octet2 (min_host cidr)
117 -- | Given a CIDR, return the third octet of the minimum valid IPv4
118 -- address contained within it.
119 min_octet3 :: Cidr -> Octet
120 min_octet3 cidr = octet3 (min_host cidr)
122 -- | Given a CIDR, return the fourth octet of the minimum valid IPv4
123 -- address contained within it.
124 min_octet4 :: Cidr -> Octet
125 min_octet4 cidr = octet4 (min_host cidr)
127 -- | Given a CIDR, return the first octet of the maximum valid IPv4
128 -- address contained within it.
129 max_octet1 :: Cidr -> Octet
130 max_octet1 cidr = octet1 (max_host cidr)
132 -- | Given a CIDR, return the second octet of the maximum valid IPv4
133 -- address contained within it.
134 max_octet2 :: Cidr -> Octet
135 max_octet2 cidr = octet2 (max_host cidr)
137 -- | Given a CIDR, return the third octet of the maximum valid IPv4
138 -- address contained within it.
139 max_octet3 :: Cidr -> Octet
140 max_octet3 cidr = octet3 (max_host cidr)
142 -- | Given a CIDR, return the fourth octet of the maximum valid IPv4
143 -- address contained within it.
144 max_octet4 :: Cidr -> Octet
145 max_octet4 cidr = octet4 (max_host cidr)
149 -- | Return true if the first argument (a CIDR range) contains the
150 -- second (another CIDR range). There are a lot of ways we can be
151 -- fed junk here. For lack of a better alternative, just return
152 -- False when we are given nonsense.
154 -- If the number of bits in the network part of the first address is
155 -- larger than the number of bits in the second, there is no way
156 -- that the first range can contain the second. For, if the number
157 -- of network bits is larger, then the number of host bits must be
158 -- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
159 -- certainly does not contain cidr2.
161 -- On the other hand, if the first argument (cidr1) has fewer (or
162 -- the same number of) network bits as the second, it can contain
163 -- the second. In this case, we need to check that every host in
164 -- cidr2 is contained in cidr1. If a host in cidr2 is contained in
165 -- cidr1, then at least mbits1 of an address in cidr2 will match
166 -- cidr1. For example,
168 -- cidr1 = 192.168.1.0\/23, cidr2 = 192.168.1.100\/24
170 -- Here, cidr2 contains all of 192.168.1.0 through
171 -- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
172 -- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
173 -- what we want to check is that cidr2 "begins with" something that
174 -- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
175 -- cidr2 DOES, cidr1 contains cidr2..
177 -- The way that we check this is to apply cidr1's mask to cidr2's
178 -- address and see if the result is the same as cidr1's mask applied
179 -- to cidr1's address.
181 contains :: Cidr -> Cidr -> Bool
182 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
183 | mbits1 > mbits2 = False
184 | otherwise = addr1masked == addr2masked
186 addr1masked = apply_mask addr1 mbits1 B.Zero
187 addr2masked = apply_mask addr2 mbits1 B.Zero
190 -- | Contains but is not equal to.
191 contains_proper :: Cidr -> Cidr -> Bool
192 contains_proper cidr1 cidr2 =
193 (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
196 -- | A CIDR range is redundant (with respect to the given list) if
197 -- another CIDR range in that list properly contains it.
198 redundant :: [Cidr] -> Cidr -> Bool
199 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
202 -- | First, we look at all possible pairs of cidrs, and combine the
203 -- adjacent ones in to a new list. Then, we concatenate that list
204 -- with the original one, and filter out all of the redundancies. If
205 -- two adjacent Cidrs are combined into a larger one, they will be
206 -- removed in the second step since the larger Cidr must contain the
209 -- Once this is done, we see whether or not the result is different
210 -- than the argument that was passed in. If nothing changed, we're
211 -- done and return the list that was passed to us. However, if
212 -- something changed, we recurse and try to combine the list again.
213 combine_all :: [Cidr] -> [Cidr]
215 | cidrs == (combine_contained unique_cidrs) = cidrs
216 | otherwise = combine_all (combine_contained unique_cidrs)
218 unique_cidrs = nubBy equivalent cidr_combinations
220 cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
223 -- | Take a list of CIDR ranges and filter out all of the ones that
224 -- are contained entirelt within some other range in the list.
225 combine_contained :: [Cidr] -> [Cidr]
226 combine_contained cidrs =
227 filter (not . (redundant cidrs)) cidrs
230 -- | If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
231 -- decrement the maskbits of cidr1 and return that; it will contain
232 -- both cidr1 and cidr2.
233 combine_adjacent :: Cidr -> Cidr -> Maybe Cidr
234 combine_adjacent cidr1 cidr2
235 | not (adjacent cidr1 cidr2) = Nothing
236 | (maskbits cidr1 == Zero) = Nothing
237 | otherwise = Just $ cidr1 { maskbits = decrement (maskbits cidr1) }
241 -- | Determine whether or not two CIDR ranges are adjacent. If two
242 -- ranges lie consecutively within the IP space, they can be
243 -- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
244 -- and can be combined in to 10.1.0.0/23.
245 adjacent :: Cidr -> Cidr -> Bool
247 | mbits1 /= mbits2 = False
248 | mbits1 == Maskbits.Zero = False -- They're equal.
249 | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
251 addr1 = ipv4address cidr1
252 addr2 = ipv4address cidr2
253 mbits1 = maskbits cidr1
254 mbits2 = maskbits cidr2
262 test_min_host1 :: Test
269 desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
270 actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24")
271 expected = "10.0.0.0"
274 test_max_host1 :: Test
281 desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
282 actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24")
283 expected = "10.0.0.255"
286 test_equality1 :: Test
294 desc = "10.1.1.0/23 equals itself"
295 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
298 test_contains1 :: Test
304 (cidr1 `contains` cidr2)
306 desc = "10.1.1.0/23 contains 10.1.1.0/24"
307 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
308 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
311 test_contains2 :: Test
317 (cidr1 `contains` cidr1)
319 desc = "10.1.1.0/23 contains itself"
320 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
323 test_contains_proper1 :: Test
324 test_contains_proper1 =
329 (cidr1 `contains_proper` cidr2)
331 desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
332 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
333 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
336 test_contains_proper2 :: Test
337 test_contains_proper2 =
342 (cidr1 `contains_proper` cidr1)
344 desc = "10.1.1.0/23 does not contain itself properly"
345 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
348 test_adjacent1 :: Test
354 (cidr1 `adjacent` cidr2)
356 desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
357 cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
358 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
361 test_adjacent2 :: Test
367 (cidr1 `adjacent` cidr2)
369 desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
370 cidr1 = fromJust $ cidr_from_string "10.1.0.0/23"
371 cidr2 = fromJust $ cidr_from_string "10.1.0.0/24"
374 test_adjacent3 :: Test
380 (cidr1 `adjacent` cidr2)
382 desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
383 cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
384 cidr2 = fromJust $ cidr_from_string "10.2.5.0/24"
387 test_adjacent4 :: Test
393 (cidr1 `adjacent` cidr2)
395 desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
396 cidr1 = fromJust $ cidr_from_string "10.1.1.0/24"
397 cidr2 = fromJust $ cidr_from_string "10.1.2.0/24"
400 test_combine_contained1 :: Test
401 test_combine_contained1 =
406 (combine_contained test_cidrs)
408 desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
409 cidr1 = fromJust $ cidr_from_string "10.0.0.0/8"
410 cidr2 = fromJust $ cidr_from_string "10.1.0.0/16"
411 cidr3 = fromJust $ cidr_from_string "10.1.1.0/24"
412 expected_cidrs = [cidr1]
413 test_cidrs = [cidr1, cidr2, cidr3]
416 test_combine_contained2 :: Test
417 test_combine_contained2 =
422 (combine_contained [cidr1, cidr2])
424 desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
425 cidr1 = fromJust $ cidr_from_string "192.168.3.0/23"
426 cidr2 = fromJust $ cidr_from_string "192.168.1.0/24"
429 test_combine_all1 :: Test
435 (combine_all test_cidrs)
437 desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
438 ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
439 cidr1 = fromJust $ cidr_from_string "10.0.0.0/24"
440 cidr2 = fromJust $ cidr_from_string "10.0.1.0/24"
441 cidr3 = fromJust $ cidr_from_string "10.0.2.0/24"
442 cidr4 = fromJust $ cidr_from_string "10.0.3.0/23"
443 cidr5 = fromJust $ cidr_from_string "10.0.0.0/23"
444 expected_cidrs = [fromJust $ cidr_from_string "10.0.0.0/22"]
445 test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
448 test_combine_all2 :: Test
454 (combine_all test_cidrs)
456 desc = "127.0.0.1/32 combines with itself recursively"
457 cidr1 = fromJust $ cidr_from_string "127.0.0.1/32"
458 expected_cidrs = [cidr1]
459 test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
462 test_combine_all3 :: Test
468 (combine_all test_cidrs)
470 desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
471 ++ "10.0.0.19 get combined into 10.0.0.16/30"
472 cidr1 = fromJust $ cidr_from_string "10.0.0.16/32"
473 cidr2 = fromJust $ cidr_from_string "10.0.0.17/32"
474 cidr3 = fromJust $ cidr_from_string "10.0.0.18/32"
475 cidr4 = fromJust $ cidr_from_string "10.0.0.19/32"
476 expected_cidrs = [fromJust $ cidr_from_string "10.0.0.16/30"]
477 test_cidrs = [cidr1, cidr2, cidr3, cidr4]
482 testGroup "CIDR Tests" [
488 test_contains_proper1,
489 test_contains_proper2,
494 test_combine_contained1,
495 test_combine_contained2,
502 prop_all_cidrs_contain_themselves :: Cidr -> Bool
503 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
506 -- If cidr1 properly contains cidr2, then by definition cidr2
507 -- does not properly contain cidr1.
508 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
509 prop_contains_proper_intransitive cidr1 cidr2 =
510 (cidr1 `contains_proper` cidr2) ==>
511 (not (cidr2 `contains_proper` cidr1))
513 cidr_properties :: Test
515 testGroup "CIDR Properties" [
517 "All CIDRs contain themselves"
518 prop_all_cidrs_contain_themselves,
521 "contains_proper is intransitive"
522 prop_contains_proper_intransitive