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 (Bit(..))
  36 import IPv4Address (IPv4Address(..), most_sig_bit_different)
  37 import Maskable (Maskable(..))
  38 import Maskbits (Maskbits(..))
  39 import Octet (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 = readMaybe (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 = pred (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 -- Test lists.
 263 cidr_tests :: Test
 264 cidr_tests =
 265   testGroup "CIDR Tests" [
 266     test_enumerate,
 267     test_min_host1,
 268     test_max_host1,
 269     test_equality1,
 270     test_contains1,
 271     test_contains2,
 272     test_contains_proper1,
 273     test_contains_proper2,
 274     test_adjacent1,
 275     test_adjacent2,
 276     test_adjacent3,
 277     test_adjacent4,
 278     test_combine_contained1,
 279     test_combine_contained2,
 280     test_combine_all1,
 281     test_combine_all2,
 282     test_combine_all3 ]
 283
 284 cidr_properties :: Test
 285 cidr_properties =
 286   testGroup "CIDR Properties" [
 287     testProperty
 288       "All CIDRs contain themselves"
 289       prop_all_cidrs_contain_themselves,
 290
 291     testProperty
 292       "contains_proper is intransitive"
 293       prop_contains_proper_intransitive
 294   ]
 295
 296
 297 -- HUnit Tests
 298 test_enumerate :: Test
 299 test_enumerate =
 300   testCase desc $ assertEqual desc expected actual
 301   where
 302     desc = "192.168.0.240/30 is enumerated correctly"
 303     oct1 = toEnum 192
 304     oct2 = toEnum 168
 305     oct3 = minBound
 306     mk_ip = IPv4Address oct1 oct2 oct3
 307     addr1 = mk_ip $ toEnum 240
 308     addr2 = mk_ip $ toEnum 241
 309     addr3 = mk_ip $ toEnum 242
 310     addr4 = mk_ip $ toEnum 243
 311     expected = [addr1, addr2, addr3, addr4]
 312     actual = enumerate $ fromJust $ cidr_from_string "192.168.0.240/30"
 313
 314 test_min_host1 :: Test
 315 test_min_host1 =
 316   testCase desc $
 317     assertEqual desc
 318     expected
 319     actual
 320   where
 321     desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
 322     actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24")
 323     expected = "10.0.0.0"
 324
 325
 326 test_max_host1 :: Test
 327 test_max_host1 =
 328   testCase desc $
 329     assertEqual desc
 330     expected
 331     actual
 332   where
 333     desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
 334     actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24")
 335     expected = "10.0.0.255"
 336
 337
 338 test_equality1 :: Test
 339 test_equality1 =
 340   testCase desc $
 341     assertEqual
 342     desc
 343     True
 344     (cidr1 == cidr1)
 345   where
 346     desc = "10.1.1.0/23 equals itself"
 347     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 348
 349
 350 test_contains1 :: Test
 351 test_contains1 =
 352   testCase desc $
 353     assertEqual
 354     desc
 355     True
 356     (cidr1 `contains` cidr2)
 357   where
 358     desc = "10.1.1.0/23 contains 10.1.1.0/24"
 359     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 360     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 361
 362
 363 test_contains2 :: Test
 364 test_contains2 =
 365   testCase desc $
 366     assertEqual
 367     desc
 368     True
 369     (cidr1 `contains` cidr1)
 370   where
 371     desc = "10.1.1.0/23 contains itself"
 372     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 373
 374
 375 test_contains_proper1 :: Test
 376 test_contains_proper1 =
 377   testCase desc $
 378     assertEqual
 379     desc
 380     True
 381     (cidr1 `contains_proper` cidr2)
 382   where
 383     desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
 384     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 385     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 386
 387
 388 test_contains_proper2 :: Test
 389 test_contains_proper2 =
 390   testCase desc $
 391     assertEqual
 392     desc
 393     False
 394     (cidr1 `contains_proper` cidr1)
 395   where
 396     desc = "10.1.1.0/23 does not contain itself properly"
 397     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 398
 399
 400 test_adjacent1 :: Test
 401 test_adjacent1 =
 402   testCase desc $
 403     assertEqual
 404     desc
 405     True
 406     (cidr1 `adjacent` cidr2)
 407   where
 408     desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
 409     cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
 410     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 411
 412
 413 test_adjacent2 :: Test
 414 test_adjacent2 =
 415   testCase desc $
 416     assertEqual
 417     desc
 418     False
 419     (cidr1 `adjacent` cidr2)
 420   where
 421     desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
 422     cidr1 = fromJust $ cidr_from_string "10.1.0.0/23"
 423     cidr2 = fromJust $ cidr_from_string "10.1.0.0/24"
 424
 425
 426 test_adjacent3 :: Test
 427 test_adjacent3 =
 428   testCase desc $
 429     assertEqual
 430     desc
 431     False
 432     (cidr1 `adjacent` cidr2)
 433   where
 434     desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
 435     cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
 436     cidr2 = fromJust $ cidr_from_string "10.2.5.0/24"
 437
 438
 439 test_adjacent4 :: Test
 440 test_adjacent4 =
 441   testCase desc $
 442     assertEqual
 443     desc
 444     False
 445     (cidr1 `adjacent` cidr2)
 446   where
 447     desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
 448     cidr1 = fromJust $ cidr_from_string "10.1.1.0/24"
 449     cidr2 = fromJust $ cidr_from_string "10.1.2.0/24"
 450
 451
 452 test_combine_contained1 :: Test
 453 test_combine_contained1 =
 454   testCase desc $
 455     assertEqual
 456     desc
 457     expected_cidrs
 458     (combine_contained test_cidrs)
 459   where
 460     desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
 461     cidr1 = fromJust $ cidr_from_string "10.0.0.0/8"
 462     cidr2 = fromJust $ cidr_from_string "10.1.0.0/16"
 463     cidr3 = fromJust $ cidr_from_string "10.1.1.0/24"
 464     expected_cidrs = [cidr1]
 465     test_cidrs = [cidr1, cidr2, cidr3]
 466
 467
 468 test_combine_contained2 :: Test
 469 test_combine_contained2 =
 470   testCase desc $
 471     assertEqual
 472     desc
 473     [cidr1, cidr2]
 474     (combine_contained [cidr1, cidr2])
 475   where
 476     desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
 477     cidr1 = fromJust $ cidr_from_string "192.168.3.0/23"
 478     cidr2 = fromJust $ cidr_from_string "192.168.1.0/24"
 479
 480
 481 test_combine_all1 :: Test
 482 test_combine_all1 =
 483   testCase desc $
 484     assertEqual
 485     desc
 486     expected_cidrs
 487     (combine_all test_cidrs)
 488   where
 489     desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
 490            ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
 491     cidr1 = fromJust $ cidr_from_string "10.0.0.0/24"
 492     cidr2 = fromJust $ cidr_from_string "10.0.1.0/24"
 493     cidr3 = fromJust $ cidr_from_string "10.0.2.0/24"
 494     cidr4 = fromJust $ cidr_from_string "10.0.3.0/23"
 495     cidr5 = fromJust $ cidr_from_string "10.0.0.0/23"
 496     expected_cidrs = [fromJust $ cidr_from_string "10.0.0.0/22"]
 497     test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
 498
 499
 500 test_combine_all2 :: Test
 501 test_combine_all2 =
 502     testCase desc $
 503       assertEqual
 504       desc
 505       expected_cidrs
 506       (combine_all test_cidrs)
 507     where
 508       desc = "127.0.0.1/32 combines with itself recursively"
 509       cidr1 = fromJust $ cidr_from_string "127.0.0.1/32"
 510       expected_cidrs = [cidr1]
 511       test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
 512
 513
 514 test_combine_all3 :: Test
 515 test_combine_all3 =
 516   testCase desc $
 517     assertEqual
 518     desc
 519     expected_cidrs
 520     (combine_all test_cidrs)
 521   where
 522     desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
 523            ++ "10.0.0.19 get combined into 10.0.0.16/30"
 524     cidr1 = fromJust $ cidr_from_string "10.0.0.16/32"
 525     cidr2 = fromJust $ cidr_from_string "10.0.0.17/32"
 526     cidr3 = fromJust $ cidr_from_string "10.0.0.18/32"
 527     cidr4 = fromJust $ cidr_from_string "10.0.0.19/32"
 528     expected_cidrs = [fromJust $ cidr_from_string "10.0.0.16/30"]
 529     test_cidrs = [cidr1, cidr2, cidr3, cidr4]
 530
 531
 532 -- QuickCheck Tests
 533 prop_all_cidrs_contain_themselves :: Cidr -> Bool
 534 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
 535
 536
 537 -- If cidr1 properly contains cidr2, then by definition cidr2
 538 -- does not properly contain cidr1.
 539 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
 540 prop_contains_proper_intransitive cidr1 cidr2 =
 541     (cidr1 `contains_proper` cidr2) ==>
 542       (not (cidr2 `contains_proper` cidr1))