iproute 1.7.11 → 1.7.12
raw patch · 5 files changed
+74/−39 lines, 5 files
Files
- Data/IP/Addr.hs +9/−12
- Data/IP/Builder.hs +43/−17
- Data/IP/Range.hs +17/−9
- iproute.cabal +1/−1
- test/IPSpec.hs +4/−0
Data/IP/Addr.hs view
@@ -490,26 +490,23 @@ -- IPv4 Parser -- -dig :: Parser Int-dig = 0 <$ char '0'- <|> toInt <$> oneOf ['1'..'9'] <*> many digit+octet :: Parser Int+octet = 0 <$ char '0'+ <|> (toInt =<< (:) <$> oneOf ['1'..'9'] <*> many digit) where- toInt n ns = foldl' (\x y -> x * 10 + y) 0 . map digitToInt $ n : ns+ toInt ds = maybe (fail "IPv4 address") pure $ foldr go Just ds 0+ go !d !f !n =+ let n' = n * 10 + ord d - 48+ in if n' <= 255 then f n' else Nothing ip4 :: Parser IPv4 ip4 = skipSpaces >> toIPv4 <$> ip4' ip4' :: Parser [Int] ip4' = do- as <- dig `sepBy1` char '.'- check as+ as <- octet `sepBy1` char '.'+ when (length as /= 4) (fail "IPv4 address") return as- where- test errmsg adr = when (adr < 0 || 255 < adr) (fail errmsg)- check as = do- let errmsg = "IPv4 address"- when (length as /= 4) (fail errmsg)- mapM_ (test errmsg) as skipSpaces :: Parser () skipSpaces = void $ many (char ' ')
Data/IP/Builder.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-}@@ -52,9 +53,9 @@ where quads a = ((qdot 0o30# a, qdot 0o20# a), (qdot 0o10# a, qfin a)) {-# INLINE quads #-}- qdot s (W32# a) = (W8# ((a `uncheckedShiftRL#` s) `and#` 0xff##), ())+ qdot s (W32# a) = (W8# (wordToWord8Compat# ((word32ToWordCompat# a `uncheckedShiftRL#` s) `and#` 0xff##)), ()) {-# INLINE qdot #-}- qfin (W32# a) = W8# (a `and#` 0xff##)+ qfin (W32# a) = W8# (wordToWord8Compat# (word32ToWordCompat# a `and#` 0xff##)) {-# INLINE qfin #-} dotsep = const 0x2e >$< toB P.word8 @@ -124,11 +125,13 @@ -- encoders for the eight field format (FF) cases. --- build_CHL = (\ (CHL w) -> ( fstUnit (hi16 w), fstUnit (lo16 w) ) )+ build_CHL = ( \ case CHL w -> ( fstUnit (hi16 w), fstUnit (lo16 w) )+ _ -> undefined ) >$< (colsep >*< P.word16Hex) >*< (colsep >*< P.word16Hex) --- build_HL = (\ (HL w) -> ( hi16 w, fstUnit (lo16 w) ) )+ build_HL = ( \ case HL w -> ( hi16 w, fstUnit (lo16 w) )+ _ -> undefined ) >$< P.word16Hex >*< colsep >*< P.word16Hex -- build_NOP = P.emptyB@@ -137,13 +140,16 @@ -- build_CC = const ((), ()) >$< colsep >*< colsep --- build_CLO = (\ (CLO w) -> fstUnit (lo16 w) )+ build_CLO = ( \ case CLO w -> fstUnit (lo16 w)+ _ -> undefined ) >$< colsep >*< P.word16Hex --- build_CHC = (\ (CHC w) -> fstUnit (sndUnit (hi16 w)) )+ build_CHC = ( \ case CHC w -> fstUnit (sndUnit (hi16 w))+ _ -> undefined ) >$< colsep >*< P.word16Hex >*< colsep --- build_HC = (\ (HC w) -> sndUnit (hi16 w))+ build_HC = ( \ case HC w -> sndUnit (hi16 w)+ _ -> undefined ) >$< P.word16Hex >*< colsep -- static encoders@@ -156,8 +162,8 @@ -- | Helpers hi16, lo16 :: Word32 -> Word16- hi16 !(W32# w) = W16# (w `uncheckedShiftRL#` 16#)- lo16 !(W32# w) = W16# (w `and#` 0xffff##)+ hi16 !(W32# w) = W16# (wordToWord16Compat# (word32ToWordCompat# w `uncheckedShiftRL#` 16#))+ lo16 !(W32# w) = W16# (wordToWord16Compat# (word32ToWordCompat# w `and#` 0xffff##)) -- fstUnit :: a -> ((), a) fstUnit = ((), )@@ -212,14 +218,14 @@ bestgap :: Word32 -> Word32 -> Word32 -> Word32 -> (Int, Int) bestgap !(W32# a0) !(W32# a1) !(W32# a2) !(W32# a3) = finalGap- (updateGap (0xffff## `and#` a3)- (updateGap (0xffff0000## `and#` a3)- (updateGap (0xffff## `and#` a2)- (updateGap (0xffff0000## `and#` a2)- (updateGap (0xffff## `and#` a1)- (updateGap (0xffff0000## `and#` a1)- (updateGap (0xffff## `and#` a0)- (initGap (0xffff0000## `and#` a0)))))))))+ (updateGap (0xffff## `and#` (word32ToWordCompat# a3))+ (updateGap (0xffff0000## `and#` (word32ToWordCompat# a3))+ (updateGap (0xffff## `and#` (word32ToWordCompat# a2))+ (updateGap (0xffff0000## `and#` (word32ToWordCompat# a2))+ (updateGap (0xffff## `and#` (word32ToWordCompat# a1))+ (updateGap (0xffff0000## `and#` (word32ToWordCompat# a1))+ (updateGap (0xffff## `and#` (word32ToWordCompat# a0))+ (initGap (0xffff0000## `and#` (word32ToWordCompat# a0)))))))))) where -- The state after the first input word is always i' = 7,@@ -252,3 +258,23 @@ s = e -# g in (I# s, I# e) {-# INLINE bestgap #-}++#if MIN_VERSION_base(4,16,0)+word32ToWordCompat# :: Word32# -> Word#+word32ToWordCompat# = word32ToWord#++wordToWord8Compat# :: Word# -> Word8#+wordToWord8Compat# = wordToWord8#++wordToWord16Compat# :: Word# -> Word16#+wordToWord16Compat# = wordToWord16#+#else+word32ToWordCompat# :: Word# -> Word#+word32ToWordCompat# x = x++wordToWord8Compat# :: Word# -> Word#+wordToWord8Compat# x = x++wordToWord16Compat# :: Word# -> Word#+wordToWord16Compat# x = x+#endif
Data/IP/Range.hs view
@@ -1,10 +1,11 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} module Data.IP.Range where -import Control.Monad import Data.Bits+import Data.Char import Data.Data (Data) import Data.IP.Addr import Data.IP.Mask@@ -102,16 +103,26 @@ (Nothing,_) -> [] (Just a6,rest) -> [(a6,rest)] +maskLen :: Int -> Parser Int+maskLen maxLen = do+ hasSlash <- option False $ True <$ char '/'+ if hasSlash+ then 0 <$ char '0'+ <|> (toInt =<< (:) <$> oneOf ['1'..'9'] <*> many digit)+ else return maxLen+ where+ toInt ds = maybe (fail "mask length") pure $ foldr go Just ds 0+ go !d !f !n =+ let n' = n * 10 + ord d - 48+ in if n' <= maxLen then f n' else Nothing+ ip4range :: Parser (AddrRange IPv4) ip4range = do ip <- ip4- len <- option 32 $ char '/' >> dig- check len+ len <- maskLen 32 let msk = maskIPv4 len adr = ip `maskedIPv4` msk return $ AddrRange adr msk len- where- check len = when (len < 0 || 32 < len) (fail "IPv4 mask length") maskedIPv4 :: IPv4 -> IPv4 -> IPv4 IP4 a `maskedIPv4` IP4 m = IP4 (a .&. m)@@ -119,13 +130,10 @@ ip6range :: Parser (AddrRange IPv6) ip6range = do ip <- ip6- len <- option 128 $ char '/' >> dig- check len+ len <- maskLen 128 let msk = maskIPv6 len adr = ip `maskedIPv6` msk return $ AddrRange adr msk len- where- check len = when (len < 0 || 128 < len) (fail ("IPv6 mask length: " ++ show len)) maskedIPv6 :: IPv6 -> IPv6 -> IPv6 IP6 (a1,a2,a3,a4) `maskedIPv6` IP6 (m1,m2,m3,m4) = IP6 (a1.&.m1,a2.&.m2,a3.&.m3,a4.&.m4)
iproute.cabal view
@@ -1,5 +1,5 @@ Name: iproute-Version: 1.7.11+Version: 1.7.12 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3
test/IPSpec.hs view
@@ -56,8 +56,12 @@ prop "IPv6 failure" ipv6_fail it "can read even if unnecessary spaces exist" $ do (readMay " 127.0.0.1" :: Maybe IPv4) `shouldBe` readMay "127.0.0.1"+ it "does not read overflow IPv4 octets" $ do+ (readMay "127.0.0.18446744073709551617" :: Maybe IPv4) `shouldBe` Nothing it "can read even if unnecessary spaces exist" $ do (readMay " ::1" :: Maybe IPv4) `shouldBe` readMay "::1"+ it "does not read overflow mask lengths" $ do+ (readMay "192.168.0.1/18446744073709551648" :: Maybe (AddrRange IPv4)) `shouldBe` Nothing to_str_ipv4 :: AddrRange IPv4 -> Bool to_str_ipv4 a = readMay (show a) == Just a