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