diff --git a/IPv6Addr.cabal b/IPv6Addr.cabal --- a/IPv6Addr.cabal +++ b/IPv6Addr.cabal @@ -1,8 +1,8 @@ Name: IPv6Addr -Version: 0.4 +Version: 0.5 License: BSD3 License-File: LICENSE -Copyright: Copyright © 2011-2013 - Michel Boucey +Copyright: Copyright © 2011-2014 - Michel Boucey Author: Michel Boucey Maintainer: Michel Boucey Bug-Reports: mailto:michel.boucey@gmail.com @@ -18,9 +18,11 @@ Library Build-Depends: attoparsec, - base >= 3 && <= 5, - bytestring >= 0.9, - network-info >= 0.2, + base < 5, + bytestring, + iproute, + network, + network-info, random, text diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2011-2013 - Michel Boucey +Copyright (c) 2011-2014 - Michel Boucey All rights reserved. diff --git a/Text/IPv6Addr.hs b/Text/IPv6Addr.hs --- a/Text/IPv6Addr.hs +++ b/Text/IPv6Addr.hs @@ -1,7 +1,7 @@ -- ----------------------------------------------------------------------------- -- Module : Text.IPv6Addr --- Copyright : (c) Michel Boucey 2011-2013 +-- Copyright : Copyright © Michel Boucey 2011-2014 -- License : BSD-style -- Maintainer : michel.boucey@gmail.com -- @@ -16,19 +16,29 @@ , maybeIPv6Addr , maybePureIPv6Addr , maybeFullIPv6Addr + , sameIPv6Addr + , fromIPv6Addr + , toIPv6 + , toHostName + , toIP6ARPA , getIPv6AddrOf - , ip6arpa , randIPv6Addr ) where -import Control.Applicative ((<$>)) +import Control.Applicative (pure,(<$>),(<*>)) +import Data.IP (IPv6) import Data.Maybe (fromJust) import qualified Data.Text as T +import Network (HostName) +import System.Random (randomRIO) import Text.IPv6Addr.Internal -import Text.IPv6Addr.Manip (sixteenBitArbToken,partialRandAddr) +import Text.IPv6Addr.Manip (randIPv6AddrChunk,randPartialIPv6Addr) import Text.IPv6Addr.Types +instance Eq IPv6Addr where + (==) (IPv6Addr a) (IPv6Addr b) = show (maybePureIPv6Addr a) == show (maybePureIPv6Addr b) + -- | Returns 'Just' the text representation of a canonized -- 'IPv6Addr' in conformation with RFC 5952, or 'Nothing'. -- @@ -39,45 +49,63 @@ -- | Returns 'Just' a pure 'IPv6Addr', or 'Nothing'. -- --- > maybePureIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "::ffff:c000:280") +-- > mabePureIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "::ffff:c000:280") -- maybePureIPv6Addr :: T.Text -> Maybe IPv6Addr maybePureIPv6Addr t = maybeTokPureIPv6Addr t >>= ipv6TokensToIPv6Addr --- | Returns 'Just' a pure and expanded 'IPv6Addr', or 'Nothing'. +-- | Returns 'Just' a pure and fully expanded 'IPv6Addr', or 'Nothing'. -- --- > maybeFullIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "0000:0000:0000:0000:0000:ffff:c000:0280") +-- > mayebFullIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "0000:0000:0000:0000:0000:ffff:c000:0280") -- maybeFullIPv6Addr :: T.Text -> Maybe IPv6Addr -maybeFullIPv6Addr t = - maybeTokPureIPv6Addr t >>= (ipv6TokensToIPv6Addr . expandTokens . fromDoubleColon) +maybeFullIPv6Addr t = maybeTokPureIPv6Addr t >>= (ipv6TokensToIPv6Addr . expandTokens . fromDoubleColon) --- | Returns 'Just' the reverse lookup domain name corresponding of the given IPv6 address --- (RFC 3596 Section 2.5), or 'Nothing'. +-- | Returns 'True' if arguments are two textual representations of the same IPv6 address. +sameIPv6Addr :: T.Text -> T.Text -> Bool +sameIPv6Addr a b = + case maybePureIPv6Addr a of + Nothing -> False + Just a' -> case maybePureIPv6Addr b of + Nothing -> False + Just b' -> a' == b' + +-- | Returns the reverse lookup domain name corresponding of the given IPv6 address (RFC 3596 Section 2.5). -- --- > ip6arpa (IPv6Addr "4321:0:1:2:3:4:567:89ab") == Just "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa." +-- > toIP6ARPA (IPv6Addr "4321:0:1:2:3:4:567:89ab") == "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.IP6.ARPA." -- -ip6arpa :: IPv6Addr -> T.Text -ip6arpa t = - rev (fromIPv6Addr $ fromJust $ maybeFullIPv6Addr $ fromIPv6Addr t) T.empty +toIP6ARPA :: IPv6Addr -> T.Text +toIP6ARPA a = + T.append (T.reverse $ T.concatMap trans $ fromIPv6Addr $ fromJust $ maybeFullIPv6Addr $ fromIPv6Addr a) (T.pack "IP6.ARPA.") where - rev i o = if i == T.empty - then o `T.append` T.pack "ip6.arpa." - else do let c = T.last i - rev (T.init i) - (if c /= ':' - then o `T.append` T.pack [c] `T.append` T.pack "." - else o) + trans ':' = T.empty + trans c = T.append (T.pack ".") (T.pack [c]) --- | Returns 'Just' the canonized 'IPv6Addr' of the given network interface, +-- | Given an 'IPv6Addr', returns the corresponding 'HostName'. +toHostName :: IPv6Addr -> HostName +toHostName = show + +-- | Given an 'IPv6addr', returns the corresponding 'IPv6' address. +toIPv6 :: IPv6Addr -> IPv6 +toIPv6 a = read $ show a + +-- | Returns 'Just' the canonized 'IPv6Addr' of the given local network interface, -- or 'Nothing'. -- -- > getIPv6AddrOf "eth0" -- getIPv6AddrOf :: String -> IO (Maybe IPv6Addr) -getIPv6AddrOf s = - maybe Nothing (maybeIPv6Addr . T.pack . show) <$> (lookup s <$> networkInterfacesIPv6AddrList) +getIPv6AddrOf s = maybe Nothing (maybeIPv6Addr . T.pack . show) <$> (lookup s <$> networkInterfacesIPv6AddrList) --- | Returns a random 'IPv6Addr' +-- | Returns a random 'IPv6Addr'. randIPv6Addr :: IO IPv6Addr -randIPv6Addr = IPv6Addr . ipv6TokensToText <$> partialRandAddr 8 +randIPv6Addr = do + r <- randomRIO (1,8) + tks <- case r of + 8 -> randPartialIPv6Addr 8 + _ -> do r' <- randomRIO (1,8-r) + case r + r' of + 7 -> concat <$> sequence [randPartialIPv6Addr r,pure [Colon,AllZeros,Colon],randPartialIPv6Addr r'] + 8 -> randPartialIPv6Addr 8 + _ -> concat <$> sequence [randPartialIPv6Addr r,pure [DoubleColon],randPartialIPv6Addr r'] + return $ fromJust $ ipv6TokensToIPv6Addr tks diff --git a/Text/IPv6Addr/Internal.hs b/Text/IPv6Addr/Internal.hs --- a/Text/IPv6Addr/Internal.hs +++ b/Text/IPv6Addr/Internal.hs @@ -2,7 +2,7 @@ -- | -- Module : Text.IPv6Addr --- Copyright : (c) Michel Boucey 2011-2013 +-- Copyright : Copyright © Michel Boucey 2011-2014 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com -- @@ -55,8 +55,7 @@ ipv6TokenToText (SixteenBit s) = s ipv6TokenToText Colon = T.pack ":" ipv6TokenToText DoubleColon = T.pack "::" --- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1) -ipv6TokenToText AllZeros = tok0 -- +ipv6TokenToText AllZeros = tok0 -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1) ipv6TokenToText (IPv4Addr a) = a -- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address. @@ -178,8 +177,7 @@ tokffff = T.pack "ffff" tok5efe = T.pack "5efe" --- | Rewrites 'Just' an embedded 'IPv4Addr' into the corresponding list of pure --- 'IPv6Addr' tokens. +-- | Rewrites 'Just' an embedded 'IPv4Addr' into the corresponding list of pure 'IPv6Addr' tokens. -- -- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"] -- @@ -188,9 +186,9 @@ case t of IPv4Addr a -> do let m = toHex a - [ SixteenBit ((!!) m 0 `T.append` addZero ((!!) m 1)) + [ SixteenBit ((!!) m 0 `T.append` addZero ((!!) m 1)) , Colon - , SixteenBit ((!!) m 2 `T.append` addZero ((!!) m 3))] + , SixteenBit ((!!) m 2 `T.append` addZero ((!!) m 3)) ] _ -> [t] where toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a @@ -257,7 +255,7 @@ fullSixteenBit :: T.Text -> Maybe IPv6AddrToken fullSixteenBit t = - case parse fourHexaChars t of + case parse ipv6AddrFullChunk t of Done a b -> if a==T.empty then Just $ SixteenBit $ T.pack b else Nothing _ -> Nothing @@ -273,7 +271,7 @@ sixteenBit :: Parser IPv6AddrToken sixteenBit = do - r <- fourHexaChars <|> count 3 hexaChar <|> count 2 hexaChar <|> count 1 hexaChar + r <- ipv6AddrFullChunk <|> count 3 hexaChar <|> count 2 hexaChar <|> count 1 hexaChar -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1) let r' = T.dropWhile (=='0') $ T.pack r return $ if T.null r' @@ -315,8 +313,8 @@ string $ T.pack ":" return Colon -fourHexaChars :: Parser String -fourHexaChars = count 4 hexaChar +ipv6AddrFullChunk :: Parser String +ipv6AddrFullChunk = count 4 hexaChar hexaChar :: Parser Char hexaChar = satisfy (inClass "0-9a-fA-F") diff --git a/Text/IPv6Addr/Manip.hs b/Text/IPv6Addr/Manip.hs --- a/Text/IPv6Addr/Manip.hs +++ b/Text/IPv6Addr/Manip.hs @@ -2,7 +2,7 @@ -- | -- Module : Text.IPv6Addr --- Copyright : (c) Michel Boucey 2011-2013 +-- Copyright : Copyright © Michel Boucey 2011-2014 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com -- @@ -12,8 +12,8 @@ -- ----------------------------------------------------------------------------- module Text.IPv6Addr.Manip - ( sixteenBitArbToken - , partialRandAddr + ( randIPv6AddrChunk + , randPartialIPv6Addr , macAddrToIPv6AddrTokens , getTokIPv6AddrOf , getTokMacAddrOf @@ -32,24 +32,24 @@ import Text.IPv6Addr.Internal import Text.IPv6Addr.Types --- | Returns 'Just' an arbitrary 'SixteenBit' token based on a mask \"____\", each +-- | Returns 'Just' a random 'SixteenBit' token based on a mask \"____\", each -- underscore being replaced by a random hexadecimal digit. -- --- > sixteenBitArbToken "_f__" == Just (SixteenBit "bfd4") +-- > randIPv6AddrChunk "_f__" == Just (SixteenBit "bfd4") -- -sixteenBitArbToken :: String -> IO IPv6AddrToken -sixteenBitArbToken m = +randIPv6AddrChunk :: String -> IO IPv6AddrToken +randIPv6AddrChunk m = mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g where getHex c - | c == '_' = randomRIO(0,15) >>= \r -> return $ intToDigit r + | c == '_' = intToDigit <$> randomRIO (0,15) | otherwise = return c --- | Generates a partial 'IPv6Addr' with n 'SixteenBit' -partialRandAddr :: Int -> IO [IPv6AddrToken] -partialRandAddr n - | n > 0 && n < 9 = intersperse Colon <$> replicateM n (sixteenBitArbToken "____") - | otherwise = return [] +-- | Generates a random partial 'IPv6Addr' with n 'SixteenBit' +randPartialIPv6Addr :: Int -> IO [IPv6AddrToken] +randPartialIPv6Addr n + | n > 0 && n < 9 = intersperse Colon <$> replicateM n (randIPv6AddrChunk "____") + | otherwise = return [] -- | Given a MAC address, returns the corresponding 'IPv6AddrToken' list, or an empty list. -- @@ -58,7 +58,7 @@ macAddrToIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken] macAddrToIPv6AddrTokens t = case parse macAddr t of - Done a b -> if a==T.empty then intersperse Colon <$> b else Nothing + Done a b -> if a == T.empty then intersperse Colon <$> b else Nothing _ -> Nothing -- diff --git a/Text/IPv6Addr/Types.hs b/Text/IPv6Addr/Types.hs --- a/Text/IPv6Addr/Types.hs +++ b/Text/IPv6Addr/Types.hs @@ -2,7 +2,7 @@ -- | -- Module : Text.IPv6Addr --- Copyright : (c) Michel Boucey 2011-2013 +-- Copyright : Copyright © Michel Boucey 2011-2014 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com -- @@ -15,7 +15,10 @@ import qualified Data.Text as T -data IPv6Addr = IPv6Addr T.Text deriving (Eq,Show) +data IPv6Addr = IPv6Addr T.Text + +instance Show IPv6Addr where + show (IPv6Addr addr) = T.unpack addr data IPv6AddrToken = SixteenBit T.Text -- ^ A four hexadecimal digits group representing a 16-Bit chunk diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -94,9 +94,10 @@ , (~?=) (maybeFullIPv6Addr "a:bb:ccc:dddd:1cDc::1") (Just (IPv6Addr "000a:00bb:0ccc:dddd:1cdc:0000:0000:0001")) , (~?=) (maybeFullIPv6Addr "FE80::0202:B3FF:FE1E:8329") (Just (IPv6Addr "fe80:0000:0000:0000:0202:b3ff:fe1e:8329")) , (~?=) (maybeFullIPv6Addr "aDb6::CE67") (Just (IPv6Addr "adb6:0000:0000:0000:0000:0000:0000:ce67")) - , (~?=) (ip6arpa (IPv6Addr "::1")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa." - , (~?=) (ip6arpa (IPv6Addr "2b02:0b08:0:7::0001")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.7.0.0.0.0.0.0.0.8.0.b.0.2.0.b.2.ip6.arpa." - , (~?=) (ip6arpa (IPv6Addr "2b02:b08:0:7::1")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.7.0.0.0.0.0.0.0.8.0.b.0.2.0.b.2.ip6.arpa." - , (~?=) (ip6arpa (IPv6Addr "fdda:5cc1:23:4::1f")) "f.1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.4.0.0.0.3.2.0.0.1.c.c.5.a.d.d.f.ip6.arpa." - , (~?=) (ip6arpa (IPv6Addr "4321:0:1:2:3:4:567:89ab")) "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa." + , (~?=) (toIP6ARPA (IPv6Addr "::1")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.IP6.ARPA." + , (~?=) (toIP6ARPA (IPv6Addr "2b02:0b08:0:7::0001")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.7.0.0.0.0.0.0.0.8.0.b.0.2.0.b.2.IP6.ARPA." + , (~?=) (toIP6ARPA (IPv6Addr "2b02:b08:0:7::1")) "1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.7.0.0.0.0.0.0.0.8.0.b.0.2.0.b.2.IP6.ARPA." + , (~?=) (toIP6ARPA (IPv6Addr "fdda:5cc1:23:4::1f")) "f.1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.4.0.0.0.3.2.0.0.1.c.c.5.a.d.d.f.IP6.ARPA." + , (~?=) (toIP6ARPA (IPv6Addr "2001:db8::")) "0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.IP6.ARPA." + , (~?=) (toIP6ARPA (IPv6Addr "4321:0:1:2:3:4:567:89ab")) "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.IP6.ARPA." ]