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