8 import Data.List (nubBy)
18 data Cidr = None | Cidr { ipv4address :: IPv4Address,
19 maskbits :: Maskbits }
23 instance Show Cidr where
24 show Cidr.None = "None"
25 show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
28 -- Two CIDR ranges are equivalent if they have the same network bits
29 -- and the masks are the same.
30 equivalent :: Cidr -> Cidr -> Bool
31 equivalent Cidr.None Cidr.None = True
32 equivalent Cidr.None _ = False
33 equivalent _ Cidr.None = False
34 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
35 (mbits1 == mbits2) && ((apply_mask addr1 mbits1) == (apply_mask addr2 mbits2))
37 -- Returns the mask portion of a CIDR address. That is, everything
38 -- after the trailing slash.
39 maskbits_from_cidr_string :: String -> Maskbits
40 maskbits_from_cidr_string s =
41 maskbits_from_string ((splitWith (`elem` "/") s) !! 1)
44 -- Takes an IP address String in CIDR notation, and returns a list of
45 -- its octets (as Ints).
46 octets_from_cidr_string :: String -> [Octet]
47 octets_from_cidr_string s =
48 map octet_from_string (take 4 (splitWith (`elem` "./") s))
51 cidr_from_string :: String -> Cidr
53 | addr == IPv4Address.None = Cidr.None
54 | mbits == Maskbits.None = Cidr.None
55 | otherwise = Cidr addr mbits
57 addr = ipv4address_from_octets (oct1) (oct2) (oct3) (oct4)
62 octs = octets_from_cidr_string s
63 mbits = maskbits_from_cidr_string s
67 -- Return true if the first argument (a CIDR range) contains the
68 -- second (another CIDR range). There are a lot of ways we can be fed
69 -- junk here. For lack of a better alternative, just return False when
70 -- we are given nonsense.
71 contains :: Cidr -> Cidr -> Bool
72 contains Cidr.None _ = False
73 contains _ Cidr.None = False
74 contains (Cidr _ Maskbits.None) _ = False
75 contains (Cidr IPv4Address.None _) _ = False
76 contains _ (Cidr _ Maskbits.None) = False
77 contains _ (Cidr IPv4Address.None _) = False
79 -- If the number of bits in the network part of the first address is
80 -- larger than the number of bits in the second, there is no way that
81 -- the first range can contain the second. For, if the number of
82 -- network bits is larger, then the number of host bits must be
83 -- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
84 -- certainly does not contain cidr2.
86 -- On the other hand, if the first argument (cidr1) has fewer (or the
87 -- same number of) network bits as the second, it can contain the
88 -- second. In this case, we need to check that every host in cidr2 is
89 -- contained in cidr1. If a host in cidr2 is contained in cidr1, then
90 -- at least mbits1 of an address in cidr2 will match cidr1. For
93 -- cidr1 = 192.168.1.0/23, cidr2 = 192.168.1.100/24
95 -- Here, cidr2 contains all of 192.168.1.0 through
96 -- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
97 -- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
98 -- what we want to check is that cidr2 "begins with" something that
99 -- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
100 -- cidr2 DOES, cidr1 contains cidr2..
102 -- The way that we check this is to apply cidr1's mask to cidr2's
103 -- address and see if the result is the same as cidr1's mask applied
104 -- to cidr1's address.
106 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
107 | mbits1 > mbits2 = False
108 | otherwise = addr1masked == addr2masked
110 addr1masked = apply_mask addr1 mbits1
111 addr2masked = apply_mask addr2 mbits1
114 contains_proper :: Cidr -> Cidr -> Bool
115 contains_proper cidr1 cidr2 =
116 (cidr1 `contains` cidr2) && (not (cidr1 == cidr2))
119 -- A CIDR range is redundant (with respect to the given list) if
120 -- another CIDR range in that list properly contains it.
121 redundant :: [Cidr] -> Cidr -> Bool
122 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
125 -- First, we look at all possible pairs of cidrs, and combine the
126 -- adjacent ones in to a new list. Then, we concatenate that list with
127 -- the original one, and filter out all of the redundancies. If two
128 -- adjacent Cidrs are combined into a larger one, they will be removed
129 -- in the second step since the larger Cidr must contain the smaller
131 combine_all :: [Cidr] -> [Cidr]
133 combine_contained unique_cidrs
135 unique_cidrs = nubBy equivalent valid_cidr_combinations
136 valid_cidr_combinations = filter (/= Cidr.None) cidr_combinations
138 cidrs ++ [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ]
141 -- Take a list of CIDR ranges and filter out all of the ones that are
142 -- contained entirelt within some other range in the list.
143 combine_contained :: [Cidr] -> [Cidr]
144 combine_contained cidrs =
145 filter (not . (redundant cidrs)) cidrs
148 -- If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
149 -- decrement the maskbits of cidr1 and return that; it will contain
150 -- both cidr1 and cidr2.
151 combine_adjacent :: Cidr -> Cidr -> Cidr
152 combine_adjacent cidr1 cidr2
153 | not (adjacent cidr1 cidr2) = Cidr.None
154 | (maskbits cidr1 == Zero) = Cidr.None
155 | otherwise = cidr1 { maskbits = decrement (maskbits cidr1) }
159 -- Determine whether or not two CIDR ranges are adjacent. If two
160 -- ranges lie consecutively within the IP space, they can be
161 -- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
162 -- and can be combined in to 10.1.0.0/23.
163 adjacent :: Cidr -> Cidr -> Bool
164 adjacent Cidr.None _ = False
165 adjacent _ Cidr.None = False
167 | mbits1 /= mbits2 = False
168 | mbits1 == Maskbits.Zero = False -- They're equal.
169 | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
171 addr1 = ipv4address cidr1
172 addr2 = ipv4address cidr2
173 mbits1 = maskbits cidr1
174 mbits2 = maskbits cidr2
182 test_equality1 :: Test
184 TestCase $ assertEqual "10.1.1.0/23 equals itself" True (cidr1 == cidr1)
186 cidr1 = cidr_from_string "10.1.1.0/23"
189 test_contains1 :: Test
191 TestCase $ assertEqual "10.1.1.0/23 contains 10.1.1.0/24" True (cidr1 `contains` cidr2)
193 cidr1 = cidr_from_string "10.1.1.0/23"
194 cidr2 = cidr_from_string "10.1.1.0/24"
197 test_contains2 :: Test
199 TestCase $ assertEqual "10.1.1.0/23 contains itself" True (cidr1 `contains` cidr1)
201 cidr1 = cidr_from_string "10.1.1.0/23"
204 test_contains_proper1 :: Test
205 test_contains_proper1 =
206 TestCase $ assertEqual "10.1.1.0/23 contains 10.1.1.0/24 properly" True (cidr1 `contains_proper` cidr2)
208 cidr1 = cidr_from_string "10.1.1.0/23"
209 cidr2 = cidr_from_string "10.1.1.0/24"
212 test_contains_proper2 :: Test
213 test_contains_proper2 =
214 TestCase $ assertEqual "10.1.1.0/23 does not contain itself properly" False (cidr1 `contains_proper` cidr1)
216 cidr1 = cidr_from_string "10.1.1.0/23"
219 test_adjacent1 :: Test
221 TestCase $ assertEqual "10.1.0.0/24 is adjacent to 10.1.1.0/24" True (cidr1 `adjacent` cidr2)
223 cidr1 = cidr_from_string "10.1.0.0/24"
224 cidr2 = cidr_from_string "10.1.1.0/24"
227 test_adjacent2 :: Test
229 TestCase $ assertEqual "10.1.0.0/23 is not adjacent to 10.1.0.0/24" False (cidr1 `adjacent` cidr2)
231 cidr1 = cidr_from_string "10.1.0.0/23"
232 cidr2 = cidr_from_string "10.1.0.0/24"
235 test_adjacent3 :: Test
237 TestCase $ assertEqual "10.1.0.0/24 is not adjacent to 10.2.5.0/24" False (cidr1 `adjacent` cidr2)
239 cidr1 = cidr_from_string "10.1.0.0/24"
240 cidr2 = cidr_from_string "10.2.5.0/24"
243 test_adjacent4 :: Test
245 TestCase $ assertEqual "10.1.1.0/24 is not adjacent to 10.1.2.0/24" False (cidr1 `adjacent` cidr2)
247 cidr1 = cidr_from_string "10.1.1.0/24"
248 cidr2 = cidr_from_string "10.1.2.0/24"
252 cidr_tests = [ test_equality1,
255 test_contains_proper1,
256 test_contains_proper2,