src/Cidr.hs

   1 -- | The CIDR modules contains most of the functions used for working
   2 --   with the CIDR type.
   3 module Cidr
   4 ( Cidr(..),
   5   cidr_from_string,
   6   cidr_properties,
   7   cidr_tests,
   8   combine_all,
   9   contains,
  10   contains_proper,
  11   enumerate,
  12   max_octet1,
  13   max_octet2,
  14   max_octet3,
  15   max_octet4,
  16   min_octet1,
  17   min_octet2,
  18   min_octet3,
  19   min_octet4,
  20   prop_all_cidrs_contain_themselves,
  21   prop_contains_proper_intransitive
  22 ) where
  23
  24 import Data.List (nubBy)
  25 import Data.List.Split (splitOneOf)
  26 import Data.Maybe (catMaybes, fromJust, mapMaybe)
  27
  28 import Test.HUnit (assertEqual)
  29 import Test.Framework (Test, testGroup)
  30 import Test.Framework.Providers.HUnit (testCase)
  31 import Test.Framework.Providers.QuickCheck2 (testProperty)
  32 import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
  33 import Text.Read (readMaybe)
  34
  35 import qualified Bit as B
  36 import IPv4Address
  37 import Maskable
  38 import Maskbits
  39 import Octet
  40
  41
  42 data Cidr = Cidr { ipv4address :: IPv4Address,
  43                    maskbits :: Maskbits }
  44
  45
  46
  47 instance Show Cidr where
  48     show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
  49
  50
  51 instance Arbitrary Cidr where
  52     arbitrary = do
  53       ipv4 <- arbitrary :: Gen IPv4Address
  54       mask <- arbitrary :: Gen Maskbits
  55       return (Cidr ipv4 mask)
  56
  57
  58 instance Eq Cidr where
  59   cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
  60
  61
  62 -- | Two CIDR ranges are equivalent if they have the same network bits
  63 --   and the masks are the same.
  64 equivalent :: Cidr -> Cidr -> Bool
  65 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
  66     (mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
  67
  68 -- | Returns the mask portion of a CIDR address. That is, everything
  69 --   after the trailing slash.
  70 maskbits_from_cidr_string :: String -> Maybe Maskbits
  71 maskbits_from_cidr_string s
  72   | length partlist == 2 = maskbits_from_string (partlist !! 1)
  73   | otherwise = Nothing
  74     where
  75       partlist = splitOneOf "/" s
  76
  77
  78 -- | Takes an IP address String in CIDR notation, and returns a list
  79 --   of its octets (as Ints).
  80 octets_from_cidr_string :: String -> [Octet]
  81 octets_from_cidr_string s =
  82   mapMaybe readMaybe (take 4 (splitOneOf "./" s))
  83
  84
  85 -- | Return Nothing if we can't parse both maskbits and octets from
  86 --   the string.
  87 cidr_from_string :: String -> Maybe Cidr
  88 cidr_from_string s =
  89   case (octets_from_cidr_string s) of
  90     [oct1, oct2, oct3, oct4] ->
  91       case (maskbits_from_cidr_string s) of
  92         Just mbits ->
  93           Just $ Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits
  94         _ -> Nothing
  95     _ -> Nothing
  96
  97
  98
  99 -- | Given a CIDR, return the minimum valid IPv4 address contained
 100 --   within it.
 101 min_host :: Cidr -> IPv4Address
 102 min_host (Cidr addr mask) = apply_mask addr mask B.Zero
 103
 104 -- | Given a CIDR, return the maximum valid IPv4 address contained
 105 --   within it.
 106 max_host :: Cidr -> IPv4Address
 107 max_host (Cidr addr mask) = apply_mask addr mask B.One
 108
 109 -- | Given a CIDR, return the first octet of the minimum valid IPv4
 110 --   address contained within it.
 111 min_octet1 :: Cidr -> Octet
 112 min_octet1 cidr = octet1 (min_host cidr)
 113
 114 -- | Given a CIDR, return the second octet of the minimum valid IPv4
 115 --   address contained within it.
 116 min_octet2 :: Cidr -> Octet
 117 min_octet2 cidr = octet2 (min_host cidr)
 118
 119 -- | Given a CIDR, return the third octet of the minimum valid IPv4
 120 --   address contained within it.
 121 min_octet3 :: Cidr -> Octet
 122 min_octet3 cidr = octet3 (min_host cidr)
 123
 124 -- | Given a CIDR, return the fourth octet of the minimum valid IPv4
 125 --   address contained within it.
 126 min_octet4 :: Cidr -> Octet
 127 min_octet4 cidr = octet4 (min_host cidr)
 128
 129 -- | Given a CIDR, return the first octet of the maximum valid IPv4
 130 --   address contained within it.
 131 max_octet1 :: Cidr -> Octet
 132 max_octet1 cidr = octet1 (max_host cidr)
 133
 134 -- | Given a CIDR, return the second octet of the maximum valid IPv4
 135 --   address contained within it.
 136 max_octet2 :: Cidr -> Octet
 137 max_octet2 cidr = octet2 (max_host cidr)
 138
 139 -- | Given a CIDR, return the third octet of the maximum valid IPv4
 140 --   address contained within it.
 141 max_octet3 :: Cidr -> Octet
 142 max_octet3 cidr = octet3 (max_host cidr)
 143
 144 -- | Given a CIDR, return the fourth octet of the maximum valid IPv4
 145 --   address contained within it.
 146 max_octet4 :: Cidr -> Octet
 147 max_octet4 cidr = octet4 (max_host cidr)
 148
 149
 150
 151 -- | Return true if the first argument (a CIDR range) contains the
 152 --   second (another CIDR range). There are a lot of ways we can be
 153 --   fed junk here. For lack of a better alternative, just return
 154 --   False when we are given nonsense.
 155 --
 156 --   If the number of bits in the network part of the first address is
 157 --   larger than the number of bits in the second, there is no way
 158 --   that the first range can contain the second. For, if the number
 159 --   of network bits is larger, then the number of host bits must be
 160 --   smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
 161 --   certainly does not contain cidr2.
 162 --
 163 --   On the other hand, if the first argument (cidr1) has fewer (or
 164 --   the same number of) network bits as the second, it can contain
 165 --   the second. In this case, we need to check that every host in
 166 --   cidr2 is contained in cidr1. If a host in cidr2 is contained in
 167 --   cidr1, then at least mbits1 of an address in cidr2 will match
 168 --   cidr1. For example,
 169 --
 170 --   cidr1 = 192.168.1.0\/23, cidr2 = 192.168.1.100\/24
 171 --
 172 --   Here, cidr2 contains all of 192.168.1.0 through
 173 --   192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
 174 --   192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
 175 --   what we want to check is that cidr2 "begins with" something that
 176 --   cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
 177 --   cidr2 DOES, cidr1 contains cidr2..
 178 --
 179 --   The way that we check this is to apply cidr1's mask to cidr2's
 180 --   address and see if the result is the same as cidr1's mask applied
 181 --   to cidr1's address.
 182 --
 183 contains :: Cidr -> Cidr -> Bool
 184 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
 185   | mbits1 > mbits2 = False
 186   | otherwise = addr1masked == addr2masked
 187   where
 188     addr1masked = apply_mask addr1 mbits1 B.Zero
 189     addr2masked = apply_mask addr2 mbits1 B.Zero
 190
 191
 192 -- | Contains but is not equal to.
 193 contains_proper :: Cidr -> Cidr -> Bool
 194 contains_proper cidr1 cidr2 =
 195     (cidr1 `contains` cidr2) && (not (cidr2 `contains` cidr1))
 196
 197
 198 -- | A CIDR range is redundant (with respect to the given list) if
 199 --   another CIDR range in that list properly contains it.
 200 redundant :: [Cidr] -> Cidr -> Bool
 201 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
 202
 203
 204 -- | First, we look at all possible pairs of cidrs, and combine the
 205 --   adjacent ones in to a new list. Then, we concatenate that list
 206 --   with the original one, and filter out all of the redundancies. If
 207 --   two adjacent Cidrs are combined into a larger one, they will be
 208 --   removed in the second step since the larger Cidr must contain the
 209 --   smaller two.
 210 --
 211 --   Once this is done, we see whether or not the result is different
 212 --   than the argument that was passed in. If nothing changed, we're
 213 --   done and return the list that was passed to us. However, if
 214 --   something changed, we recurse and try to combine the list again.
 215 combine_all :: [Cidr] -> [Cidr]
 216 combine_all cidrs
 217   | cidrs == (combine_contained unique_cidrs) = cidrs
 218   | otherwise = combine_all (combine_contained unique_cidrs)
 219     where
 220       unique_cidrs = nubBy equivalent cidr_combinations
 221       cidr_combinations =
 222         cidrs ++ (catMaybes [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ])
 223
 224
 225 -- | Take a list of CIDR ranges and filter out all of the ones that
 226 --   are contained entirelt within some other range in the list.
 227 combine_contained :: [Cidr] -> [Cidr]
 228 combine_contained cidrs =
 229   filter (not . (redundant cidrs)) cidrs
 230
 231
 232 -- | If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
 233 --   decrement the maskbits of cidr1 and return that; it will contain
 234 --   both cidr1 and cidr2.
 235 combine_adjacent :: Cidr -> Cidr -> Maybe Cidr
 236 combine_adjacent cidr1 cidr2
 237   | not (adjacent cidr1 cidr2) = Nothing
 238   | (maskbits cidr1 == Zero) = Nothing
 239   | otherwise = Just $ cidr1 { maskbits = decrement (maskbits cidr1) }
 240
 241
 242
 243 -- | Determine whether or not two CIDR ranges are adjacent. If two
 244 --   ranges lie consecutively within the IP space, they can be
 245 --   combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
 246 --   and can be combined in to 10.1.0.0/23.
 247 adjacent :: Cidr -> Cidr -> Bool
 248 adjacent cidr1 cidr2
 249   | mbits1 /= mbits2 = False
 250   | mbits1 == Maskbits.Zero = False -- They're equal.
 251   | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
 252   where
 253     addr1 = ipv4address cidr1
 254     addr2 = ipv4address cidr2
 255     mbits1 = maskbits cidr1
 256     mbits2 = maskbits cidr2
 257
 258
 259 enumerate :: Cidr -> [IPv4Address]
 260 enumerate cidr = [(min_host cidr)..(max_host cidr)]
 261
 262
 263 -- HUnit Tests
 264
 265 test_min_host1 :: Test
 266 test_min_host1 =
 267   testCase desc $
 268     assertEqual desc
 269     expected
 270     actual
 271   where
 272     desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
 273     actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24")
 274     expected = "10.0.0.0"
 275
 276
 277 test_max_host1 :: Test
 278 test_max_host1 =
 279   testCase desc $
 280     assertEqual desc
 281     expected
 282     actual
 283   where
 284     desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
 285     actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24")
 286     expected = "10.0.0.255"
 287
 288
 289 test_equality1 :: Test
 290 test_equality1 =
 291   testCase desc $
 292     assertEqual
 293     desc
 294     True
 295     (cidr1 == cidr1)
 296   where
 297     desc = "10.1.1.0/23 equals itself"
 298     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 299
 300
 301 test_contains1 :: Test
 302 test_contains1 =
 303   testCase desc $
 304     assertEqual
 305     desc
 306     True
 307     (cidr1 `contains` cidr2)
 308   where
 309     desc = "10.1.1.0/23 contains 10.1.1.0/24"
 310     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 311     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 312
 313
 314 test_contains2 :: Test
 315 test_contains2 =
 316   testCase desc $
 317     assertEqual
 318     desc
 319     True
 320     (cidr1 `contains` cidr1)
 321   where
 322     desc = "10.1.1.0/23 contains itself"
 323     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 324
 325
 326 test_contains_proper1 :: Test
 327 test_contains_proper1 =
 328   testCase desc $
 329     assertEqual
 330     desc
 331     True
 332     (cidr1 `contains_proper` cidr2)
 333   where
 334     desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
 335     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 336     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 337
 338
 339 test_contains_proper2 :: Test
 340 test_contains_proper2 =
 341   testCase desc $
 342     assertEqual
 343     desc
 344     False
 345     (cidr1 `contains_proper` cidr1)
 346   where
 347     desc = "10.1.1.0/23 does not contain itself properly"
 348     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 349
 350
 351 test_adjacent1 :: Test
 352 test_adjacent1 =
 353   testCase desc $
 354     assertEqual
 355     desc
 356     True
 357     (cidr1 `adjacent` cidr2)
 358   where
 359     desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
 360     cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
 361     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 362
 363
 364 test_adjacent2 :: Test
 365 test_adjacent2 =
 366   testCase desc $
 367     assertEqual
 368     desc
 369     False
 370     (cidr1 `adjacent` cidr2)
 371   where
 372     desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
 373     cidr1 = fromJust $ cidr_from_string "10.1.0.0/23"
 374     cidr2 = fromJust $ cidr_from_string "10.1.0.0/24"
 375
 376
 377 test_adjacent3 :: Test
 378 test_adjacent3 =
 379   testCase desc $
 380     assertEqual
 381     desc
 382     False
 383     (cidr1 `adjacent` cidr2)
 384   where
 385     desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
 386     cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
 387     cidr2 = fromJust $ cidr_from_string "10.2.5.0/24"
 388
 389
 390 test_adjacent4 :: Test
 391 test_adjacent4 =
 392   testCase desc $
 393     assertEqual
 394     desc
 395     False
 396     (cidr1 `adjacent` cidr2)
 397   where
 398     desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
 399     cidr1 = fromJust $ cidr_from_string "10.1.1.0/24"
 400     cidr2 = fromJust $ cidr_from_string "10.1.2.0/24"
 401
 402
 403 test_combine_contained1 :: Test
 404 test_combine_contained1 =
 405   testCase desc $
 406     assertEqual
 407     desc
 408     expected_cidrs
 409     (combine_contained test_cidrs)
 410   where
 411     desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
 412     cidr1 = fromJust $ cidr_from_string "10.0.0.0/8"
 413     cidr2 = fromJust $ cidr_from_string "10.1.0.0/16"
 414     cidr3 = fromJust $ cidr_from_string "10.1.1.0/24"
 415     expected_cidrs = [cidr1]
 416     test_cidrs = [cidr1, cidr2, cidr3]
 417
 418
 419 test_combine_contained2 :: Test
 420 test_combine_contained2 =
 421   testCase desc $
 422     assertEqual
 423     desc
 424     [cidr1, cidr2]
 425     (combine_contained [cidr1, cidr2])
 426   where
 427     desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
 428     cidr1 = fromJust $ cidr_from_string "192.168.3.0/23"
 429     cidr2 = fromJust $ cidr_from_string "192.168.1.0/24"
 430
 431
 432 test_combine_all1 :: Test
 433 test_combine_all1 =
 434   testCase desc $
 435     assertEqual
 436     desc
 437     expected_cidrs
 438     (combine_all test_cidrs)
 439   where
 440     desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
 441            ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
 442     cidr1 = fromJust $ cidr_from_string "10.0.0.0/24"
 443     cidr2 = fromJust $ cidr_from_string "10.0.1.0/24"
 444     cidr3 = fromJust $ cidr_from_string "10.0.2.0/24"
 445     cidr4 = fromJust $ cidr_from_string "10.0.3.0/23"
 446     cidr5 = fromJust $ cidr_from_string "10.0.0.0/23"
 447     expected_cidrs = [fromJust $ cidr_from_string "10.0.0.0/22"]
 448     test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
 449
 450
 451 test_combine_all2 :: Test
 452 test_combine_all2 =
 453     testCase desc $
 454       assertEqual
 455       desc
 456       expected_cidrs
 457       (combine_all test_cidrs)
 458     where
 459       desc = "127.0.0.1/32 combines with itself recursively"
 460       cidr1 = fromJust $ cidr_from_string "127.0.0.1/32"
 461       expected_cidrs = [cidr1]
 462       test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
 463
 464
 465 test_combine_all3 :: Test
 466 test_combine_all3 =
 467   testCase desc $
 468     assertEqual
 469     desc
 470     expected_cidrs
 471     (combine_all test_cidrs)
 472   where
 473     desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
 474            ++ "10.0.0.19 get combined into 10.0.0.16/30"
 475     cidr1 = fromJust $ cidr_from_string "10.0.0.16/32"
 476     cidr2 = fromJust $ cidr_from_string "10.0.0.17/32"
 477     cidr3 = fromJust $ cidr_from_string "10.0.0.18/32"
 478     cidr4 = fromJust $ cidr_from_string "10.0.0.19/32"
 479     expected_cidrs = [fromJust $ cidr_from_string "10.0.0.16/30"]
 480     test_cidrs = [cidr1, cidr2, cidr3, cidr4]
 481
 482
 483 cidr_tests :: Test
 484 cidr_tests =
 485   testGroup "CIDR Tests" [
 486     test_min_host1,
 487     test_max_host1,
 488     test_equality1,
 489     test_contains1,
 490     test_contains2,
 491     test_contains_proper1,
 492     test_contains_proper2,
 493     test_adjacent1,
 494     test_adjacent2,
 495     test_adjacent3,
 496     test_adjacent4,
 497     test_combine_contained1,
 498     test_combine_contained2,
 499     test_combine_all1,
 500     test_combine_all2,
 501     test_combine_all3 ]
 502
 503
 504 -- QuickCheck Tests
 505 prop_all_cidrs_contain_themselves :: Cidr -> Bool
 506 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
 507
 508
 509 -- If cidr1 properly contains cidr2, then by definition cidr2
 510 -- does not properly contain cidr1.
 511 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
 512 prop_contains_proper_intransitive cidr1 cidr2 =
 513     (cidr1 `contains_proper` cidr2) ==>
 514       (not (cidr2 `contains_proper` cidr1))
 515
 516 cidr_properties :: Test
 517 cidr_properties =
 518   testGroup "CIDR Properties" [
 519     testProperty
 520       "All CIDRs contain themselves"
 521       prop_all_cidrs_contain_themselves,
 522
 523     testProperty
 524       "contains_proper is intransitive"
 525       prop_contains_proper_intransitive
 526   ]