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, mapMaybe)
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, (==>))
32 import Text.Read (readMaybe)
34 import qualified Bit as B (Bit(..))
35 import IPv4Address (IPv4Address(..), most_sig_bit_different)
36 import Maskable (Maskable(..))
37 import Maskbits (Maskbits(..))
38 import Octet (Octet(..))
41 data Cidr = Cidr { ipv4address :: IPv4Address,
42 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 = readMaybe (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 =
81 (p1:p2:p3:p4:_) -> mapMaybe readMaybe [p1,p2,p3,p4]
84 parts = splitOneOf "./" s
86 instance Read Cidr where
87 -- | Parse everything or nothing.
89 case (octets_from_cidr_string s) of
90 [oct1, oct2, oct3, oct4] ->
91 case (maskbits_from_cidr_string s) of
93 [(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 = pred (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 testGroup "CIDR Tests" [
271 test_contains_proper1,
272 test_contains_proper2,
277 test_combine_contained1,
278 test_combine_contained2,
283 cidr_properties :: Test
285 testGroup "CIDR Properties" [
287 "All CIDRs contain themselves"
288 prop_all_cidrs_contain_themselves,
291 "contains_proper is intransitive"
292 prop_contains_proper_intransitive
297 test_enumerate :: Test
299 testCase desc $ assertEqual desc expected actual
301 desc = "192.168.0.240/30 is enumerated correctly"
305 mk_ip = IPv4Address oct1 oct2 oct3
306 addr1 = mk_ip $ toEnum 240
307 addr2 = mk_ip $ toEnum 241
308 addr3 = mk_ip $ toEnum 242
309 addr4 = mk_ip $ toEnum 243
310 expected = [addr1, addr2, addr3, addr4]
311 actual = enumerate $ read "192.168.0.240/30"
313 test_min_host1 :: Test
320 desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
321 actual = show $ min_host (read "10.0.0.0/24")
322 expected = "10.0.0.0"
325 test_max_host1 :: Test
332 desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
333 actual = show $ max_host (read "10.0.0.0/24")
334 expected = "10.0.0.255"
337 test_equality1 :: Test
345 desc = "10.1.1.0/23 equals itself"
346 cidr1 = read "10.1.1.0/23" :: Cidr
349 test_contains1 :: Test
355 (cidr1 `contains` cidr2)
357 desc = "10.1.1.0/23 contains 10.1.1.0/24"
358 cidr1 = read "10.1.1.0/23"
359 cidr2 = read "10.1.1.0/24"
362 test_contains2 :: Test
368 (cidr1 `contains` cidr1)
370 desc = "10.1.1.0/23 contains itself"
371 cidr1 = read "10.1.1.0/23"
374 test_contains_proper1 :: Test
375 test_contains_proper1 =
380 (cidr1 `contains_proper` cidr2)
382 desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
383 cidr1 = read "10.1.1.0/23"
384 cidr2 = read "10.1.1.0/24"
387 test_contains_proper2 :: Test
388 test_contains_proper2 =
393 (cidr1 `contains_proper` cidr1)
395 desc = "10.1.1.0/23 does not contain itself properly"
396 cidr1 = read "10.1.1.0/23"
399 test_adjacent1 :: Test
405 (cidr1 `adjacent` cidr2)
407 desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
408 cidr1 = read "10.1.0.0/24"
409 cidr2 = read "10.1.1.0/24"
412 test_adjacent2 :: Test
418 (cidr1 `adjacent` cidr2)
420 desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
421 cidr1 = read "10.1.0.0/23"
422 cidr2 = read "10.1.0.0/24"
425 test_adjacent3 :: Test
431 (cidr1 `adjacent` cidr2)
433 desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
434 cidr1 = read "10.1.0.0/24"
435 cidr2 = read "10.2.5.0/24"
438 test_adjacent4 :: Test
444 (cidr1 `adjacent` cidr2)
446 desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
447 cidr1 = read "10.1.1.0/24"
448 cidr2 = read "10.1.2.0/24"
451 test_combine_contained1 :: Test
452 test_combine_contained1 =
457 (combine_contained test_cidrs)
459 desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
460 cidr1 = read "10.0.0.0/8"
461 cidr2 = read "10.1.0.0/16"
462 cidr3 = read "10.1.1.0/24"
463 expected_cidrs = [cidr1]
464 test_cidrs = [cidr1, cidr2, cidr3]
467 test_combine_contained2 :: Test
468 test_combine_contained2 =
473 (combine_contained [cidr1, cidr2])
475 desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
476 cidr1 = read "192.168.3.0/23"
477 cidr2 = read "192.168.1.0/24"
480 test_combine_all1 :: Test
486 (combine_all test_cidrs)
488 desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
489 ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
490 cidr1 = read "10.0.0.0/24"
491 cidr2 = read "10.0.1.0/24"
492 cidr3 = read "10.0.2.0/24"
493 cidr4 = read "10.0.3.0/23"
494 cidr5 = read "10.0.0.0/23"
495 expected_cidrs = [read "10.0.0.0/22"]
496 test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
499 test_combine_all2 :: Test
505 (combine_all test_cidrs)
507 desc = "127.0.0.1/32 combines with itself recursively"
508 cidr1 = read "127.0.0.1/32"
509 expected_cidrs = [cidr1]
510 test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
513 test_combine_all3 :: Test
519 (combine_all test_cidrs)
521 desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
522 ++ "10.0.0.19 get combined into 10.0.0.16/30"
523 cidr1 = read "10.0.0.16/32"
524 cidr2 = read "10.0.0.17/32"
525 cidr3 = read "10.0.0.18/32"
526 cidr4 = read "10.0.0.19/32"
527 expected_cidrs = [read "10.0.0.16/30"]
528 test_cidrs = [cidr1, cidr2, cidr3, cidr4]
532 prop_all_cidrs_contain_themselves :: Cidr -> Bool
533 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
536 -- If cidr1 properly contains cidr2, then by definition cidr2
537 -- does not properly contain cidr1.
538 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
539 prop_contains_proper_intransitive cidr1 cidr2 =
540 (cidr1 `contains_proper` cidr2) ==>
541 (not (cidr2 `contains_proper` cidr1))