src/Cidr.hs

   1 module Cidr
   2 ( Cidr(..),
   3   cidr_from_string,
   4   cidr_tests,
   5   combine_all,
   6   prop_all_cidrs_contain_themselves
   7 ) where
   8
   9 import Data.List (nubBy)
  10 import Test.HUnit
  11 import Test.QuickCheck
  12
  13 import IPv4Address
  14 import ListUtils
  15 import Maskable
  16 import Maskbits
  17 import Octet
  18
  19
  20 data Cidr = None | Cidr { ipv4address :: IPv4Address,
  21                           maskbits :: Maskbits }
  22             deriving (Eq)
  23
  24
  25 instance Show Cidr where
  26     show Cidr.None = "None"
  27     show cidr = (show (ipv4address cidr)) ++ "/" ++ (show (maskbits cidr))
  28
  29
  30 instance Arbitrary Cidr where
  31     arbitrary = do
  32       ipv4 <- arbitrary :: Gen IPv4Address
  33       mask <- arbitrary :: Gen Maskbits
  34       return (Cidr ipv4 mask)
  35
  36     coarbitrary _ = variant 0
  37
  38
  39 -- Two CIDR ranges are equivalent if they have the same network bits
  40 -- and the masks are the same.
  41 equivalent :: Cidr -> Cidr -> Bool
  42 equivalent Cidr.None Cidr.None = True
  43 equivalent Cidr.None _ = False
  44 equivalent _ Cidr.None = False
  45 equivalent (Cidr addr1 mbits1) (Cidr addr2 mbits2) =
  46     (mbits1 == mbits2) && ((apply_mask addr1 mbits1) == (apply_mask addr2 mbits2))
  47
  48 -- Returns the mask portion of a CIDR address. That is, everything
  49 -- after the trailing slash.
  50 maskbits_from_cidr_string :: String -> Maskbits
  51 maskbits_from_cidr_string s =
  52     maskbits_from_string ((splitWith (`elem` "/") s) !! 1)
  53
  54
  55 -- Takes an IP address String in CIDR notation, and returns a list of
  56 -- its octets (as Ints).
  57 octets_from_cidr_string :: String -> [Octet]
  58 octets_from_cidr_string s =
  59     map octet_from_string (take 4 (splitWith (`elem` "./") s))
  60
  61
  62 cidr_from_string :: String -> Cidr
  63 cidr_from_string s
  64     | addr  == IPv4Address.None = Cidr.None
  65     | mbits == Maskbits.None    = Cidr.None
  66     | otherwise = Cidr addr mbits
  67                where
  68                  addr = ipv4address_from_octets (oct1) (oct2) (oct3) (oct4)
  69                  oct1 = (octs !! 0)
  70                  oct2 = (octs !! 1)
  71                  oct3 = (octs !! 2)
  72                  oct4 = (octs !! 3)
  73                  octs  = octets_from_cidr_string s
  74                  mbits = maskbits_from_cidr_string s
  75
  76
  77
  78 -- Return true if the first argument (a CIDR range) contains the
  79 -- second (another CIDR range). There are a lot of ways we can be fed
  80 -- junk here. For lack of a better alternative, just return False when
  81 -- we are given nonsense.
  82 contains :: Cidr -> Cidr -> Bool
  83 contains Cidr.None _ = False
  84 contains _ Cidr.None = False
  85 contains (Cidr _ Maskbits.None) _    = False
  86 contains (Cidr IPv4Address.None _) _ = False
  87 contains _ (Cidr _ Maskbits.None)    = False
  88 contains _ (Cidr IPv4Address.None _) = False
  89
  90 -- If the number of bits in the network part of the first address is
  91 -- larger than the number of bits in the second, there is no way that
  92 -- the first range can contain the second. For, if the number of
  93 -- network bits is larger, then the number of host bits must be
  94 -- smaller, and if cidr1 has fewer hosts than cidr2, cidr1 most
  95 -- certainly does not contain cidr2.
  96 --
  97 -- On the other hand, if the first argument (cidr1) has fewer (or the
  98 -- same number of) network bits as the second, it can contain the
  99 -- second. In this case, we need to check that every host in cidr2 is
 100 -- contained in cidr1. If a host in cidr2 is contained in cidr1, then
 101 -- at least mbits1 of an address in cidr2 will match cidr1. For
 102 -- example,
 103 --
 104 -- cidr1 = 192.168.1.0/23, cidr2 = 192.168.1.100/24
 105 --
 106 -- Here, cidr2 contains all of 192.168.1.0 through
 107 -- 192.168.1.255. However, cidr1 contains BOTH 192.168.0.0 through
 108 -- 192.168.0.255 and 192.168.1.0 through 192.168.1.255. In essence,
 109 -- what we want to check is that cidr2 "begins with" something that
 110 -- cidr1 CAN begin with. Since cidr1 can begin with 192.168.1, and
 111 -- cidr2 DOES, cidr1 contains cidr2..
 112 --
 113 -- The way that we check this is to apply cidr1's mask to cidr2's
 114 -- address and see if the result is the same as cidr1's mask applied
 115 -- to cidr1's address.
 116 --
 117 contains (Cidr addr1 mbits1) (Cidr addr2 mbits2)
 118     | mbits1 > mbits2 = False
 119     | otherwise = addr1masked == addr2masked
 120     where
 121       addr1masked = apply_mask addr1 mbits1
 122       addr2masked = apply_mask addr2 mbits1
 123
 124
 125 contains_proper :: Cidr -> Cidr -> Bool
 126 contains_proper cidr1 cidr2 =
 127     (cidr1 `contains` cidr2) && (not (cidr1 == cidr2))
 128
 129
 130 -- A CIDR range is redundant (with respect to the given list) if
 131 -- another CIDR range in that list properly contains it.
 132 redundant :: [Cidr] -> Cidr -> Bool
 133 redundant cidrlist cidr = any ((flip contains_proper) cidr) cidrlist
 134
 135
 136 -- First, we look at all possible pairs of cidrs, and combine the
 137 -- adjacent ones in to a new list. Then, we concatenate that list with
 138 -- the original one, and filter out all of the redundancies. If two
 139 -- adjacent Cidrs are combined into a larger one, they will be removed
 140 -- in the second step since the larger Cidr must contain the smaller
 141 -- two.
 142 combine_all :: [Cidr] -> [Cidr]
 143 combine_all cidrs =
 144     combine_contained unique_cidrs
 145     where
 146       unique_cidrs = nubBy equivalent valid_cidr_combinations
 147       valid_cidr_combinations = filter (/= Cidr.None) cidr_combinations
 148       cidr_combinations =
 149           cidrs ++ [ (combine_adjacent x y) | x <- cidrs, y <- cidrs ]
 150
 151
 152 -- Take a list of CIDR ranges and filter out all of the ones that are
 153 -- contained entirelt within some other range in the list.
 154 combine_contained :: [Cidr] -> [Cidr]
 155 combine_contained cidrs =
 156     filter (not . (redundant cidrs)) cidrs
 157
 158
 159 -- If the two Cidrs are not adjacent, return Cidr.None. Otherwise,
 160 -- decrement the maskbits of cidr1 and return that; it will contain
 161 -- both cidr1 and cidr2.
 162 combine_adjacent :: Cidr -> Cidr -> Cidr
 163 combine_adjacent cidr1 cidr2
 164   | not (adjacent cidr1 cidr2) = Cidr.None
 165   | (maskbits cidr1 == Zero) = Cidr.None
 166   | otherwise = cidr1 { maskbits = decrement (maskbits cidr1) }
 167
 168
 169
 170 -- Determine whether or not two CIDR ranges are adjacent. If two
 171 -- ranges lie consecutively within the IP space, they can be
 172 -- combined. For example, 10.1.0.0/24 and 10.0.1.0/24 are adjacent,
 173 -- and can be combined in to 10.1.0.0/23.
 174 adjacent :: Cidr -> Cidr -> Bool
 175 adjacent Cidr.None _ = False
 176 adjacent _ Cidr.None = False
 177 adjacent cidr1 cidr2
 178   | mbits1 /= mbits2 = False
 179   | mbits1 == Maskbits.Zero = False -- They're equal.
 180   | otherwise = (mbits1 == (most_sig_bit_different addr1 addr2))
 181   where
 182     addr1 = ipv4address cidr1
 183     addr2 = ipv4address cidr2
 184     mbits1 = maskbits cidr1
 185     mbits2 = maskbits cidr2
 186
 187
 188
 189
 190
 191 -- HUnit Tests
 192
 193 test_equality1 :: Test
 194 test_equality1 =
 195     TestCase $ assertEqual "10.1.1.0/23 equals itself" True (cidr1 == cidr1)
 196     where
 197       cidr1 = cidr_from_string "10.1.1.0/23"
 198
 199
 200 test_contains1 :: Test
 201 test_contains1 =
 202     TestCase $ assertEqual "10.1.1.0/23 contains 10.1.1.0/24" True (cidr1 `contains` cidr2)
 203     where
 204       cidr1 = cidr_from_string "10.1.1.0/23"
 205       cidr2 = cidr_from_string "10.1.1.0/24"
 206
 207
 208 test_contains2 :: Test
 209 test_contains2 =
 210     TestCase $ assertEqual "10.1.1.0/23 contains itself" True (cidr1 `contains` cidr1)
 211     where
 212       cidr1 = cidr_from_string "10.1.1.0/23"
 213
 214
 215 test_contains_proper1 :: Test
 216 test_contains_proper1 =
 217     TestCase $ assertEqual "10.1.1.0/23 contains 10.1.1.0/24 properly" True (cidr1 `contains_proper` cidr2)
 218     where
 219       cidr1 = cidr_from_string "10.1.1.0/23"
 220       cidr2 = cidr_from_string "10.1.1.0/24"
 221
 222
 223 test_contains_proper2 :: Test
 224 test_contains_proper2 =
 225     TestCase $ assertEqual "10.1.1.0/23 does not contain itself properly" False (cidr1 `contains_proper` cidr1)
 226     where
 227       cidr1 = cidr_from_string "10.1.1.0/23"
 228
 229
 230 test_adjacent1 :: Test
 231 test_adjacent1 =
 232     TestCase $ assertEqual "10.1.0.0/24 is adjacent to 10.1.1.0/24" True (cidr1 `adjacent` cidr2)
 233     where
 234       cidr1 = cidr_from_string "10.1.0.0/24"
 235       cidr2 = cidr_from_string "10.1.1.0/24"
 236
 237
 238 test_adjacent2 :: Test
 239 test_adjacent2 =
 240     TestCase $ assertEqual "10.1.0.0/23 is not adjacent to 10.1.0.0/24" False (cidr1 `adjacent` cidr2)
 241     where
 242       cidr1 = cidr_from_string "10.1.0.0/23"
 243       cidr2 = cidr_from_string "10.1.0.0/24"
 244
 245
 246 test_adjacent3 :: Test
 247 test_adjacent3 =
 248     TestCase $ assertEqual "10.1.0.0/24 is not adjacent to 10.2.5.0/24" False (cidr1 `adjacent` cidr2)
 249     where
 250       cidr1 = cidr_from_string "10.1.0.0/24"
 251       cidr2 = cidr_from_string "10.2.5.0/24"
 252
 253
 254 test_adjacent4 :: Test
 255 test_adjacent4 =
 256     TestCase $ assertEqual "10.1.1.0/24 is not adjacent to 10.1.2.0/24" False (cidr1 `adjacent` cidr2)
 257     where
 258       cidr1 = cidr_from_string "10.1.1.0/24"
 259       cidr2 = cidr_from_string "10.1.2.0/24"
 260
 261
 262 test_combine_contained1 :: Test
 263 test_combine_contained1 =
 264     TestCase $ assertEqual "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8" expected_cidrs (combine_all test_cidrs)
 265     where
 266       cidr1 = cidr_from_string "10.0.0.0/8"
 267       cidr2 = cidr_from_string "10.1.0.0/16"
 268       cidr3 = cidr_from_string "10.1.1.0/24"
 269       expected_cidrs = [cidr1]
 270       test_cidrs = [cidr1, cidr2, cidr3]
 271
 272
 273 test_combine_contained2 :: Test
 274 test_combine_contained2 =
 275     TestCase $ assertEqual "192.168.1.0/24 combines with itself" [cidr1] (combine_all [cidr1, cidr1])
 276     where
 277       cidr1 = cidr_from_string "192.168.1.0/24"
 278
 279
 280 cidr_tests :: [Test]
 281 cidr_tests = [ test_equality1,
 282                test_contains1,
 283                test_contains2,
 284                test_contains_proper1,
 285                test_contains_proper2,
 286                test_adjacent1,
 287                test_adjacent2,
 288                test_adjacent3,
 289                test_adjacent4,
 290                test_combine_contained1,
 291                test_combine_contained2
 292              ]
 293
 294
 295 -- QuickCheck Tests
 296 prop_all_cidrs_contain_themselves :: Cidr -> Bool
 297 prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1
 298