iproute-1.2.11/0000755000000000000000000000000012114023442011442 5ustar0000000000000000iproute-1.2.11/iproute.cabal0000644000000000000000000000417112114023442014120 0ustar0000000000000000Name: iproute Version: 1.2.11 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Homepage: http://www.mew.org/~kazu/proj/iproute/ Synopsis: IP Routing Table Description: IP Routing Table is a tree of IP ranges to search one of them on the longest match base. It is a kind of TRIE with one way branching removed. Both IPv4 and IPv6 are supported. Category: Algorithms, Network Cabal-Version: >= 1.10 Build-Type: Simple Library Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Data.IP Data.IP.RouteTable Other-Modules: Data.IP.Addr Data.IP.Mask Data.IP.Op Data.IP.Range Data.IP.RouteTable.Internal Build-Depends: base >= 4 && < 5 , appar , byteorder , containers , network Test-Suite doctest Type: exitcode-stdio-1.0 Default-Language: Haskell2010 HS-Source-Dirs: test Ghc-Options: -threaded -Wall Main-Is: doctests.hs Build-Depends: base , doctest >= 0.9.3 Test-Suite spec Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: ., test Ghc-Options: -Wall Main-Is: Spec.hs Other-Modules: RouteTableSpec , IPSpec Build-Depends: base , hspec , QuickCheck , appar , byteorder , containers , network , safe Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/iproute.git iproute-1.2.11/LICENSE0000644000000000000000000000276512114023442012461 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. iproute-1.2.11/Setup.hs0000644000000000000000000000005612114023442013077 0ustar0000000000000000import Distribution.Simple main = defaultMain iproute-1.2.11/Data/0000755000000000000000000000000012114023442012313 5ustar0000000000000000iproute-1.2.11/Data/IP.hs0000644000000000000000000000071712114023442013164 0ustar0000000000000000{-| Data structures to express IPv4, IPv6 and IP range. -} module Data.IP ( -- * Documentation -- ** IP data IP (..) , IPv4, toIPv4, fromIPv4, fromHostAddress, toHostAddress , IPv6, toIPv6, fromIPv6, fromHostAddress6, toHostAddress6 -- ** IP range data , IPRange (..) , AddrRange (addr, mask, mlen) -- ** Address class , Addr (..) , makeAddrRange, (>:>), isMatchedTo ) where import Data.IP.Addr import Data.IP.Op import Data.IP.Range iproute-1.2.11/Data/IP/0000755000000000000000000000000012114023442012623 5ustar0000000000000000iproute-1.2.11/Data/IP/Addr.hs0000644000000000000000000002141212114023442014031 0ustar0000000000000000module Data.IP.Addr where import Control.Monad import Data.Bits import Data.Char import Data.List (foldl') import Data.String import Data.Word import Network.Socket import System.ByteOrder import Text.Appar.String import Text.Printf ---------------------------------------------------------------- {-| 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. >>> (read "192.0.2.1" :: IP) == IPv4 (read "192.0.2.1" :: IPv4) True >>> (read "2001:db8:00:00:00:00:00:01" :: IP) == IPv6 (read "2001:db8:00:00:00:00:00:01" :: IPv6) True -} data IP = IPv4 { ipv4 :: IPv4 } | IPv6 { ipv6 :: IPv6 } deriving (Eq) instance Show IP where show (IPv4 ip) = show ip show (IPv6 ip) = show ip ---------------------------------------------------------------- -- This is host byte order type IPv4Addr = Word32 type IPv6Addr = (Word32,Word32,Word32,Word32) {-| The abstract data type to express an IPv4 address. 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. >>> read "192.0.2.1" :: IPv4 192.0.2.1 -} newtype IPv4 = IP4 IPv4Addr deriving (Eq, Ord) {-| The abstract data type to express an IPv6 address. 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. >>> read "2001:db8:00:00:00:00:00:01" :: IPv6 2001:db8:00:00:00:00:00:01 >>> 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) ---------------------------------------------------------------- -- -- Show -- instance Show IPv4 where show = showIPv4 instance Show IPv6 where show = showIPv6 showIPv4 :: IPv4 -> String showIPv4 (IP4 a) = show4 a 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 = printf "%02x:%02x" r1 r2 where (r2,q2) = remQuo q (r1, _) = remQuo q2 ---------------------------------------------------------------- -- -- IntToIP -- {-| The 'toIPv4' function takes a list of 'Int' and returns 'IPv4'. >>> toIPv4 [192,0,2,1] 192.0.2.1 -} 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" {-| The 'toIPv6' function takes a list of 'Int' and returns 'IPv6'. >>> toIPv6 [0x2001,0xDB8,0,0,0,0,0,1] 2001:db8:00:00:00:00:00:01 -} toIPv6 :: [Int] -> IPv6 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" ---------------------------------------------------------------- -- -- IPToInt -- {-| The 'fromIPv4' function converts 'IPv4' to a list of 'Int'. >>> fromIPv4 (toIPv4 [192,0,2,1]) [192,0,2,1] -} fromIPv4 :: IPv4 -> [Int] fromIPv4 (IP4 w) = map (\n -> fromEnum $ (w `shiftR` n) .&. 0xff) [0o30, 0o20, 0o10, 0o00] {-| The 'toIPv6' function converts 'IPv6' to a list of 'Int'. >>> fromIPv6 (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) [8193,3512,0,0,0,0,0,1] -} fromIPv6 :: IPv6 -> [Int] fromIPv6 (IP6 (w1, w2, w3, w4)) = map fromEnum (concatMap split [w1,w2,w3,w4]) where split :: Word32 -> [Word32] split n = [n `shiftR` 0x10 .&. 0xffff, n .&. 0xffff] ---------------------------------------------------------------- -- -- Read -- instance Read IP where readsPrec _ = parseIP instance Read IPv4 where readsPrec _ = parseIPv4 instance Read IPv6 where 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,_) -> [] parseIPv4 :: String -> [(IPv4,String)] parseIPv4 cs = case runParser ip4 cs of (Nothing,_) -> [] (Just a4,rest) -> [(a4,rest)] parseIPv6 :: String -> [(IPv6,String)] parseIPv6 cs = case runParser ip6 cs of (Nothing,_) -> [] (Just a6,rest) -> [(a6,rest)] ---------------------------------------------------------------- -- -- IsString -- instance IsString IP where fromString = read instance IsString IPv4 where fromString = read instance IsString IPv6 where fromString = read ---------------------------------------------------------------- -- -- IPv4 Parser -- dig :: Parser Int dig = 0 <$ char '0' <|> toInt <$> oneOf ['1'..'9'] <*> many digit where toInt n ns = foldl' (\x y -> x * 10 + y) 0 . map digitToInt $ n : ns ip4 :: Parser IPv4 ip4 = skipSpaces >> toIPv4 <$> ip4' ip4' :: Parser [Int] ip4' = do as <- dig `sepBy1` char '.' check 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 skipSpaces :: Parser () skipSpaces = void $ many (char ' ') ---------------------------------------------------------------- -- -- IPv6 Parser (RFC 4291) -- 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") colon2 :: Parser () colon2 = void $ 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 = skipSpaces >> toIPv6 <$> ip6' ip6' :: Parser [Int] 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 -- -- | The 'fromHostAddress' function converts 'HostAddress' to 'IPv4'. fromHostAddress :: HostAddress -> IPv4 fromHostAddress addr4 | byteOrder == LittleEndian = IP4 $ fixByteOrder addr4 | otherwise = IP4 addr4 -- | The 'toHostAddress' function converts 'IPv4' to 'HostAddress'. toHostAddress :: IPv4 -> HostAddress toHostAddress (IP4 addr4) | byteOrder == LittleEndian = fixByteOrder addr4 | otherwise = addr4 -- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'. fromHostAddress6 :: HostAddress6 -> IPv6 fromHostAddress6 = IP6 -- | The 'toHostAddress6' function converts 'IPv6' to 'HostAddress6'. toHostAddress6 :: IPv6 -> HostAddress6 toHostAddress6 (IP6 addr6) = addr6 fixByteOrder :: Word32 -> Word32 fixByteOrder s = d1 .|. d2 .|. d3 .|. d4 where d1 = shiftL s 24 d2 = shiftL s 8 .&. 0x00ff0000 d3 = shiftR s 8 .&. 0x0000ff00 d4 = shiftR s 24 .&. 0x000000ff iproute-1.2.11/Data/IP/Mask.hs0000644000000000000000000000157612114023442014063 0ustar0000000000000000module Data.IP.Mask where import Data.Bits import Data.IP.Addr import Data.Word import Data.IntMap hiding (map) ---------------------------------------------------------------- maskIPv4 :: Int -> IPv4 maskIPv4 len = IP4 (masksIPv4 ! len) maskIPv6 :: Int -> IPv6 maskIPv6 len = IP6 (masksIPv6 ! len) masksWord32 :: [Word32] masksWord32 = take 33 $ iterate (`shift` 1) 0xffffffff masksIPv4 :: IntMap IPv4Addr masksIPv4 = fromList $ zip [32,31..0] masksWord32 masksIPv6 :: IntMap IPv6Addr masksIPv6 = fromList $ zip [128,127..0] ms where ms = m0 ++ m1 ++ m2 ++ m3 ++ m4 m0 = [(all1,all1,all1,all1)] m1 = map (\vmsk -> (all1,all1,all1,vmsk)) masks m2 = map (\vmsk -> (all1,all1,vmsk,all0)) masks m3 = map (\vmsk -> (all1,vmsk,all0,all0)) masks m4 = map (\vmsk -> (vmsk,all0,all0,all0)) masks masks = tail masksWord32 all1 = 0xffffffff all0 = 0x00000000 iproute-1.2.11/Data/IP/Op.hs0000644000000000000000000000463312114023442013543 0ustar0000000000000000module Data.IP.Op where import Data.Bits import Data.IP.Addr import Data.IP.Mask import Data.IP.Range ---------------------------------------------------------------- {-| >>> toIPv4 [127,0,2,1] `masked` intToMask 7 126.0.0.0 -} class Eq a => Addr a where {-| The 'masked' function takes an 'Addr' and a contiguous mask and returned a masked 'Addr'. -} masked :: a -> a -> a {-| The 'intToMask' function takes 'Int' and returns a contiguous mask. -} intToMask :: Int -> a instance Addr IPv4 where masked = maskedIPv4 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) intToMask = maskIPv6 ---------------------------------------------------------------- {-| The >:> operator takes two 'AddrRange'. It returns 'True' if the first 'AddrRange' contains the second 'AddrRange'. Otherwise, it returns 'False'. >>> makeAddrRange ("127.0.2.1" :: IPv4) 8 >:> makeAddrRange "127.0.2.1" 24 True >>> makeAddrRange ("127.0.2.1" :: IPv4) 24 >:> makeAddrRange "127.0.2.1" 8 False >>> makeAddrRange ("2001:DB8::1" :: IPv6) 16 >:> makeAddrRange "2001:DB8::1" 32 True >>> makeAddrRange ("2001:DB8::1" :: IPv6) 32 >:> makeAddrRange "2001:DB8::1" 16 False -} (>:>) :: Addr a => AddrRange a -> AddrRange a -> Bool a >:> b = mlen a <= mlen b && (addr b `masked` mask a) == addr a {-| The 'toMatchedTo' function take an 'Addr' address and an 'AddrRange', and returns 'True' if the range contains the address. >>> ("127.0.2.0" :: IPv4) `isMatchedTo` makeAddrRange "127.0.2.1" 24 True >>> ("127.0.2.0" :: IPv4) `isMatchedTo` makeAddrRange "127.0.2.1" 32 False >>> ("2001:DB8::1" :: IPv6) `isMatchedTo` makeAddrRange "2001:DB8::1" 32 True >>> ("2001:DB8::" :: IPv6) `isMatchedTo` makeAddrRange "2001:DB8::1" 128 False -} isMatchedTo :: Addr a => a -> AddrRange a -> Bool isMatchedTo a r = a `masked` mask r == addr r {-| The 'makeAddrRange' functions takes an 'Addr' address and a mask length. It creates a bit mask from the mask length and masks the 'Addr' address, then returns 'AddrRange' made of them. >>> makeAddrRange (toIPv4 [127,0,2,1]) 8 127.0.0.0/8 >>> makeAddrRange (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) 8 2000:00:00:00:00:00:00:00/8 -} makeAddrRange :: Addr a => a -> Int -> AddrRange a makeAddrRange ad len = AddrRange adr msk len where msk = intToMask len adr = ad `masked` msk iproute-1.2.11/Data/IP/Range.hs0000644000000000000000000000762012114023442014220 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} module Data.IP.Range where import Control.Monad import Data.Bits import Data.IP.Addr import Data.IP.Mask import Data.String import Text.Appar.String ---------------------------------------------------------------- {-| 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. >>> (read "192.0.2.1/24" :: IPRange) == IPv4Range (read "192.0.2.0/24" :: AddrRange IPv4) True >>> (read "2001:db8:00:00:00:00:00:01/48" :: IPRange) == IPv6Range (read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6) True -} data IPRange = IPv4Range { ipv4range :: AddrRange IPv4 } | IPv6Range { ipv6range :: AddrRange IPv6 } deriving (Eq) ---------------------------------------------------------------- -- -- Range -- {-| The Addr range consists of an address, a contiguous mask, and mask length. The contiguous mask and the mask length are essentially same information but contained for pre 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. >>> read "192.0.2.1/24" :: AddrRange IPv4 192.0.2.0/24 >>> read "2001:db8:00:00:00:00:00:01/48" :: AddrRange IPv6 2001:db8:00:00:00:00:00:00/48 -} data AddrRange a = AddrRange { -- |The 'addr' function returns an address from 'AddrRange'. addr :: !a -- |The 'mask' function returns a contiguous 'IP' mask from 'AddrRange'. , mask :: !a -- |The 'mlen' function returns a mask length from 'AddrRange'. , mlen :: {-# UNPACK #-} !Int } deriving (Eq, Ord) ---------------------------------------------------------------- -- -- Show -- instance Show a => Show (AddrRange a) where show x = show (addr x) ++ "/" ++ show (mlen x) instance Show IPRange where show (IPv4Range ip) = show ip show (IPv6Range ip) = show ip ---------------------------------------------------------------- -- -- Read -- instance Read IPRange where 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,_) -> [] instance Read (AddrRange IPv4) where readsPrec _ = parseIPv4Range instance Read (AddrRange IPv6) where readsPrec _ = parseIPv6Range parseIPv4Range :: String -> [(AddrRange IPv4,String)] parseIPv4Range cs = case runParser ip4range cs of (Nothing,_) -> [] (Just a4,rest) -> [(a4,rest)] parseIPv6Range :: String -> [(AddrRange IPv6,String)] parseIPv6Range cs = case runParser ip6range cs of (Nothing,_) -> [] (Just a6,rest) -> [(a6,rest)] ip4range :: Parser (AddrRange IPv4) ip4range = do ip <- ip4 len <- option 32 $ char '/' >> dig check len 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) ip6range :: Parser (AddrRange IPv6) ip6range = do ip <- ip6 len <- option 128 $ char '/' >> dig check len 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) ---------------------------------------------------------------- -- -- IsString -- instance IsString IPRange where fromString = read instance IsString (AddrRange IPv4) where fromString = read instance IsString (AddrRange IPv6) where fromString = read iproute-1.2.11/Data/IP/RouteTable.hs0000644000000000000000000000111012114023442015216 0ustar0000000000000000{-| IP routing table is a tree of 'IPRange' to search one of them on the longest match base. It is a kind of TRIE with one way branching removed. Both IPv4 and IPv6 are supported. For more information, see: -} module Data.IP.RouteTable ( -- * Documentation -- ** Routable class Routable (..) -- ** Type for IP routing table , IPRTable -- ** Functions to manipulate an IP routing table , empty, insert, delete , I.lookup , findMatch , fromList, toList ) where import Data.IP.RouteTable.Internal as I iproute-1.2.11/Data/IP/RouteTable/0000755000000000000000000000000012114023442014671 5ustar0000000000000000iproute-1.2.11/Data/IP/RouteTable/Internal.hs0000644000000000000000000001777212114023442017017 0ustar0000000000000000{-| IP routing table is a tree of 'AddrRange' to search one of them on the longest match base. It is a kind of TRIE with one way branching removed. Both IPv4 and IPv6 are supported. -} module Data.IP.RouteTable.Internal where import Control.Monad hiding (join) import Data.Bits 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.Word import Prelude hiding (lookup) ---------------------------------------------------------------- {-| A class to contain IPv4 and IPv6. -} class Addr a => Routable a where {-| The 'intToTBit' function takes 'Int' and returns an 'Routable' address whose only n-th bit is set. -} intToTBit :: Int -> a {-| The 'isZero' function takes an 'Routable' address and an test bit 'Routable' address and returns 'True' is the bit is unset, otherwise returns 'False'. -} isZero :: a -> a -> Bool instance Routable IPv4 where intToTBit = intToTBitIPv4 isZero a b = a `masked` b == IP4 0 instance Routable IPv6 where intToTBit = intToTBitIPv6 isZero a b = a `masked` b == IP6 (0,0,0,0) ---------------------------------------------------------------- -- -- Test Bit -- intToTBitIPv4 :: Int -> IPv4 intToTBitIPv4 len = IP4 (intToTBitsIPv4 ! len) intToTBitIPv6 :: Int -> IPv6 intToTBitIPv6 len = IP6 (intToTBitsIPv6 ! len) intToTBitsWord32 :: [Word32] intToTBitsWord32 = iterate (`shift` (-1)) 0x80000000 intToTBitsIPv4 :: IntMap IPv4Addr intToTBitsIPv4 = IM.fromList $ zip [0..32] intToTBitsWord32 intToTBitsIPv6 :: IntMap IPv6Addr intToTBitsIPv6 = IM.fromList $ zip [0..128] bs where bs = b1 ++ b2 ++ b3 ++ b4 ++ b5 b1 = map (\vbit -> (vbit,all0,all0,all0)) intToTBits b2 = map (\vbit -> (all0,vbit,all0,all0)) intToTBits b3 = map (\vbit -> (all0,all0,vbit,all0)) intToTBits b4 = map (\vbit -> (all0,all0,all0,vbit)) intToTBits b5 = [(all0,all0,all0,all0)] intToTBits = take 32 intToTBitsWord32 all0 = 0x00000000 ---------------------------------------------------------------- {-| The Tree structure for IP routing table based on TRIE with one way branching removed. This is an abstract data type, so you cannot touch its inside. Please use 'insert' or 'lookup', instead. -} data IPRTable k a = Nil | Node !(AddrRange k) !k !(Maybe a) !(IPRTable k a) !(IPRTable k a) deriving (Eq, Show) ---------------------------------------------------------------- {-| The 'empty' function returns an empty IP routing table. >>> (empty :: IPRTable IPv4 ()) == fromList [] True -} empty :: Routable k => IPRTable k a empty = Nil ---------------------------------------------------------------- {-| The 'insert' function inserts a value with a key of 'AddrRange' to 'IPRTable' and returns a new 'IPRTable'. >>> (insert ("127.0.0.1" :: AddrRange IPv4) () empty) == fromList [("127.0.0.1",())] True -} insert :: (Routable k) => AddrRange k -> a -> IPRTable k a -> IPRTable k a insert k1 v1 Nil = Node k1 tb1 (Just v1) Nil Nil 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 where tb1 = keyToTestBit k1 join :: Routable k => IPRTable k a -> IPRTable k a -> IPRTable k a 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) where mk = intToMask n keyToTestBit :: Routable k => AddrRange k -> k keyToTestBit = intToTBit . mlen isLeft :: Routable k => AddrRange k -> k -> Bool isLeft adr = isZero (addr adr) ---------------------------------------------------------------- {-| The 'delete' function deletes a value by a key of 'AddrRange' from 'IPRTable' and returns a new 'IPRTable'. >>> delete "127.0.0.1" (insert "127.0.0.1" () empty) == (empty :: IPRTable IPv4 ()) True -} delete :: (Routable k) => AddrRange k -> IPRTable k a -> IPRTable k a 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) | otherwise = s 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 ---------------------------------------------------------------- {-| The 'lookup' function looks up 'IPRTable' with a key of 'AddrRange'. If a routing information in 'IPRTable' matches the key, its value is returned. >>> let v4 = ["133.4.0.0/16","133.5.0.0/16","133.5.16.0/24","133.5.23.0/24"] :: [AddrRange IPv4] >>> let rt = fromList $ zip v4 v4 >>> 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 -} lookup :: Routable k => AddrRange k -> IPRTable k a -> Maybe a lookup k s = search k s Nothing 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 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 ---------------------------------------------------------------- {-| The 'findMatch' function looks up 'IPRTable' with a key of 'AddrRange'. If the key matches routing informations in 'IPRTable', they are returned. >>> let v4 = ["133.4.0.0/16","133.5.0.0/16","133.5.16.0/24","133.5.23.0/24"] :: [AddrRange IPv4] >>> let rt = fromList $ zip v4 $ repeat () >>> findMatch "133.4.0.0/15" rt :: [(AddrRange IPv4,())] [(133.4.0.0/16,()),(133.5.0.0/16,()),(133.5.16.0/24,()),(133.5.23.0/24,())] -} 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 ---------------------------------------------------------------- {-| The 'fromList' function creates a new IP routing table from a list of a pair of 'IPrange' and value. -} fromList :: Routable k => [(AddrRange k, a)] -> IPRTable k a fromList = foldl' (\s (k,v) -> insert k v s) empty {-| The 'toList' function creates a list of a pair of 'AddrRange' and value from an IP routing table. -} toList :: Routable k => IPRTable k a -> [(AddrRange k, a)] toList = foldt toL [] where toL Nil xs = xs toL (Node _ _ Nothing _ _) xs = xs toL (Node k _ (Just a) _ _) xs = (k,a) : xs ---------------------------------------------------------------- foldt :: (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b foldt _ v Nil = v foldt func v rt@(Node _ _ _ l r) = foldt func (foldt func (func rt v) l) r iproute-1.2.11/test/0000755000000000000000000000000012114023442012421 5ustar0000000000000000iproute-1.2.11/test/doctests.hs0000644000000000000000000000020412114023442014601 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["-XOverloadedStrings", "Data/IP.hs", "Data/IP/RouteTable.hs"] iproute-1.2.11/test/IPSpec.hs0000644000000000000000000000400512114023442014077 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module IPSpec where import Control.Applicative import Data.IP import Safe (readMay) import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.QuickCheck import RouteTableSpec () ---------------------------------------------------------------- -- -- Arbitrary -- data InvalidIPv4Str = Iv4 String deriving (Show) instance Arbitrary InvalidIPv4Str where arbitrary = arbitraryIIPv4Str arbitrary 32 arbitraryIIPv4Str :: Gen IPv4 -> Int -> Gen InvalidIPv4Str arbitraryIIPv4Str adrGen msklen = toIv4 <$> adrGen <*> lenGen where toIv4 adr len = Iv4 $ show adr ++ "/" ++ show len lenGen = oneof [choose (minBound, -1), choose (msklen + 1, maxBound)] data InvalidIPv6Str = Iv6 String deriving (Show) instance Arbitrary InvalidIPv6Str where arbitrary = arbitraryIIPv6Str arbitrary 128 arbitraryIIPv6Str :: Gen IPv6 -> Int -> Gen InvalidIPv6Str arbitraryIIPv6Str adrGen msklen = toIv6 <$> adrGen <*> lenGen where toIv6 adr len = Iv6 $ show adr ++ "/" ++ show len lenGen = oneof [choose (minBound, -1), choose (msklen + 1, maxBound)] ---------------------------------------------------------------- -- -- Spec -- spec :: Spec spec = do describe "read" $ do prop "IPv4" to_str_ipv4 prop "IPv6" to_str_ipv6 prop "IPv4 failure" ipv4_fail 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 "can read even if unnecessary spaces exist" $ do (readMay " ::1" :: Maybe IPv4) `shouldBe` readMay "::1" to_str_ipv4 :: AddrRange IPv4 -> Bool to_str_ipv4 a = readMay (show a) == Just a to_str_ipv6 :: AddrRange IPv6 -> Bool to_str_ipv6 a = readMay (show a) == Just a ipv4_fail :: InvalidIPv4Str -> Bool ipv4_fail (Iv4 a) = (readMay a :: Maybe (AddrRange IPv4)) == Nothing ipv6_fail :: InvalidIPv6Str -> Bool ipv6_fail (Iv6 a) = (readMay a :: Maybe (AddrRange IPv6)) == Nothing iproute-1.2.11/test/RouteTableSpec.hs0000644000000000000000000000464412114023442015646 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module RouteTableSpec where import Control.Applicative import Control.Monad import Data.IP import Data.IP.RouteTable.Internal import Data.List (sort, nub) import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.QuickCheck ---------------------------------------------------------------- -- -- Arbitrary -- instance Arbitrary (AddrRange IPv4) where arbitrary = arbitraryIP arbitrary 32 instance Arbitrary (AddrRange IPv6) where arbitrary = arbitraryIP arbitrary 128 instance Arbitrary IPv4 where arbitrary = arbitraryAdr toIPv4 255 4 instance Arbitrary IPv6 where arbitrary = arbitraryAdr toIPv6 65535 8 arbitraryAdr :: Routable a => ([Int] -> a) -> Int -> Int -> Gen a arbitraryAdr func width adrlen = func <$> replicateM adrlen (choose (0, width)) arbitraryIP :: Routable a => Gen a -> Int -> Gen (AddrRange a) arbitraryIP adrGen msklen = makeAddrRange <$> adrGen <*> choose (0,msklen) ---------------------------------------------------------------- -- -- Spec -- spec :: Spec spec = do describe "fromList" $ do prop "creates the same tree for random input and ordered input" (sort_ip :: [AddrRange IPv4] -> Bool) prop "creates the same tree for random input and ordered input" (sort_ip :: [AddrRange IPv6] -> Bool) prop "stores input in the incremental order" (ord_ip :: [AddrRange IPv4] -> Bool) prop "stores input in the incremental order" (ord_ip :: [AddrRange IPv6] -> Bool) describe "toList" $ do prop "expands as sorted" (fromto_ip :: [AddrRange IPv4] -> Bool) prop "expands as sorted" (fromto_ip :: [AddrRange IPv6] -> Bool) sort_ip :: (Routable a, Ord a) => [AddrRange a] -> Bool sort_ip xs = fromList (zip xs xs) == fromList (zip xs' xs') where xs' = sort xs fromto_ip :: (Routable a, Ord a) => [AddrRange a] -> Bool fromto_ip xs = nub (sort xs) == nub (sort ys) where ys = map fst . toList . fromList $ zip xs xs ord_ip :: Routable a => [AddrRange a] -> Bool ord_ip xs = isOrdered . fromList $ zip xs xs isOrdered :: Routable k => IPRTable k a -> Bool isOrdered = foldt (\x v -> v && ordered x) True ordered :: Routable k => IPRTable k a -> Bool ordered Nil = True ordered (Node k _ _ l r) = ordered' k l && ordered' k r where ordered' _ Nil = True ordered' k1 (Node k2 _ _ _ _) = k1 >:> k2 iproute-1.2.11/test/Spec.hs0000644000000000000000000000005412114023442013646 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}