iproute 1.2.1 → 1.2.2
raw patch · 6 files changed
+143/−36 lines, 6 files
Files
- Data/IP/Addr.hs +27/−7
- Data/IP/Range.hs +21/−4
- Data/IP/RouteTable.hs +3/−2
- Data/IP/RouteTable/Internal.hs +24/−3
- iproute.cabal +1/−1
- test/Tests.hs +67/−19
Data/IP/Addr.hs view
@@ -13,6 +13,7 @@ {-| A unified IP data for 'IPv4' and 'IPv6'.+ To create this, use the data constructors. Or use 'read' @"192.0.2.1"@ :: 'IP', for example. Also, @"192.0.2.1"@ can be used as literal with OverloadedStrings. -} data IP = IPv4 { ipv4 :: IPv4 }@@ -31,13 +32,13 @@ {-| The abstract data structure to express an IPv4 address.- To create this, use 'toIPv4'. Or use 'read' @\"192.0.2.1\"@ :: 'IPv4', for example. Or use @\"192.0.2.1\"@ with OverloadedStrings.+ To create this, use 'toIPv4'. Or use 'read' @\"192.0.2.1\"@ :: 'IPv4', for example. Also, @\"192.0.2.1\"@ can be used as literal with OverloadedStrings. -} newtype IPv4 = IP4 IPv4Addr deriving (Eq, Ord) {-| The abstract data structure to express an IPv6 address.- To create this, use 'toIPv6'. Or use 'read' @\"2001:DB8::1\"@ :: 'IPv6', for example. Or use @\"2001:DB8::1\"@ with OverloadedStrings.+ To create this, use 'toIPv6'. Or use 'read' @\"2001:DB8::1\"@ :: 'IPv6', for example. Also, @\"2001:DB8::1\"@ can be used as literal with OverloadedStrings. -} newtype IPv6 = IP6 IPv6Addr deriving (Eq, Ord) @@ -103,17 +104,22 @@ -- Read -- +instance Read IP where+ readsPrec _ = parseIP+ instance Read IPv4 where readsPrec _ = parseIPv4 instance Read IPv6 where readsPrec _ = parseIPv6 -instance IsString IPv4 where- fromString = read--instance IsString IPv6 where- fromString = read+parseIP :: String -> [(IP,String)]+parseIP cs =+ case runParser ip4 cs of+ (Just ip,rest) -> [(IPv4 ip,rest)]+ (Nothing,_) -> case runParser ip6 cs of+ (Just ip,rest) -> [(IPv6 ip,rest)]+ (Nothing,_) -> error $ "parseIP" ++ cs parseIPv4 :: String -> [(IPv4,String)] parseIPv4 cs = case runParser ip4 cs of@@ -124,6 +130,20 @@ parseIPv6 cs = case runParser ip6 cs of (Nothing,_) -> error $ "parseIPv6 " ++ cs (Just a6,rest) -> [(a6,rest)]++----------------------------------------------------------------+--+-- IsString+--++instance IsString IP where+ fromString = read++instance IsString IPv4 where+ fromString = read++instance IsString IPv6 where+ fromString = read ---------------------------------------------------------------- --
Data/IP/Range.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE FlexibleInstances #-} module Data.IP.Range where -import Data.Bits import Control.Monad+import Data.Bits import Data.IP.Addr import Data.IP.Mask+import Data.String import Text.Appar.String ----------------------------------------------------------------@@ -12,6 +13,7 @@ {-| A unified data for 'AddrRange' 'IPv4' and 'AddrRange' 'IPv6'. To create this, use 'read' \"192.0.2.0/24\" :: 'IPRange'.+ Also, \"192.0.2.0/24\" can be used as literal with OverloadedStrings. -} data IPRange = IPv4Range { ipv4range :: AddrRange IPv4 }@@ -30,6 +32,7 @@ calculation. To create this, use 'makeAddrRange' or 'read' \"192.0.2.0/24\" :: 'AddrRange' 'IPv4'.+ Also, \"192.0.2.0/24\" can be used as literal with OverloadedStrings. -} data AddrRange a = AddrRange { -- |The 'addr' function returns an address from 'AddrRange'.@@ -58,10 +61,10 @@ -- instance Read IPRange where- readsPrec _ = parseIPRange- + readsPrec _ = parseIPRange+ parseIPRange :: String -> [(IPRange,String)]-parseIPRange cs = +parseIPRange cs = case runParser ip4range cs of (Just ip,rest) -> [(IPv4Range ip,rest)] (Nothing,_) -> case runParser ip6range cs of@@ -111,3 +114,17 @@ 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+--++instance IsString IPRange where+ fromString = read++instance IsString (AddrRange IPv4) where+ fromString = read++instance IsString (AddrRange IPv6) where+ fromString = read
Data/IP/RouteTable.hs view
@@ -16,8 +16,9 @@ , IPRTable -- ** Functions to manipulate an IP routing table , empty, insert, delete- , Data.IP.RouteTable.Internal.lookup+ , I.lookup+ , findMatch , fromList, toList ) where -import Data.IP.RouteTable.Internal+import Data.IP.RouteTable.Internal as I
Data/IP/RouteTable/Internal.hs view
@@ -7,6 +7,7 @@ -} module Data.IP.RouteTable.Internal where +import Control.Monad hiding (join) import Data.Bits import Data.IP.Addr import Data.IP.Op@@ -152,7 +153,7 @@ else node k2 tb2 v2 l (delete k1 r) | otherwise = s -node :: (Routable k) => AddrRange k -> k -> (Maybe a) -> IPRTable k a -> IPRTable k a -> IPRTable k a+node :: (Routable k) => AddrRange k -> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a node _ _ Nothing Nil r = r node _ _ Nothing l Nil = l node k tb v l r = Node k tb v l r@@ -160,8 +161,9 @@ ---------------------------------------------------------------- {-|- The 'lookup' function looks up 'IPRTable' with a key of 'AddrRange'- and returns its value if exists.+ The 'lookup' function looks up 'IPRTable' with a key of 'AddrRange'.+ If a routing information in 'IPRTable' matches the key, its value+ is returned. -} lookup :: Routable k => AddrRange k -> IPRTable k a -> Maybe a lookup k s = search k s Nothing@@ -180,6 +182,25 @@ then search k1 l vl else search k1 r vl | otherwise = res++----------------------------------------------------------------++{-|+ The 'findMatch' function looks up 'IPRTable' with a key of 'AddrRange'.+ If the key matches routing informations in 'IPRTable', they are+ returned.+-}++findMatch :: MonadPlus m => Routable k => AddrRange k -> IPRTable k a -> m (AddrRange k, a)+findMatch _ Nil = mzero+findMatch k1 (Node k2 _ Nothing l r)+ | k1 >:> k2 = findMatch k1 l `mplus` findMatch k1 r+ | k2 >:> k1 = findMatch k1 l `mplus` findMatch k1 r+ | otherwise = mzero+findMatch k1 (Node k2 _ (Just vl) l r)+ | k1 >:> k2 = return (k2, vl) `mplus` findMatch k1 l `mplus` findMatch k1 r+ | k2 >:> k1 = findMatch k1 l `mplus` findMatch k1 r+ | otherwise = mzero ----------------------------------------------------------------
iproute.cabal view
@@ -1,5 +1,5 @@ Name: iproute-Version: 1.2.1+Version: 1.2.2 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3
test/Tests.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} module Tests where @@ -45,15 +45,20 @@ testCase "fromto IPv4" test_fromto_ipv4 , testCase "lookup IPv4" test_lookup_ipv4 , testCase "lookup2 IPv4" test_lookup_ipv4_2+ , testCase "findMatch IPv4" test_findMatch_ipv4 ] , testGroup "Test case for IP" [ testCase "toIPv4" test_toIPv4 , testCase "toIPv6" test_toIPv6+ , testCase "read IP" test_read_IP+ , testCase "read IP 2" test_read_IP_2 , testCase "read IPv4" test_read_IPv4 , testCase "read IPv6" test_read_IPv6 , testCase "read IPv6 2" test_read_IPv6_2- , testCase "read IPv4 range" test_read_IPv4_range+ , testCase "read IP range" test_read_IP_range+ , testCase "read IP range 2" test_read_IP_range_2 , testCase "read IPv6 range" test_read_IPv6_range+ , testCase "read IPv6 range" test_read_IPv6_range , testCase "makeAddrRange IPv4" test_makeAddrRange_IPv4 , testCase "makeAddrRange IPv6" test_makeAddrRange_IPv6 , testCase "contains IPv4" test_contains_IPv4@@ -237,6 +242,12 @@ test_toIPv6 :: Assertion test_toIPv6 = show (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) @?= "2001:db8:00:00:00:00:00:01" +test_read_IP :: Assertion+test_read_IP = (read "192.0.2.1" :: IP) @?= IPv4 (read "192.0.2.1" :: IPv4)++test_read_IP_2 :: Assertion+test_read_IP_2 = (read "2001:db8:00:00:00:00:00:01" :: IP) @?= IPv6 (read "2001:db8:00:00:00:00:00:01" :: IPv6)+ test_read_IPv4 :: Assertion test_read_IPv4 = show (read "192.0.2.1" :: IPv4) @?= "192.0.2.1" @@ -246,6 +257,14 @@ test_read_IPv6_2 :: Assertion test_read_IPv6_2 = show (read "2001:240:11e:c00::101" :: IPv6) @?= "2001:240:11e:c00:00:00:00:101" +test_read_IP_range :: Assertion+test_read_IP_range = (read "192.0.2.1/24" :: IPRange)+ @?= IPv4Range (read "192.0.2.0/24" :: AddrRange IPv4)++test_read_IP_range_2 :: Assertion+test_read_IP_range_2 = (read "2001:db8:00:00:00:00:00:01/48" :: IPRange)+ @?= IPv6Range (read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6)+ test_read_IPv4_range :: Assertion test_read_IPv4_range = show (read "192.0.2.1/24" :: AddrRange IPv4) @?= "192.0.2.0/24" @@ -292,11 +311,11 @@ ipv4_list :: [AddrRange IPv4] ipv4_list = [- read "0.0.0.0/0"- , read "133.4.0.0/16"- , read "133.5.0.0/16"- , read "133.5.16.0/24"- , read "133.5.23.0/24"+ "0.0.0.0/0"+ , "133.4.0.0/16"+ , "133.5.0.0/16"+ , "133.5.16.0/24"+ , "133.5.23.0/24" ] test_fromto_ipv4 :: Assertion@@ -307,24 +326,53 @@ test_lookup_ipv4 :: Assertion test_lookup_ipv4 = do let rt = fromList pairs- lookup (read "127.0.0.1") rt @?= Just (read "0.0.0.0/0")- lookup (read "133.3.0.1") rt @?= Just (read "0.0.0.0/0")- lookup (read "133.4.0.0") rt @?= Just (read "133.4.0.0/16")- lookup (read "133.4.0.1") rt @?= Just (read "133.4.0.0/16")- lookup (read "133.5.16.0") rt @?= Just (read "133.5.16.0/24")- lookup (read "133.5.16.1") rt @?= Just (read "133.5.16.0/24")+ lookup "127.0.0.1" rt @?= Just "0.0.0.0/0"+ lookup "133.3.0.1" rt @?= Just "0.0.0.0/0"+ lookup "133.4.0.0" rt @?= Just "133.4.0.0/16"+ lookup "133.4.0.1" rt @?= Just "133.4.0.0/16"+ lookup "133.5.16.0" rt @?= Just "133.5.16.0/24"+ lookup "133.5.16.1" rt @?= Just "133.5.16.0/24" where pairs = zip ipv4_list ipv4_list test_lookup_ipv4_2 :: Assertion test_lookup_ipv4_2 = do let rt = fromList pairs- lookup (read "127.0.0.1") rt @?= Nothing- lookup (read "133.3.0.1") rt @?= Nothing- lookup (read "133.4.0.0") rt @?= Just (read "133.4.0.0/16")- lookup (read "133.4.0.1") rt @?= Just (read "133.4.0.0/16")- lookup (read "133.5.16.0") rt @?= Just (read "133.5.16.0/24")- lookup (read "133.5.16.1") rt @?= Just (read "133.5.16.0/24")+ lookup "127.0.0.1" rt @?= Nothing+ lookup "133.3.0.1" rt @?= Nothing+ lookup "133.4.0.0" rt @?= Just "133.4.0.0/16"+ lookup "133.4.0.1" rt @?= Just "133.4.0.0/16"+ lookup "133.5.16.0" rt @?= Just "133.5.16.0/24"+ lookup "133.5.16.1" rt @?= Just "133.5.16.0/24" where ipv4_list' = tail ipv4_list pairs = zip ipv4_list' ipv4_list'++test_findMatch_ipv4 :: Assertion+test_findMatch_ipv4 = do+ let rt = fromList pairs+ findMatch "127.0.0.1" rt @?= []+ findMatch "133.5.23.0/23" rt @?= [("133.5.23.0/24","133.5.23.0/24")]+ findMatch "133.5.0.0/16" rt @?= [+ ("133.5.0.0/16","133.5.0.0/16")+ , ("133.5.16.0/24","133.5.16.0/24")+ , ("133.5.23.0/24","133.5.23.0/24")+ ]+ findMatch "133.4.0.0/16" rt @?= [("133.4.0.0/16", "133.4.0.0/16")]+ findMatch "133.4.0.0/15" rt @?= [+ ("133.4.0.0/16","133.4.0.0/16")+ , ("133.5.0.0/16","133.5.0.0/16")+ , ("133.5.16.0/24","133.5.16.0/24")+ , ("133.5.23.0/24","133.5.23.0/24")+ ]+ findMatch "0.0.0.0/0" rt @?= [+ ("0.0.0.0/0", "0.0.0.0/0")+ , ("133.4.0.0/16", "133.4.0.0/16")+ , ("133.5.0.0/16", "133.5.0.0/16")+ , ("133.5.16.0/24", "133.5.16.0/24")+ , ("133.5.23.0/24", "133.5.23.0/24")+ ]+ where+ pairs = zip ipv4_list ipv4_list++----------------------------------------------------------------