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
  34 import qualified Bit as B
  35 import IPv4Address
  36 import Maskable
  37 import Maskbits
  38 import Octet
  39
  40
  41 data Cidr = Cidr { ipv4address :: IPv4Address,
  42                    maskbits :: Maskbits }
  43
  44
  45
  46 instance Show Cidr where
  47     show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
  48
  49
  50 instance Arbitrary Cidr where
  51     arbitrary = do
  52       ipv4 <- arbitrary :: Gen IPv4Address
  53       mask <- arbitrary :: Gen Maskbits
  54       return (Cidr ipv4 mask)
  55
  56
  57 instance Eq Cidr where
  58   cidr1 == cidr2 = (cidr1 `equivalent` cidr2)
  59
  60
  61 -- | Two CIDR ranges are equivalent if they have the same network bits
  62 --   and the masks are the same.
  63 equivalent :: Cidr -> Cidr -> Bool
  64 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
  65     (mbits1 == mbits2) && ((apply_mask addr1 mbits1 B.Zero) == (apply_mask addr2 mbits2 B.Zero))
  66
  67 -- | Returns the mask portion of a CIDR address. That is, everything
  68 --   after the trailing slash.
  69 maskbits_from_cidr_string :: String -> Maybe Maskbits
  70 maskbits_from_cidr_string s
  71   | length partlist == 2 = maskbits_from_string (partlist !! 1)
  72   | otherwise = Nothing
  73     where
  74       partlist = splitOneOf "/" s
  75
  76
  77 -- | Takes an IP address String in CIDR notation, and returns a list
  78 --   of its octets (as Ints).
  79 octets_from_cidr_string :: String -> [Octet]
  80 octets_from_cidr_string s =
  81   mapMaybe octet_from_string (take 4 (splitOneOf "./" s))
  82
  83
  84 -- | Return Nothing if we can't parse both maskbits and octets from
  85 --   the string.
  86 cidr_from_string :: String -> Maybe Cidr
  87 cidr_from_string s =
  88   case (octets_from_cidr_string s) of
  89     [oct1, oct2, oct3, oct4] ->
  90       case (maskbits_from_cidr_string s) of
  91         Just mbits ->
  92           Just $ Cidr (IPv4Address oct1 oct2 oct3 oct4) mbits
  93         _ -> Nothing
  94     _ -> Nothing
  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 = decrement (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
 262 -- HUnit Tests
 263
 264 test_min_host1 :: Test
 265 test_min_host1 =
 266   testCase desc $
 267     assertEqual desc
 268     expected
 269     actual
 270   where
 271     desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0"
 272     actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24")
 273     expected = "10.0.0.0"
 274
 275
 276 test_max_host1 :: Test
 277 test_max_host1 =
 278   testCase desc $
 279     assertEqual desc
 280     expected
 281     actual
 282   where
 283     desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255"
 284     actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24")
 285     expected = "10.0.0.255"
 286
 287
 288 test_equality1 :: Test
 289 test_equality1 =
 290   testCase desc $
 291     assertEqual
 292     desc
 293     True
 294     (cidr1 == cidr1)
 295   where
 296     desc = "10.1.1.0/23 equals itself"
 297     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 298
 299
 300 test_contains1 :: Test
 301 test_contains1 =
 302   testCase desc $
 303     assertEqual
 304     desc
 305     True
 306     (cidr1 `contains` cidr2)
 307   where
 308     desc = "10.1.1.0/23 contains 10.1.1.0/24"
 309     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 310     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 311
 312
 313 test_contains2 :: Test
 314 test_contains2 =
 315   testCase desc $
 316     assertEqual
 317     desc
 318     True
 319     (cidr1 `contains` cidr1)
 320   where
 321     desc = "10.1.1.0/23 contains itself"
 322     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 323
 324
 325 test_contains_proper1 :: Test
 326 test_contains_proper1 =
 327   testCase desc $
 328     assertEqual
 329     desc
 330     True
 331     (cidr1 `contains_proper` cidr2)
 332   where
 333     desc = "10.1.1.0/23 contains 10.1.1.0/24 properly"
 334     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 335     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 336
 337
 338 test_contains_proper2 :: Test
 339 test_contains_proper2 =
 340   testCase desc $
 341     assertEqual
 342     desc
 343     False
 344     (cidr1 `contains_proper` cidr1)
 345   where
 346     desc = "10.1.1.0/23 does not contain itself properly"
 347     cidr1 = fromJust $ cidr_from_string "10.1.1.0/23"
 348
 349
 350 test_adjacent1 :: Test
 351 test_adjacent1 =
 352   testCase desc $
 353     assertEqual
 354     desc
 355     True
 356     (cidr1 `adjacent` cidr2)
 357   where
 358     desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24"
 359     cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
 360     cidr2 = fromJust $ cidr_from_string "10.1.1.0/24"
 361
 362
 363 test_adjacent2 :: Test
 364 test_adjacent2 =
 365   testCase desc $
 366     assertEqual
 367     desc
 368     False
 369     (cidr1 `adjacent` cidr2)
 370   where
 371     desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24"
 372     cidr1 = fromJust $ cidr_from_string "10.1.0.0/23"
 373     cidr2 = fromJust $ cidr_from_string "10.1.0.0/24"
 374
 375
 376 test_adjacent3 :: Test
 377 test_adjacent3 =
 378   testCase desc $
 379     assertEqual
 380     desc
 381     False
 382     (cidr1 `adjacent` cidr2)
 383   where
 384     desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24"
 385     cidr1 = fromJust $ cidr_from_string "10.1.0.0/24"
 386     cidr2 = fromJust $ cidr_from_string "10.2.5.0/24"
 387
 388
 389 test_adjacent4 :: Test
 390 test_adjacent4 =
 391   testCase desc $
 392     assertEqual
 393     desc
 394     False
 395     (cidr1 `adjacent` cidr2)
 396   where
 397     desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24"
 398     cidr1 = fromJust $ cidr_from_string "10.1.1.0/24"
 399     cidr2 = fromJust $ cidr_from_string "10.1.2.0/24"
 400
 401
 402 test_combine_contained1 :: Test
 403 test_combine_contained1 =
 404   testCase desc $
 405     assertEqual
 406     desc
 407     expected_cidrs
 408     (combine_contained test_cidrs)
 409   where
 410     desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8"
 411     cidr1 = fromJust $ cidr_from_string "10.0.0.0/8"
 412     cidr2 = fromJust $ cidr_from_string "10.1.0.0/16"
 413     cidr3 = fromJust $ cidr_from_string "10.1.1.0/24"
 414     expected_cidrs = [cidr1]
 415     test_cidrs = [cidr1, cidr2, cidr3]
 416
 417
 418 test_combine_contained2 :: Test
 419 test_combine_contained2 =
 420   testCase desc $
 421     assertEqual
 422     desc
 423     [cidr1, cidr2]
 424     (combine_contained [cidr1, cidr2])
 425   where
 426     desc = "192.168.3.0/23 does not contain 192.168.1.0/24"
 427     cidr1 = fromJust $ cidr_from_string "192.168.3.0/23"
 428     cidr2 = fromJust $ cidr_from_string "192.168.1.0/24"
 429
 430
 431 test_combine_all1 :: Test
 432 test_combine_all1 =
 433   testCase desc $
 434     assertEqual
 435     desc
 436     expected_cidrs
 437     (combine_all test_cidrs)
 438   where
 439     desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 "
 440            ++ "and 10.0.3.0/23 contains 10.0.2.0/24"
 441     cidr1 = fromJust $ cidr_from_string "10.0.0.0/24"
 442     cidr2 = fromJust $ cidr_from_string "10.0.1.0/24"
 443     cidr3 = fromJust $ cidr_from_string "10.0.2.0/24"
 444     cidr4 = fromJust $ cidr_from_string "10.0.3.0/23"
 445     cidr5 = fromJust $ cidr_from_string "10.0.0.0/23"
 446     expected_cidrs = [fromJust $ cidr_from_string "10.0.0.0/22"]
 447     test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5]
 448
 449
 450 test_combine_all2 :: Test
 451 test_combine_all2 =
 452     testCase desc $
 453       assertEqual
 454       desc
 455       expected_cidrs
 456       (combine_all test_cidrs)
 457     where
 458       desc = "127.0.0.1/32 combines with itself recursively"
 459       cidr1 = fromJust $ cidr_from_string "127.0.0.1/32"
 460       expected_cidrs = [cidr1]
 461       test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1]
 462
 463
 464 test_combine_all3 :: Test
 465 test_combine_all3 =
 466   testCase desc $
 467     assertEqual
 468     desc
 469     expected_cidrs
 470     (combine_all test_cidrs)
 471   where
 472     desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and "
 473            ++ "10.0.0.19 get combined into 10.0.0.16/30"
 474     cidr1 = fromJust $ cidr_from_string "10.0.0.16/32"
 475     cidr2 = fromJust $ cidr_from_string "10.0.0.17/32"
 476     cidr3 = fromJust $ cidr_from_string "10.0.0.18/32"
 477     cidr4 = fromJust $ cidr_from_string "10.0.0.19/32"
 478     expected_cidrs = [fromJust $ cidr_from_string "10.0.0.16/30"]
 479     test_cidrs = [cidr1, cidr2, cidr3, cidr4]
 480
 481
 482 cidr_tests :: Test
 483 cidr_tests =
 484   testGroup "CIDR Tests" [
 485     test_min_host1,
 486     test_max_host1,
 487     test_equality1,
 488     test_contains1,
 489     test_contains2,
 490     test_contains_proper1,
 491     test_contains_proper2,
 492     test_adjacent1,
 493     test_adjacent2,
 494     test_adjacent3,
 495     test_adjacent4,
 496     test_combine_contained1,
 497     test_combine_contained2,
 498     test_combine_all1,
 499     test_combine_all2,
 500     test_combine_all3 ]
 501
 502
 503 -- QuickCheck Tests
 504 prop_all_cidrs_contain_themselves :: Cidr -> Bool
 505 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
 506
 507
 508 -- If cidr1 properly contains cidr2, then by definition cidr2
 509 -- does not properly contain cidr1.
 510 prop_contains_proper_intransitive :: Cidr -> Cidr -> Property
 511 prop_contains_proper_intransitive cidr1 cidr2 =
 512     (cidr1 `contains_proper` cidr2) ==>
 513       (not (cidr2 `contains_proper` cidr1))
 514
 515 cidr_properties :: Test
 516 cidr_properties =
 517   testGroup "CIDR Properties" [
 518     testProperty
 519       "All CIDRs contain themselves"
 520       prop_all_cidrs_contain_themselves,
 521
 522     testProperty
 523       "contains_proper is intransitive"
 524       prop_contains_proper_intransitive
 525   ]