iproute 1.2.6 → 1.2.7
raw patch · 5 files changed
+154/−111 lines, 5 files
Files
- Data/IP/Addr.hs +104/−65
- Data/IP/Op.hs +3/−3
- Data/IP/Range.hs +5/−6
- Data/IP/RouteTable/Internal.hs +41/−36
- iproute.cabal +1/−1
Data/IP/Addr.hs view
@@ -52,8 +52,12 @@ >>> read "2001:db8:00:00:00:00:00:01" :: IPv6 2001:db8:00:00:00:00:00:01->>> read "2001:240:11e:c00::101" :: IPv6-2001:240:11e:c00:00:00:00:101+>>> read "2001:db8:11e:c00::101" :: IPv6+2001:db8:11e:c00:00:00:00:101+>>> read "2001:db8:11e:c00:aa:bb:192.0.2.1" :: IPv6+2001:db8:11e:c00:aa:bb:c000:201+>>> read "2001:db8::192.0.2.1" :: IPv6+2001:db8:00:00:00:00:c000:201 -} newtype IPv6 = IP6 IPv6Addr deriving (Eq, Ord) @@ -70,21 +74,23 @@ showIPv4 :: IPv4 -> String showIPv4 (IP4 a) = show4 a- where- remQuo x = (x `mod` 256, x `div` 256)- show4 q = let (a4,q4) = remQuo q- (a3,q3) = remQuo q4- (a2,q2) = remQuo q3- (a1, _) = remQuo q2- in printf "%d.%d.%d.%d" a1 a2 a3 a4+ where+ remQuo x = (x `mod` 256, x `div` 256)+ show4 q = printf "%d.%d.%d.%d" a1 a2 a3 a4+ where+ (a4,q4) = remQuo q+ (a3,q3) = remQuo q4+ (a2,q2) = remQuo q3+ (a1, _) = remQuo q2 showIPv6 :: IPv6 -> String showIPv6 (IP6 (a1,a2,a3,a4)) = show6 a1 ++ ":" ++ show6 a2 ++ ":" ++ show6 a3 ++ ":" ++ show6 a4- where- remQuo x = (x `mod` 65536, x `div` 65536)- show6 q = let (r2,q2) = remQuo q- (r1, _) = remQuo q2- in printf "%02x:%02x" r1 r2+ where+ remQuo x = (x `mod` 65536, x `div` 65536)+ show6 q = printf "%02x:%02x" r1 r2+ where+ (r2,q2) = remQuo q+ (r1, _) = remQuo q2 ---------------------------------------------------------------- --@@ -99,9 +105,9 @@ -} toIPv4 :: [Int] -> IPv4 toIPv4 = IP4 . toWord32- where- toWord32 [a1,a2,a3,a4] = fromIntegral $ shift a1 24 + shift a2 16 + shift a3 8 + a4- toWord32 _ = error "toWord32"+ where+ toWord32 [a1,a2,a3,a4] = fromIntegral $ shift a1 24 + shift a2 16 + shift a3 8 + a4+ toWord32 _ = error "toWord32" {-| The 'toIPv6' function takes a list of 'Int' and returns 'IPv6'.@@ -110,13 +116,13 @@ 2001:db8:00:00:00:00:00:01 -} toIPv6 :: [Int] -> IPv6-toIPv6 ad = let [x1,x2,x3,x4] = map toWord32 $ split2 ad- in IP6 (x1,x2,x3,x4)- where- split2 [] = []- split2 x = take 2 x : split2 (drop 2 x)- toWord32 [a1,a2] = fromIntegral $ shift a1 16 + a2- toWord32 _ = error "toWord32"+toIPv6 ad = IP6 (x1,x2,x3,x4)+ where+ [x1,x2,x3,x4] = map toWord32 $ split2 ad+ split2 [] = []+ split2 x = take 2 x : split2 (drop 2 x)+ toWord32 [a1,a2] = fromIntegral $ shift a1 16 + a2+ toWord32 _ = error "toWord32" ---------------------------------------------------------------- --@@ -159,12 +165,11 @@ readsPrec _ = parseIPv6 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+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@@ -202,15 +207,19 @@ toInt n ns = foldl' (\x y -> x * 10 + y) 0 . map digitToInt $ n : ns ip4 :: Parser IPv4-ip4 = do+ip4 = toIPv4 <$> ip4'++ip4' :: Parser [Int]+ip4' = do as <- dig `sepBy1` char '.' check as- return $ toIPv4 as+ return as where test errmsg adr = when (adr < 0 || 255 < adr) (fail errmsg)- check as = do let errmsg = "IPv4 adddress"- when (length as /= 4) (fail errmsg)- mapM_ (test errmsg) as+ check as = do+ let errmsg = "IPv4 adddress"+ when (length as /= 4) (fail errmsg)+ mapM_ (test errmsg) as ---------------------------------------------------------------- --@@ -218,41 +227,71 @@ -- hex :: Parser Int-hex = do ns <- some hexDigit- check ns- let ms = map digitToInt ns- val = foldl' (\x y -> x * 16 + y) 0 ms- return val- where- check ns = when (length ns > 4) (fail "IPv6 address -- more than 4 hex")+hex = do+ ns <- some hexDigit+ check ns+ let ms = map digitToInt ns+ val = foldl' (\x y -> x * 16 + y) 0 ms+ return val+ where+ check ns = when (length ns > 4) (fail "IPv6 address -- more than 4 hex") +colon2 :: Parser String+colon2 = string "::"++format :: [Int] -> [Int] -> Parser [Int]+format bs1 bs2 = do+ let len1 = length bs1+ len2 = length bs2+ when (len1 > 7) (fail "IPv6 address1")+ when (len2 > 7) (fail "IPv6 address2")+ let len = 8 - len1 - len2+ when (len <= 0) (fail "IPv6 address3")+ let spring = replicate len 0+ return $ bs1 ++ spring ++ bs2+ ip6 :: Parser IPv6 ip6 = toIPv6 <$> ip6' ip6' :: Parser [Int]-ip6' = do colon2- bs <- option [] hexcolon- format [] bs- <|> try (do rs <- hexcolon- check rs- return rs)- <|> do bs1 <- hexcolon2- bs2 <- option [] hexcolon- format bs1 bs2- where- colon2 = string "::"- hexcolon = hex `sepBy1` char ':'- hexcolon2 = manyTill (hex <* char ':') (char ':')- format bs1 bs2 = do let len1 = length bs1- len2 = length bs2- when (len1 > 7) (fail "IPv6 address1")- when (len2 > 7) (fail "IPv6 address2")- let len = 8 - len1 - len2- when (len <= 0) (fail "IPv6 address3")- let spring = replicate len 0- return $ bs1 ++ spring ++ bs2- check bs = when (length bs /= 8) (fail "IPv6 address4")+ip6' = ip4Embedded+ <|> do colon2+ bs <- option [] hexcolon+ format [] bs+ <|> try (do rs <- hexcolon+ check rs+ return rs)+ <|> do bs1 <- hexcolon2+ bs2 <- option [] hexcolon+ format bs1 bs2+ where+ hexcolon = hex `sepBy1` char ':'+ hexcolon2 = manyTill (hex <* char ':') (char ':')+ check bs = when (length bs /= 8) (fail "IPv6 address4") +ip4Embedded :: Parser [Int]+ip4Embedded = try (do colon2+ bs <- beforeEmbedded+ embedded <- ip4'+ format [] (bs ++ ip4ToIp6 embedded))+ -- matches 2001:db8::192.0.2.1+ <|> try (do bs1 <- manyTill (try $ hex <* char ':') (char ':')+ bs2 <- option [] beforeEmbedded+ embedded <- ip4'+ format bs1 (bs2 ++ ip4ToIp6 embedded))+ -- matches 2001:db8:11e:c00:aa:bb:192.0.2.1+ <|> try (do bs <- beforeEmbedded+ embedded <- ip4'+ let rs = bs ++ ip4ToIp6 embedded+ check rs+ return rs)+ where+ beforeEmbedded = many $ try $ hex <* char ':'+ ip4ToIp6 [a,b,c,d] = [ a `shiftL` 8 .|. b+ , c `shiftL` 8 .|. d ]+ ip4ToIp6 _ = error "ip4ToIp6"+ check bs = when (length bs /= 8) (fail "IPv6 address4")+ ---------------------------------------------------------------- -- -- HostAddress and HostAddress6@@ -272,7 +311,7 @@ -- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'. fromHostAddress6 :: HostAddress6 -> IPv6-fromHostAddress6 addr6 = IP6 addr6+fromHostAddress6 = IP6 -- | The 'toHostAddress6' function converts 'IPv6' to 'HostAddress6'. toHostAddress6 :: IPv6 -> HostAddress6
Data/IP/Op.hs view
@@ -81,6 +81,6 @@ -} makeAddrRange :: Addr a => a -> Int -> AddrRange a makeAddrRange ad len = AddrRange adr msk len- where- msk = intToMask len- adr = ad `masked` msk+ where+ msk = intToMask len+ adr = ad `masked` msk
Data/IP/Range.hs view
@@ -74,12 +74,11 @@ readsPrec _ = parseIPRange parseIPRange :: String -> [(IPRange,String)]-parseIPRange cs =- case runParser ip4range cs of- (Just ip,rest) -> [(IPv4Range ip,rest)]- (Nothing,_) -> case runParser ip6range cs of- (Just ip,rest) -> [(IPv6Range ip,rest)]- (Nothing,_) -> error $ "parseIPRange" ++ cs+parseIPRange cs = case runParser ip4range cs of+ (Just ip,rest) -> [(IPv4Range ip,rest)]+ (Nothing,_) -> case runParser ip6range cs of+ (Just ip,rest) -> [(IPv6Range ip,rest)]+ (Nothing,_) -> error $ "parseIPRange" ++ cs instance Read (AddrRange IPv4) where readsPrec _ = parseIPv4Range
Data/IP/RouteTable/Internal.hs view
@@ -110,31 +110,33 @@ where tb1 = keyToTestBit k1 insert k1 v1 s@(Node k2 tb2 v2 l r)- | k1 == k2 = Node k1 tb1 (Just v1) l r- | k2 >:> k1 = if isLeft k1 tb2- then Node k2 tb2 v2 (insert k1 v1 l) r- else Node k2 tb2 v2 l (insert k1 v1 r)- | k1 >:> k2 = if isLeft k2 tb1- then Node k1 tb1 (Just v1) s Nil- else Node k1 tb1 (Just v1) Nil s- | otherwise = let n = Node k1 tb1 (Just v1) Nil Nil- in join n s+ | k1 == k2 = Node k1 tb1 (Just v1) l r+ | k2 >:> k1 = if isLeft k1 tb2 then+ Node k2 tb2 v2 (insert k1 v1 l) r+ else+ Node k2 tb2 v2 l (insert k1 v1 r)+ | k1 >:> k2 = if isLeft k2 tb1 then+ Node k1 tb1 (Just v1) s Nil+ else+ Node k1 tb1 (Just v1) Nil s+ | otherwise = let n = Node k1 tb1 (Just v1) Nil Nil+ in join n s where tb1 = keyToTestBit k1 join :: Routable k => IPRTable k a -> IPRTable k a -> IPRTable k a-join s1@(Node k1 _ _ _ _) s2@(Node k2 _ _ _ _) =- let kg = glue 0 k1 k2- tbg = keyToTestBit kg- in if isLeft k1 tbg- then Node kg tbg Nothing s1 s2- else Node kg tbg Nothing s2 s1+join s1@(Node k1 _ _ _ _) s2@(Node k2 _ _ _ _)+ | isLeft k1 tbg = Node kg tbg Nothing s1 s2+ | otherwise = Node kg tbg Nothing s2 s1+ where+ kg = glue 0 k1 k2+ tbg = keyToTestBit kg join _ _ = error "join" glue :: (Routable k) => Int -> AddrRange k -> AddrRange k -> AddrRange k glue n k1 k2- | addr k1 `masked` mk == addr k2 `masked` mk = glue (n + 1) k1 k2- | otherwise = makeAddrRange (addr k1) (n - 1)+ | addr k1 `masked` mk == addr k2 `masked` mk = glue (n + 1) k1 k2+ | otherwise = makeAddrRange (addr k1) (n - 1) where mk = intToMask n @@ -157,9 +159,10 @@ delete _ Nil = Nil delete k1 s@(Node k2 tb2 v2 l r) | k1 == k2 = node k2 tb2 Nothing l r- | k2 >:> k1 = if isLeft k1 tb2- then node k2 tb2 v2 (delete k1 l) r- else node k2 tb2 v2 l (delete k1 r)+ | k2 >:> k1 = if isLeft k1 tb2 then+ node k2 tb2 v2 (delete k1 l) r+ 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@@ -195,17 +198,19 @@ search :: Routable k => AddrRange k -> IPRTable k a -> Maybe a -> Maybe a search _ Nil res = res search k1 (Node k2 tb2 Nothing l r) res- | k1 == k2 = res- | k2 >:> k1 = if isLeft k1 tb2- then search k1 l res- else search k1 r res- | otherwise = res+ | k1 == k2 = res+ | k2 >:> k1 = if isLeft k1 tb2 then+ search k1 l res+ else+ search k1 r res+ | otherwise = res search k1 (Node k2 tb2 vl l r) res- | k1 == k2 = vl- | k2 >:> k1 = if isLeft k1 tb2- then search k1 l vl- else search k1 r vl- | otherwise = res+ | k1 == k2 = vl+ | k2 >:> k1 = if isLeft k1 tb2 then+ search k1 l vl+ else+ search k1 r vl+ | otherwise = res ---------------------------------------------------------------- @@ -223,13 +228,13 @@ 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+ | 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+ | 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.6+Version: 1.2.7 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3