diff --git a/Data/IP.hs b/Data/IP.hs --- a/Data/IP.hs +++ b/Data/IP.hs @@ -12,7 +12,8 @@ , AddrRange (addr, mask, mlen) -- ** Address class , Addr (..) - , makeAddrRange, (>:>), isMatchedTo + , makeAddrRange, (>:>), isMatchedTo, addrRangePair + , ipv4RangeToIPv6, ipv4ToIPv6 ) where import Data.IP.Addr diff --git a/Data/IP/Addr.hs b/Data/IP/Addr.hs --- a/Data/IP/Addr.hs +++ b/Data/IP/Addr.hs @@ -11,6 +11,7 @@ import Numeric (showHex, showInt) import System.ByteOrder import Text.Appar.String +import GHC.Enum (succError,predError) #ifdef GENERICS import GHC.Generics #endif @@ -30,11 +31,42 @@ data IP = IPv4 { ipv4 :: IPv4 } | IPv6 { ipv6 :: IPv6 } #ifdef GENERICS - deriving (Eq, Ord, Generic) -#else - deriving (Eq, Ord) + deriving (Generic) #endif +{-| + Equality over IP addresses. Correctly compare IPv4 and IPv4-embedded-in-IPv6 addresses. + +>>> (read "2001:db8:00:00:00:00:00:01" :: IP) == (read "2001:db8:00:00:00:00:00:01" :: IP) +True +>>> (read "2001:db8:00:00:00:00:00:01" :: IP) == (read "2001:db8:00:00:00:00:00:05" :: IP) +False +>>> (read "127.0.0.1" :: IP) == (read "127.0.0.1" :: IP) +True +>>> (read "127.0.0.1" :: IP) == (read "10.0.0.1" :: IP) +False +>>> (read "::ffff:127.0.0.1" :: IP) == (read "127.0.0.1" :: IP) +True +>>> (read "::ffff:127.0.0.1" :: IP) == (read "127.0.0.9" :: IP) +False +>>> (read "::ffff:127.0.0.1" :: IP) >= (read "127.0.0.1" :: IP) +True +>>> (read "::ffff:127.0.0.1" :: IP) <= (read "127.0.0.1" :: IP) +True +-} +instance Eq IP where + (IPv4 ip1) == (IPv4 ip2) = ip1 == ip2 + (IPv6 ip1) == (IPv6 ip2) = ip1 == ip2 + (IPv4 ip1) == (IPv6 ip2) = ipv4ToIPv6 ip1 == ip2 + (IPv6 ip1) == (IPv4 ip2) = ip1 == ipv4ToIPv6 ip2 + + +instance Ord IP where + (IPv4 ip1) `compare` (IPv4 ip2) = ip1 `compare` ip2 + (IPv6 ip1) `compare` (IPv6 ip2) = ip1 `compare` ip2 + (IPv4 ip1) `compare` (IPv6 ip2) = ipv4ToIPv6 ip1 `compare` ip2 + (IPv6 ip1) `compare` (IPv4 ip2) = ip1 `compare` ipv4ToIPv6 ip2 + instance Show IP where show (IPv4 ip) = show ip show (IPv6 ip) = show ip @@ -54,9 +86,9 @@ -} newtype IPv4 = IP4 IPv4Addr #ifdef GENERICS - deriving (Eq, Ord,Generic) + deriving (Eq, Ord, Bounded, Generic) #else - deriving (Eq, Ord) + deriving (Eq, Ord, Bounded) #endif {-| @@ -80,13 +112,84 @@ -} newtype IPv6 = IP6 IPv6Addr #ifdef GENERICS - deriving (Eq, Ord,Generic) + deriving (Eq, Ord, Bounded, Generic) #else - deriving (Eq, Ord) + deriving (Eq, Ord, Bounded) #endif + ---------------------------------------------------------------- -- +-- Enum +-- + +instance Enum IPv4 where + fromEnum (IP4 a) = fromEnum a + toEnum = IP4 . toEnum + +instance Enum IPv6 where + -- fromEnum and toEnum are not really useful, but I defined them anyway + fromEnum (IP6 (a,b,c,d)) = let a' = fromEnum a `shift` 96 + b' = fromEnum b `shift` 64 + c' = fromEnum c `shift` 32 + d' = fromEnum d + in a' .|. b' .|. c' .|. d' + toEnum i = let a = toEnum (i `shiftR` 96 .&. 0xffffffff) + b = toEnum (i `shiftR` 64 .&. 0xffffffff) + c = toEnum (i `shiftR` 32 .&. 0xffffffff) + d = toEnum (i .&. 0xffffffff) + in IP6 (a,b,c,d) + + succ (IP6 (0xffffffff,0xffffffff,0xffffffff,0xffffffff)) = succError "IPv6" + succ (IP6 (a, 0xffffffff,0xffffffff,0xffffffff)) = IP6 (succ a,0,0,0) + succ (IP6 (a, b,0xffffffff,0xffffffff)) = IP6 (a,succ b,0,0) + succ (IP6 (a, b, c,0xffffffff)) = IP6 (a,b,succ c,0) + succ (IP6 (a, b, c, d)) = IP6 (a,b,c,succ d) + + pred (IP6 (0,0,0,0)) = predError "IPv6" + pred (IP6 (a,0,0,0)) = IP6 (pred a, 0xffffffff, 0xffffffff, 0xffffffff) + pred (IP6 (a,b,0,0)) = IP6 ( a, pred b, 0xffffffff, 0xffffffff) + pred (IP6 (a,b,c,0)) = IP6 ( a, b, pred c, 0xffffffff) + pred (IP6 (a,b,c,d)) = IP6 ( a, b, c, pred d) + + enumFrom ip = ip:gen ip + where gen i = let i' = succ i in i':gen i' + + enumFromTo ip ip' = ip:gen ip + where gen i + | i == ip' = [] + | otherwise = let i' = succ i in i':gen i' + + -- These two are implemented via the integer enum instance. + -- A more correct implementation would essentially require + -- implementing instance Num IPv6, which isn't something + -- I wanna do. Another approach is to use Word128 to store + -- an IPv6 address. + enumFromThen ip ip' = fmap integerToIP6 [ip6ToInteger ip, ip6ToInteger ip' ..] + enumFromThenTo ip inc fin = fmap integerToIP6 [ip6ToInteger ip, ip6ToInteger inc .. ip6ToInteger fin] + +ip6ToInteger :: IPv6 -> Integer +ip6ToInteger (IP6 (a,b,c,d)) = let a' = word32ToInteger a `shift` 96 + b' = word32ToInteger b `shift` 64 + c' = word32ToInteger c `shift` 32 + d' = word32ToInteger d + in a' .|. b' .|. c' .|. d' + where + word32ToInteger :: Word32 -> Integer + word32ToInteger = toEnum . fromEnum + +integerToIP6 :: Integer -> IPv6 +integerToIP6 i = let a = integerToWord32 (i `shiftR` 96 .&. 0xffffffff) + b = integerToWord32 (i `shiftR` 64 .&. 0xffffffff) + c = integerToWord32 (i `shiftR` 32 .&. 0xffffffff) + d = integerToWord32 (i .&. 0xffffffff) + in IP6 (a,b,c,d) + where + integerToWord32 :: Integer -> Word32 + integerToWord32 = toEnum . fromEnum + +---------------------------------------------------------------- +-- -- Show -- @@ -391,3 +494,9 @@ d2 = shiftL s 8 .&. 0x00ff0000 d3 = shiftR s 8 .&. 0x0000ff00 d4 = shiftR s 24 .&. 0x000000ff + +-- | Convert IPv4 address to IPv4-embedded-in-IPv6 +ipv4ToIPv6 :: IPv4 -> IPv6 +ipv4ToIPv6 ip = toIPv6b [0,0,0,0,0,0,0,0,0,0,0xff,0xff,i1,i2,i3,i4] + where + [i1,i2,i3,i4] = fromIPv4 ip diff --git a/Data/IP/Op.hs b/Data/IP/Op.hs --- a/Data/IP/Op.hs +++ b/Data/IP/Op.hs @@ -29,8 +29,7 @@ intToMask = maskIPv4 instance Addr IPv6 where - IP6 (a1,a2,a3,a4) `masked` IP6 (m1,m2,m3,m4) = - IP6 (a1.&.m1,a2.&.m2,a3.&.m3,a4.&.m4) + masked = maskedIPv6 intToMask = maskIPv6 ---------------------------------------------------------------- @@ -84,3 +83,25 @@ where msk = intToMask len adr = ad `masked` msk + + +-- | Convert IPv4 range to IPV4-embedded-in-IPV6 range +ipv4RangeToIPv6 :: AddrRange IPv4 -> AddrRange IPv6 +ipv4RangeToIPv6 range = + makeAddrRange (toIPv6 [0,0,0,0,0,0xffff, (i1 `shift` 8) .|. i2, (i3 `shift` 8) .|. i4]) (masklen + 96) + where + (ip, masklen) = addrRangePair range + [i1,i2,i3,i4] = fromIPv4 ip + + +{-| + The 'unmakeAddrRange' functions take a 'AddrRange' and + returns the network address and a mask length. + +>>> addrRangePair ("127.0.0.0/8" :: AddrRange IPv4) +(127.0.0.0,8) +>>> addrRangePair ("2000::/8" :: AddrRange IPv6) +(2000::,8) +-} +addrRangePair :: Addr a => AddrRange a -> (a, Int) +addrRangePair (AddrRange adr _ len) = (adr, len) diff --git a/Data/IP/Range.hs b/Data/IP/Range.hs --- a/Data/IP/Range.hs +++ b/Data/IP/Range.hs @@ -137,6 +137,8 @@ maskedIPv6 :: IPv6 -> IPv6 -> IPv6 IP6 (a1,a2,a3,a4) `maskedIPv6` IP6 (m1,m2,m3,m4) = IP6 (a1.&.m1,a2.&.m2,a3.&.m3,a4.&.m4) + + ---------------------------------------------------------------- -- -- IsString diff --git a/Data/IP/RouteTable/Internal.hs b/Data/IP/RouteTable/Internal.hs --- a/Data/IP/RouteTable/Internal.hs +++ b/Data/IP/RouteTable/Internal.hs @@ -7,15 +7,17 @@ -} module Data.IP.RouteTable.Internal where -import Control.Applicative ((<$>)) +import Control.Applicative ((<$>),(<*>),pure) import Control.Monad import Data.Bits +import Data.Foldable (Foldable(..)) import Data.IP.Addr import Data.IP.Op import Data.IP.Range import Data.IntMap (IntMap, (!)) import qualified Data.IntMap as IM (fromList) -import Data.List (foldl') +import Data.Monoid +import Data.Traversable import Data.Word import Prelude hiding (lookup) @@ -100,6 +102,14 @@ instance Functor (IPRTable k) where fmap _ Nil = Nil fmap f (Node r a mv b1 b2) = Node r a (f <$> mv) (fmap f b1) (fmap f b2) + +instance Foldable (IPRTable k) where + foldMap _ Nil = mempty + foldMap f (Node _ _ mv b1 b2) = foldMap f mv <> foldMap f b1 <> foldMap f b2 + +instance Traversable (IPRTable k) where + traverse _ Nil = pure Nil + traverse f (Node r a mv b1 b2) = Node r a <$> traverse f mv <*> traverse f b1 <*> traverse f b2 ---------------------------------------------------------------- diff --git a/iproute.cabal b/iproute.cabal --- a/iproute.cabal +++ b/iproute.cabal @@ -1,5 +1,5 @@ Name: iproute -Version: 1.3.2 +Version: 1.4.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3