src/Cidr.hs

   1 module Cidr
   2 ( Cidr(..),
   3   cidr_from_string,
   4   cidr_tests,
   5   combine_all,
   6   contains,
   7   contains_proper,
   8   prop_all_cidrs_contain_themselves,
   9   prop_contains_proper_intransitive
  10 ) where
  11
  12 import Data.List (nubBy)
  13 import Test.HUnit
  14 import Test.QuickCheck
  15
  16 import IPv4Address
  17 import ListUtils
  18 import Maskable
  19 import Maskbits
  20 import Octet
  21
  22
  23 data Cidr = None | Cidr { ipv4address :: IPv4Address,
  24                           maskbits :: Maskbits }
  25             deriving (Eq)
  26
  27
  28 instance Show Cidr where
  29     show Cidr.None = "None"
  30     show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
  31
  32
  33 instance Arbitrary Cidr where
  34     arbitrary = do
  35       ipv4 <- arbitrary :: Gen IPv4Address
  36       mask <- arbitrary :: Gen Maskbits
  37       return (Cidr ipv4 mask)
  38
  39     coarbitrary _ = variant 0
  40
  41
  42 -- Two CIDR ranges are equivalent if they have the same network bits
  43 -- and the masks are the same.
  44 equivalent :: Cidr -> Cidr -> Bool
  45 equivalent Cidr.None Cidr.None = True
  46 equivalent Cidr.None _ = False
  47 equivalent _ Cidr.None = False
  48 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
  49     (mbits1 == mbits2) && ((apply_mask addr1 mbits1) == (apply_mask addr2 mbits2))
  50
  51 -- Returns the mask portion of a CIDR address. That is, everything
  52 -- after the trailing slash.
  53 maskbits_from_cidr_string :: String -> Maskbits
  54 maskbits_from_cidr_string s =
  55     maskbits_from_string ((splitWith (`elem` "/") s) !! 1)
  56
  57
  58 -- Takes an IP address String in CIDR notation, and returns a list of
  59 -- its octets (as Ints).
  60 octets_from_cidr_string :: String -> [Octet]
  61 octets_from_cidr_string s =
  62     map octet_from_string (take 4 (splitWith (`elem` "./") s))
  63
  64
  65 cidr_from_string :: String -> Cidr
  66 cidr_from_string s
  67     | addr  == IPv4Address.None = Cidr.None
  68     | mbits == Maskbits.None    = Cidr.None
  69     | otherwise = Cidr addr mbits
  70                where
  71                  addr = ipv4address_from_octets (oct1) (oct2) (oct3) (oct4)
  72                  oct1 = (octs !! 0)
  73                  oct2 = (octs !! 1)
  74                  oct3 = (octs !! 2)
  75                  oct4 = (octs !! 3)
  76                  octs  = octets_from_cidr_string s
  77                  mbits = maskbits_from_cidr_string s
  78
  79
  80
  81 -- Return true if the first argument (a CIDR range) contains the
  82 -- second (another CIDR range). There are a lot of ways we can be fed
  83 -- junk here. For lack of a better alternative, just return False when
  84 -- we are given nonsense.
  85 contains :: Cidr -> Cidr -> Bool
  86 contains Cidr.None _ = False
  87 contains _ Cidr.None = False
  88 contains (Cidr _ Maskbits.None) _    = False
  89 contains (Cidr IPv4Address.None _) _ = False
  90 contains _ (Cidr _ Maskbits.None)    = False
  91 contains _ (Cidr IPv4Address.None _) = False
  92
  93 -- If the number of bits in the network part of the first address is
  94 -- larger than the number of bits in the second, there is no way that
  95 -- the first range can contain the second. For, if the number of
  96 -- network bits is larger, then the number of host bits must be
  97 -- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
  98 -- certainly does not contain cidr2.
  99 --
 100 -- On the other hand, if the first argument (cidr1) has fewer (or the
 101 -- same number of) network bits as the second, it can contain the
 102 -- second. In this case, we need to check that every host in cidr2 is
 103 -- contained in cidr1. If a host in cidr2 is contained in cidr1, then
 104 -- at least mbits1 of an address in cidr2 will match cidr1. For
 105 -- example,
 106 --
 107 -- cidr1 = 192.168.1.0/23, cidr2 = 192.168.1.100/24
 108 --
 109 -- Here, cidr2 contains all of 192.168.1.0 through
 110 -- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
 111 -- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
 112 -- what we want to check is that cidr2 "begins with" something that
 113 -- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
 114 -- cidr2 DOES, cidr1 contains cidr2..
 115 --
 116 -- The way that we check this is to apply cidr1's mask to cidr2's
 117 -- address and see if the result is the same as cidr1's mask applied
 118 -- to cidr1's address.
 119 --
 120 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
 121     | mbits1 > mbits2 = False
 122     | otherwise = addr1masked == addr2masked
 123     where
 124       addr1masked = apply_mask addr1 mbits1
 125       addr2masked = apply_mask addr2 mbits1
 126
 127
 128 contains_proper :: Cidr -> Cidr -> Bool
 129 contains_proper cidr1 cidr2 =
 130     (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
 131
 132
 133 -- A CIDR range is redundant (with respect to the given list) if
 134 -- another CIDR range in that list properly contains it.
 135 redundant :: [Cidr] -> Cidr -> Bool
 136 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
 137
 138
 139 -- First, we look at all possible pairs of cidrs, and combine the
 140 -- adjacent ones in to a new list. Then, we concatenate that list with
 141 -- the original one, and filter out all of the redundancies. If two
 142 -- adjacent Cidrs are combined into a larger one, they will be removed
 143 -- in the second step since the larger Cidr must contain the smaller
 144 -- two.
 145 combine_all :: [Cidr] -> [Cidr]
 146 combine_all cidrs =
 147     combine_contained unique_cidrs
 148     where
 149       unique_cidrs = nubBy equivalent valid_cidr_combinations
 150       valid_cidr_combinations = filter (/= Cidr.None) cidr_combinations
 151       cidr_combinations =
 152           cidrs ++ [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ]
 153
 154
 155 -- Take a list of CIDR ranges and filter out all of the ones that are
 156 -- contained entirelt within some other range in the list.
 157 combine_contained :: [Cidr] -> [Cidr]
 158 combine_contained cidrs =
 159     filter (not . (redundant cidrs)) cidrs
 160
 161
 162 -- If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
 163 -- decrement the maskbits of cidr1 and return that; it will contain
 164 -- both cidr1 and cidr2.
 165 combine_adjacent :: Cidr -> Cidr -> Cidr
 166 combine_adjacent cidr1 cidr2
 167   | not (adjacent cidr1 cidr2) = Cidr.None
 168   | (maskbits cidr1 == Zero) = Cidr.None
 169   | otherwise = cidr1 { maskbits = decrement (maskbits cidr1) }
 170
 171
 172
 173 -- Determine whether or not two CIDR ranges are adjacent. If two
 174 -- ranges lie consecutively within the IP space, they can be
 175 -- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
 176 -- and can be combined in to 10.1.0.0/23.
 177 adjacent :: Cidr -> Cidr -> Bool
 178 adjacent Cidr.None _ = False
 179 adjacent _ Cidr.None = False
 180 adjacent cidr1 cidr2
 181   | mbits1 /= mbits2 = False
 182   | mbits1 == Maskbits.Zero = False -- They're equal.
 183   | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
 184   where
 185     addr1 = ipv4address cidr1
 186     addr2 = ipv4address cidr2
 187     mbits1 = maskbits cidr1
 188     mbits2 = maskbits cidr2
 189
 190
 191
 192
 193
 194 -- HUnit Tests
 195
 196 test_equality1 :: Test
 197 test_equality1 =
 198     TestCase $ assertEqual "10.1.1.0/23 equals itself" True (cidr1 == cidr1)
 199     where
 200       cidr1 = cidr_from_string "10.1.1.0/23"
 201
 202
 203 test_contains1 :: Test
 204 test_contains1 =
 205     TestCase $ assertEqual "10.1.1.0/23 contains 10.1.1.0/24" True (cidr1 `contains` cidr2)
 206     where
 207       cidr1 = cidr_from_string "10.1.1.0/23"
 208       cidr2 = cidr_from_string "10.1.1.0/24"
 209
 210
 211 test_contains2 :: Test
 212 test_contains2 =
 213     TestCase $ assertEqual "10.1.1.0/23 contains itself" True (cidr1 `contains` cidr1)
 214     where
 215       cidr1 = cidr_from_string "10.1.1.0/23"
 216
 217
 218 test_contains_proper1 :: Test
 219 test_contains_proper1 =
 220     TestCase $ assertEqual "10.1.1.0/23 contains 10.1.1.0/24 properly" True (cidr1 `contains_proper` cidr2)
 221     where
 222       cidr1 = cidr_from_string "10.1.1.0/23"
 223       cidr2 = cidr_from_string "10.1.1.0/24"
 224
 225
 226 test_contains_proper2 :: Test
 227 test_contains_proper2 =
 228     TestCase $ assertEqual "10.1.1.0/23 does not contain itself properly" False (cidr1 `contains_proper` cidr1)
 229     where
 230       cidr1 = cidr_from_string "10.1.1.0/23"
 231
 232
 233 test_adjacent1 :: Test
 234 test_adjacent1 =
 235     TestCase $ assertEqual "10.1.0.0/24 is adjacent to 10.1.1.0/24" True (cidr1 `adjacent` cidr2)
 236     where
 237       cidr1 = cidr_from_string "10.1.0.0/24"
 238       cidr2 = cidr_from_string "10.1.1.0/24"
 239
 240
 241 test_adjacent2 :: Test
 242 test_adjacent2 =
 243     TestCase $ assertEqual "10.1.0.0/23 is not adjacent to 10.1.0.0/24" False (cidr1 `adjacent` cidr2)
 244     where
 245       cidr1 = cidr_from_string "10.1.0.0/23"
 246       cidr2 = cidr_from_string "10.1.0.0/24"
 247
 248
 249 test_adjacent3 :: Test
 250 test_adjacent3 =
 251     TestCase $ assertEqual "10.1.0.0/24 is not adjacent to 10.2.5.0/24" False (cidr1 `adjacent` cidr2)
 252     where
 253       cidr1 = cidr_from_string "10.1.0.0/24"
 254       cidr2 = cidr_from_string "10.2.5.0/24"
 255
 256
 257 test_adjacent4 :: Test
 258 test_adjacent4 =
 259     TestCase $ assertEqual "10.1.1.0/24 is not adjacent to 10.1.2.0/24" False (cidr1 `adjacent` cidr2)
 260     where
 261       cidr1 = cidr_from_string "10.1.1.0/24"
 262       cidr2 = cidr_from_string "10.1.2.0/24"
 263
 264
 265 test_combine_contained1 :: Test
 266 test_combine_contained1 =
 267     TestCase $ assertEqual "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8" expected_cidrs (combine_contained test_cidrs)
 268     where
 269       cidr1 = cidr_from_string "10.0.0.0/8"
 270       cidr2 = cidr_from_string "10.1.0.0/16"
 271       cidr3 = cidr_from_string "10.1.1.0/24"
 272       expected_cidrs = [cidr1]
 273       test_cidrs = [cidr1, cidr2, cidr3]
 274
 275
 276 test_combine_contained2 :: Test
 277 test_combine_contained2 =
 278     TestCase $ assertEqual "192.168.3.0/23 does not contain 192.168.1.0/24" [cidr1, cidr2] (combine_contained [cidr1, cidr2])
 279     where
 280       cidr1 = cidr_from_string "192.168.3.0/23"
 281       cidr2 = cidr_from_string "192.168.1.0/24"
 282
 283
 284 test_combine_all1 :: Test
 285 test_combine_all1 =
 286     TestCase $ assertEqual "10.0.0.0/24 is adjacent to 10.0.1.0/24 and 10.0.3.0/23 contains 10.0.2.0/24" expected_cidrs (combine_all test_cidrs)
 287     where
 288       cidr1 = cidr_from_string "10.0.0.0/24"
 289       cidr2 = cidr_from_string "10.0.1.0/24"
 290       cidr3 = cidr_from_string "10.0.2.0/24"
 291       cidr4 = cidr_from_string "10.0.3.0/23"
 292       cidr5 = cidr_from_string "10.0.0.0/23"
 293       expected_cidrs = [cidr4, cidr5]
 294       test_cidrs = [cidr1, cidr2, cidr3, cidr4]
 295
 296
 297 test_combine_all2 :: Test
 298 test_combine_all2 =
 299     TestCase $ assertEqual "127.0.0.1/32 combines with itself recursively" expected_cidrs (combine_all test_cidrs)
 300     where
 301       cidr1 = cidr_from_string "127.0.0.1/32"
 302       expected_cidrs = [cidr1]
 303       test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
 304
 305
 306 cidr_tests :: [Test]
 307 cidr_tests = [ test_equality1,
 308                test_contains1,
 309                test_contains2,
 310                test_contains_proper1,
 311                test_contains_proper2,
 312                test_adjacent1,
 313                test_adjacent2,
 314                test_adjacent3,
 315                test_adjacent4,
 316                test_combine_contained1,
 317                test_combine_contained2,
 318                test_combine_all1,
 319                test_combine_all2
 320              ]
 321
 322
 323 -- QuickCheck Tests
 324 prop_all_cidrs_contain_themselves :: Cidr -> Bool
 325 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
 326
 327
 328 -- If cidr1 properly contains cidr2, then by definition cidr2
 329 -- does not properly contain cidr1.
 330 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
 331 prop_contains_proper_intransitive cidr1 cidr2 =
 332     (cidr1 `contains_proper` cidr2) ==>
 333       (not (cidr2 `contains_proper` cidr1))