17 prop_all_cidrs_contain_themselves,
18 prop_contains_proper_intransitive
21 import Data.List (nubBy)
22 import Data.Maybe (catMaybes, fromJust)
24 import Test.HUnit (assertEqual)
25 import Test.Framework (Test, testGroup)
26 import Test.Framework.Providers.HUnit (testCase)
27 import Test.Framework.Providers.QuickCheck2 (testProperty)
28 import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
30 import qualified Bit as B
38 data Cidr = Cidr { ipv4address :: IPv4Address,
39 maskbits :: Maskbits }
43 instance Show Cidr where
44 show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
47 instance Arbitrary Cidr where
49 ipv4 <- arbitrary :: Gen IPv4Address
50 mask <- arbitrary :: Gen Maskbits
51 return (Cidr ipv4 mask)
54 instance Eq Cidr where
55 cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
58 -- Two CIDR ranges are equivalent if they have the same network bits
59 -- and the masks are the same.
60 equivalent :: Cidr -> Cidr -> Bool
61 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
62 (mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
64 -- Returns the mask portion of a CIDR address. That is, everything
65 -- after the trailing slash.
66 maskbits_from_cidr_string :: String -> Maybe Maskbits
67 maskbits_from_cidr_string s
68 | length partlist == 2 = maskbits_from_string (partlist !! 1)
71 partlist = (splitWith (`elem` "/") s)
74 -- | Takes an IP address String in CIDR notation, and returns a list
75 -- of its octets (as Ints).
76 octets_from_cidr_string :: String -> [Octet]
77 octets_from_cidr_string s =
78 catMaybes $ map octet_from_string (take 4 (splitWith (`elem` "./") s))
81 -- | Return Nothing if we can't parse both maskbits and octets from
83 cidr_from_string :: String -> Maybe Cidr
85 case (octets_from_cidr_string s) of
86 [oct1, oct2, oct3, oct4] ->
87 case (maskbits_from_cidr_string s) of
89 Just $ Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits
95 min_host :: Cidr -> IPv4Address
96 min_host (Cidr addr mask) = apply_mask addr mask B.Zero
99 max_host :: Cidr -> IPv4Address
100 max_host (Cidr addr mask) = apply_mask addr mask B.One
103 min_octet1 :: Cidr -> Octet
104 min_octet1 cidr = octet1 (min_host cidr)
106 min_octet2 :: Cidr -> Octet
107 min_octet2 cidr = octet2 (min_host cidr)
109 min_octet3 :: Cidr -> Octet
110 min_octet3 cidr = octet3 (min_host cidr)
112 min_octet4 :: Cidr -> Octet
113 min_octet4 cidr = octet4 (min_host cidr)
115 max_octet1 :: Cidr -> Octet
116 max_octet1 cidr = octet1 (max_host cidr)
118 max_octet2 :: Cidr -> Octet
119 max_octet2 cidr = octet2 (max_host cidr)
121 max_octet3 :: Cidr -> Octet
122 max_octet3 cidr = octet3 (max_host cidr)
124 max_octet4 :: Cidr -> Octet
125 max_octet4 cidr = octet4 (max_host cidr)
129 -- | Return true if the first argument (a CIDR range) contains the
130 -- second (another CIDR range). There are a lot of ways we can be
131 -- fed junk here. For lack of a better alternative, just return
132 -- False when we are given nonsense.
134 -- If the number of bits in the network part of the first address is
135 -- larger than the number of bits in the second, there is no way
136 -- that the first range can contain the second. For, if the number
137 -- of network bits is larger, then the number of host bits must be
138 -- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
139 -- certainly does not contain cidr2.
141 -- On the other hand, if the first argument (cidr1) has fewer (or
142 -- the same number of) network bits as the second, it can contain
143 -- the second. In this case, we need to check that every host in
144 -- cidr2 is contained in cidr1. If a host in cidr2 is contained in
145 -- cidr1, then at least mbits1 of an address in cidr2 will match
146 -- cidr1. For example,
148 -- cidr1 = 192.168.1.0/23, cidr2 = 192.168.1.100/24
150 -- Here, cidr2 contains all of 192.168.1.0 through
151 -- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
152 -- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
153 -- what we want to check is that cidr2 "begins with" something that
154 -- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
155 -- cidr2 DOES, cidr1 contains cidr2..
157 -- The way that we check this is to apply cidr1's mask to cidr2's
158 -- address and see if the result is the same as cidr1's mask applied
159 -- to cidr1's address.
161 contains :: Cidr -> Cidr -> Bool
162 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
163 | mbits1 > mbits2 = False
164 | otherwise = addr1masked == addr2masked
166 addr1masked = apply_mask addr1 mbits1 B.Zero
167 addr2masked = apply_mask addr2 mbits1 B.Zero
170 contains_proper :: Cidr -> Cidr -> Bool
171 contains_proper cidr1 cidr2 =
172 (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
175 -- | A CIDR range is redundant (with respect to the given list) if
176 -- another CIDR range in that list properly contains it.
177 redundant :: [Cidr] -> Cidr -> Bool
178 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
181 -- | First, we look at all possible pairs of cidrs, and combine the
182 -- adjacent ones in to a new list. Then, we concatenate that list
183 -- with the original one, and filter out all of the redundancies. If
184 -- two adjacent Cidrs are combined into a larger one, they will be
185 -- removed in the second step since the larger Cidr must contain the
188 -- Once this is done, we see whether or not the result is different
189 -- than the argument that was passed in. If nothing changed, we're
190 -- done and return the list that was passed to us. However, if
191 -- something changed, we recurse and try to combine the list again.
192 combine_all :: [Cidr] -> [Cidr]
194 | cidrs == (combine_contained unique_cidrs) = cidrs
195 | otherwise = combine_all (combine_contained unique_cidrs)
197 unique_cidrs = nubBy equivalent cidr_combinations
199 cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
202 -- | Take a list of CIDR ranges and filter out all of the ones that
203 -- are contained entirelt within some other range in the list.
204 combine_contained :: [Cidr] -> [Cidr]
205 combine_contained cidrs =
206 filter (not . (redundant cidrs)) cidrs
209 -- | If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
210 -- decrement the maskbits of cidr1 and return that; it will contain
211 -- both cidr1 and cidr2.
212 combine_adjacent :: Cidr -> Cidr -> Maybe Cidr
213 combine_adjacent cidr1 cidr2
214 | not (adjacent cidr1 cidr2) = Nothing
215 | (maskbits cidr1 == Zero) = Nothing
216 | otherwise = Just $ cidr1 { maskbits = decrement (maskbits cidr1) }
220 -- | Determine whether or not two CIDR ranges are adjacent. If two
221 -- ranges lie consecutively within the IP space, they can be
222 -- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
223 -- and can be combined in to 10.1.0.0/23.
224 adjacent :: Cidr -> Cidr -> Bool
226 | mbits1 /= mbits2 = False
227 | mbits1 == Maskbits.Zero = False -- They're equal.
228 | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
230 addr1 = ipv4address cidr1
231 addr2 = ipv4address cidr2
232 mbits1 = maskbits cidr1
233 mbits2 = maskbits cidr2
241 test_min_host1 :: Test
248 desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
249 actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24")
250 expected = "10.0.0.0"
253 test_max_host1 :: Test
260 desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
261 actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24")
262 expected = "10.0.0.255"
265 test_equality1 :: Test
273 desc = "10.1.1.0/23 equals itself"
274 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
277 test_contains1 :: Test
283 (cidr1 `contains` cidr2)
285 desc = "10.1.1.0/23 contains 10.1.1.0/24"
286 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
287 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
290 test_contains2 :: Test
296 (cidr1 `contains` cidr1)
298 desc = "10.1.1.0/23 contains itself"
299 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
302 test_contains_proper1 :: Test
303 test_contains_proper1 =
308 (cidr1 `contains_proper` cidr2)
310 desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
311 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
312 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
315 test_contains_proper2 :: Test
316 test_contains_proper2 =
321 (cidr1 `contains_proper` cidr1)
323 desc = "10.1.1.0/23 does not contain itself properly"
324 cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
327 test_adjacent1 :: Test
333 (cidr1 `adjacent` cidr2)
335 desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
336 cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
337 cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
340 test_adjacent2 :: Test
346 (cidr1 `adjacent` cidr2)
348 desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
349 cidr1 = fromJust $ cidr_from_string "10.1.0.0/23"
350 cidr2 = fromJust $ cidr_from_string "10.1.0.0/24"
353 test_adjacent3 :: Test
359 (cidr1 `adjacent` cidr2)
361 desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
362 cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
363 cidr2 = fromJust $ cidr_from_string "10.2.5.0/24"
366 test_adjacent4 :: Test
372 (cidr1 `adjacent` cidr2)
374 desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
375 cidr1 = fromJust $ cidr_from_string "10.1.1.0/24"
376 cidr2 = fromJust $ cidr_from_string "10.1.2.0/24"
379 test_combine_contained1 :: Test
380 test_combine_contained1 =
385 (combine_contained test_cidrs)
387 desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
388 cidr1 = fromJust $ cidr_from_string "10.0.0.0/8"
389 cidr2 = fromJust $ cidr_from_string "10.1.0.0/16"
390 cidr3 = fromJust $ cidr_from_string "10.1.1.0/24"
391 expected_cidrs = [cidr1]
392 test_cidrs = [cidr1, cidr2, cidr3]
395 test_combine_contained2 :: Test
396 test_combine_contained2 =
401 (combine_contained [cidr1, cidr2])
403 desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
404 cidr1 = fromJust $ cidr_from_string "192.168.3.0/23"
405 cidr2 = fromJust $ cidr_from_string "192.168.1.0/24"
408 test_combine_all1 :: Test
414 (combine_all test_cidrs)
416 desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
417 ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
418 cidr1 = fromJust $ cidr_from_string "10.0.0.0/24"
419 cidr2 = fromJust $ cidr_from_string "10.0.1.0/24"
420 cidr3 = fromJust $ cidr_from_string "10.0.2.0/24"
421 cidr4 = fromJust $ cidr_from_string "10.0.3.0/23"
422 cidr5 = fromJust $ cidr_from_string "10.0.0.0/23"
423 expected_cidrs = [fromJust $ cidr_from_string "10.0.0.0/22"]
424 test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
427 test_combine_all2 :: Test
433 (combine_all test_cidrs)
435 desc = "127.0.0.1/32 combines with itself recursively"
436 cidr1 = fromJust $ cidr_from_string "127.0.0.1/32"
437 expected_cidrs = [cidr1]
438 test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
441 test_combine_all3 :: Test
447 (combine_all test_cidrs)
449 desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
450 ++ "10.0.0.19 get combined into 10.0.0.16/30"
451 cidr1 = fromJust $ cidr_from_string "10.0.0.16/32"
452 cidr2 = fromJust $ cidr_from_string "10.0.0.17/32"
453 cidr3 = fromJust $ cidr_from_string "10.0.0.18/32"
454 cidr4 = fromJust $ cidr_from_string "10.0.0.19/32"
455 expected_cidrs = [fromJust $ cidr_from_string "10.0.0.16/30"]
456 test_cidrs = [cidr1, cidr2, cidr3, cidr4]
461 testGroup "CIDR Tests" [
467 test_contains_proper1,
468 test_contains_proper2,
473 test_combine_contained1,
474 test_combine_contained2,
481 prop_all_cidrs_contain_themselves :: Cidr -> Bool
482 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
485 -- If cidr1 properly contains cidr2, then by definition cidr2
486 -- does not properly contain cidr1.
487 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
488 prop_contains_proper_intransitive cidr1 cidr2 =
489 (cidr1 `contains_proper` cidr2) ==>
490 (not (cidr2 `contains_proper` cidr1))
492 cidr_properties :: Test
494 testGroup "CIDR Properties" [
496 "All CIDRs contain themselves"
497 prop_all_cidrs_contain_themselves,
500 "contains_proper is intransitive"
501 prop_contains_proper_intransitive