src/Cidr.hs

   1 module Cidr
   2 ( Cidr(..),
   3   cidr_from_string,
   4   cidr_properties,
   5   cidr_tests,
   6   combine_all,
   7   contains,
   8   contains_proper,
   9   max_octet1,
  10   max_octet2,
  11   max_octet3,
  12   max_octet4,
  13   min_octet1,
  14   min_octet2,
  15   min_octet3,
  16   min_octet4,
  17   prop_all_cidrs_contain_themselves,
  18   prop_contains_proper_intransitive
  19 ) where
  20
  21 import Data.List (nubBy)
  22 import Data.Maybe (catMaybes, fromJust)
  23
  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, (==>))
  29
  30 import qualified Bit as B
  31 import IPv4Address
  32 import ListUtils
  33 import Maskable
  34 import Maskbits
  35 import Octet
  36
  37
  38 data Cidr = Cidr { ipv4address :: IPv4Address,
  39                    maskbits :: Maskbits }
  40
  41
  42
  43 instance Show Cidr where
  44     show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
  45
  46
  47 instance Arbitrary Cidr where
  48     arbitrary = do
  49       ipv4 <- arbitrary :: Gen IPv4Address
  50       mask <- arbitrary :: Gen Maskbits
  51       return (Cidr ipv4 mask)
  52
  53
  54 instance Eq Cidr where
  55   cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
  56
  57
  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))
  63
  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)
  69   | otherwise = Nothing
  70     where
  71       partlist = (splitWith (`elem` "/") s)
  72
  73
  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))
  79
  80
  81 -- | Return Nothing if we can't parse both maskbits and octets from
  82 --   the string.
  83 cidr_from_string :: String -> Maybe Cidr
  84 cidr_from_string s =
  85   case (octets_from_cidr_string s) of
  86     [oct1, oct2, oct3, oct4] ->
  87       case (maskbits_from_cidr_string s) of
  88         Just mbits ->
  89           Just $ Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits
  90         _ -> Nothing
  91     _ -> Nothing
  92
  93
  94
  95 min_host :: Cidr -> IPv4Address
  96 min_host (Cidr addr mask) = apply_mask addr mask B.Zero
  97
  98
  99 max_host :: Cidr -> IPv4Address
 100 max_host (Cidr addr mask) = apply_mask addr mask B.One
 101
 102
 103 min_octet1 :: Cidr -> Octet
 104 min_octet1 cidr = octet1 (min_host cidr)
 105
 106 min_octet2 :: Cidr -> Octet
 107 min_octet2 cidr = octet2 (min_host cidr)
 108
 109 min_octet3 :: Cidr -> Octet
 110 min_octet3 cidr = octet3 (min_host cidr)
 111
 112 min_octet4 :: Cidr -> Octet
 113 min_octet4 cidr = octet4 (min_host cidr)
 114
 115 max_octet1 :: Cidr -> Octet
 116 max_octet1 cidr = octet1 (max_host cidr)
 117
 118 max_octet2 :: Cidr -> Octet
 119 max_octet2 cidr = octet2 (max_host cidr)
 120
 121 max_octet3 :: Cidr -> Octet
 122 max_octet3 cidr = octet3 (max_host cidr)
 123
 124 max_octet4 :: Cidr -> Octet
 125 max_octet4 cidr = octet4 (max_host cidr)
 126
 127
 128
 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.
 133 --
 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.
 140 --
 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,
 147 --
 148 --   cidr1 = 192.168.1.0/23, cidr2 = 192.168.1.100/24
 149 --
 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..
 156 --
 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.
 160 --
 161 contains :: Cidr -> Cidr -> Bool
 162 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
 163   | mbits1 > mbits2 = False
 164   | otherwise = addr1masked == addr2masked
 165   where
 166     addr1masked = apply_mask addr1 mbits1 B.Zero
 167     addr2masked = apply_mask addr2 mbits1 B.Zero
 168
 169
 170 contains_proper :: Cidr -> Cidr -> Bool
 171 contains_proper cidr1 cidr2 =
 172     (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
 173
 174
 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
 179
 180
 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
 186 --   smaller two.
 187 --
 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]
 193 combine_all cidrs
 194   | cidrs == (combine_contained unique_cidrs) = cidrs
 195   | otherwise = combine_all (combine_contained unique_cidrs)
 196     where
 197       unique_cidrs = nubBy equivalent cidr_combinations
 198       cidr_combinations =
 199         cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
 200
 201
 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
 207
 208
 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) }
 217
 218
 219
 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
 225 adjacent cidr1 cidr2
 226   | mbits1 /= mbits2 = False
 227   | mbits1 == Maskbits.Zero = False -- They're equal.
 228   | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
 229   where
 230     addr1 = ipv4address cidr1
 231     addr2 = ipv4address cidr2
 232     mbits1 = maskbits cidr1
 233     mbits2 = maskbits cidr2
 234
 235
 236
 237
 238
 239 -- HUnit Tests
 240
 241 test_min_host1 :: Test
 242 test_min_host1 =
 243   testCase desc $
 244     assertEqual desc
 245     expected
 246     actual
 247   where
 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"
 251
 252
 253 test_max_host1 :: Test
 254 test_max_host1 =
 255   testCase desc $
 256     assertEqual desc
 257     expected
 258     actual
 259   where
 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"
 263
 264
 265 test_equality1 :: Test
 266 test_equality1 =
 267   testCase desc $
 268     assertEqual
 269     desc
 270     True
 271     (cidr1 == cidr1)
 272   where
 273     desc = "10.1.1.0/23 equals itself"
 274     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 275
 276
 277 test_contains1 :: Test
 278 test_contains1 =
 279   testCase desc $
 280     assertEqual
 281     desc
 282     True
 283     (cidr1 `contains` cidr2)
 284   where
 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"
 288
 289
 290 test_contains2 :: Test
 291 test_contains2 =
 292   testCase desc $
 293     assertEqual
 294     desc
 295     True
 296     (cidr1 `contains` cidr1)
 297   where
 298     desc = "10.1.1.0/23 contains itself"
 299     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 300
 301
 302 test_contains_proper1 :: Test
 303 test_contains_proper1 =
 304   testCase desc $
 305     assertEqual
 306     desc
 307     True
 308     (cidr1 `contains_proper` cidr2)
 309   where
 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"
 313
 314
 315 test_contains_proper2 :: Test
 316 test_contains_proper2 =
 317   testCase desc $
 318     assertEqual
 319     desc
 320     False
 321     (cidr1 `contains_proper` cidr1)
 322   where
 323     desc = "10.1.1.0/23 does not contain itself properly"
 324     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 325
 326
 327 test_adjacent1 :: Test
 328 test_adjacent1 =
 329   testCase desc $
 330     assertEqual
 331     desc
 332     True
 333     (cidr1 `adjacent` cidr2)
 334   where
 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"
 338
 339
 340 test_adjacent2 :: Test
 341 test_adjacent2 =
 342   testCase desc $
 343     assertEqual
 344     desc
 345     False
 346     (cidr1 `adjacent` cidr2)
 347   where
 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"
 351
 352
 353 test_adjacent3 :: Test
 354 test_adjacent3 =
 355   testCase desc $
 356     assertEqual
 357     desc
 358     False
 359     (cidr1 `adjacent` cidr2)
 360   where
 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"
 364
 365
 366 test_adjacent4 :: Test
 367 test_adjacent4 =
 368   testCase desc $
 369     assertEqual
 370     desc
 371     False
 372     (cidr1 `adjacent` cidr2)
 373   where
 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"
 377
 378
 379 test_combine_contained1 :: Test
 380 test_combine_contained1 =
 381   testCase desc $
 382     assertEqual
 383     desc
 384     expected_cidrs
 385     (combine_contained test_cidrs)
 386   where
 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]
 393
 394
 395 test_combine_contained2 :: Test
 396 test_combine_contained2 =
 397   testCase desc $
 398     assertEqual
 399     desc
 400     [cidr1, cidr2]
 401     (combine_contained [cidr1, cidr2])
 402   where
 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"
 406
 407
 408 test_combine_all1 :: Test
 409 test_combine_all1 =
 410   testCase desc $
 411     assertEqual
 412     desc
 413     expected_cidrs
 414     (combine_all test_cidrs)
 415   where
 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]
 425
 426
 427 test_combine_all2 :: Test
 428 test_combine_all2 =
 429     testCase desc $
 430       assertEqual
 431       desc
 432       expected_cidrs
 433       (combine_all test_cidrs)
 434     where
 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]
 439
 440
 441 test_combine_all3 :: Test
 442 test_combine_all3 =
 443   testCase desc $
 444     assertEqual
 445     desc
 446     expected_cidrs
 447     (combine_all test_cidrs)
 448   where
 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]
 457
 458
 459 cidr_tests :: Test
 460 cidr_tests =
 461   testGroup "CIDR Tests" [
 462     test_min_host1,
 463     test_max_host1,
 464     test_equality1,
 465     test_contains1,
 466     test_contains2,
 467     test_contains_proper1,
 468     test_contains_proper2,
 469     test_adjacent1,
 470     test_adjacent2,
 471     test_adjacent3,
 472     test_adjacent4,
 473     test_combine_contained1,
 474     test_combine_contained2,
 475     test_combine_all1,
 476     test_combine_all2,
 477     test_combine_all3 ]
 478
 479
 480 -- QuickCheck Tests
 481 prop_all_cidrs_contain_themselves :: Cidr -> Bool
 482 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
 483
 484
 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))
 491
 492 cidr_properties :: Test
 493 cidr_properties =
 494   testGroup "CIDR Properties" [
 495     testProperty
 496       "All CIDRs contain themselves"
 497       prop_all_cidrs_contain_themselves,
 498
 499     testProperty
 500       "contains_proper is intransitive"
 501       prop_contains_proper_intransitive
 502   ]