diff --git a/IPv6Addr.cabal b/IPv6Addr.cabal --- a/IPv6Addr.cabal +++ b/IPv6Addr.cabal @@ -1,13 +1,13 @@ name: IPv6Addr -version: 0.2 +version: 0.3 license: BSD3 license-file: LICENSE -Copyright: Copyright © 2011-2012 - Michel Boucey +Copyright: Copyright © 2011-2013 - Michel Boucey author: Michel Boucey maintainer: Michel Boucey Bug-Reports: mailto:michel.boucey@gmail.com -synopsis: Library to deal with IPv6 address text representation. -description: Library to deal with IPv6 address text representation, canonization and manipulations. +synopsis: Library to deal with IPv6 address text representations. +description: Library to deal with IPv6 address text representations, canonization and manipulations. category: Network, Text stability: provisional build-type: Simple diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2011-2012 - Michel Boucey +Copyright (c) 2011-2013 - Michel Boucey All rights reserved. diff --git a/Text/IPv6Addr.hs b/Text/IPv6Addr.hs --- a/Text/IPv6Addr.hs +++ b/Text/IPv6Addr.hs @@ -1,15 +1,15 @@ --------------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- -- | -- Module : Text.IPv6Addr --- Copyright : (c) Michel Boucey 2011-2012 +-- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-style -- Maintainer : michel.boucey@gmail.com -- Stability : provisional -- --- Dealing with IPv6 address text representation, +-- Dealing with IPv6 address text representations, -- canonization and manipulations. -- --------------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- module Text.IPv6Addr ( @@ -18,45 +18,64 @@ , maybePureIPv6Addr , maybeFullIPv6Addr , getIPv6AddrOf + , ip6arpa + , randIPv6Addr ) where import Control.Monad (replicateM) import Data.Char (intToDigit,isDigit,isHexDigit,toLower) import Data.Function (on) import Data.List (group,isSuffixOf,elemIndex,elemIndices,intersperse) -import Data.Maybe (fromJust,isJust) +import Data.Maybe (catMaybes,fromJust,isJust) import qualified Data.Text as T import Data.Text.Read (decimal) import Numeric (showIntAtBase) import Text.IPv6Addr.Internal +import Text.IPv6Addr.Manip (sixteenBitsArbToken,partialRandAddr) import Text.IPv6Addr.Types --- | Returns Just the text representation of a canonized --- 'IPv6Addr' in conformation with RFC 5952, or Nothing. +-- | Returns 'Just' the text representation of a canonized +-- 'IPv6Addr' in conformation with RFC 5952, or 'Nothing'. -- --- > maybeIPv6Addr "0:0::FFFF:192.0.2.128" == Just "::ffff:192.0.2.128" +-- > maybeIPv6Addr "0:0::FFFF:192.0.2.128" == Just (IPv6Addr "::ffff:192.0.2.128") -- maybeIPv6Addr :: T.Text -> Maybe IPv6Addr -maybeIPv6Addr t = maybeTokIPv6Addr t >>= ipv6TokensToText +maybeIPv6Addr t = maybeTokIPv6Addr t >>= ipv6TokensToIPv6Addr --- | Returns Just a pure 'IPv6Addr', or Nothing. +-- | Returns 'Just' a pure 'IPv6Addr', or 'Nothing'. -- --- > maybePureIPv6Addr "::ffff:192.0.2.128" == Just "::ffff:c000:280" +-- > maybePureIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "::ffff:c000:280") -- maybePureIPv6Addr :: T.Text -> Maybe IPv6Addr -maybePureIPv6Addr t = maybeTokPureIPv6Addr t >>= ipv6TokensToText +maybePureIPv6Addr t = maybeTokPureIPv6Addr t >>= ipv6TokensToIPv6Addr --- | Returns Just a pure and expanded 'IPv6Addr', or Nothing. +-- | Returns 'Just' a pure and expanded 'IPv6Addr', or 'Nothing'. -- --- > maybeFullIPv6Addr "::ffff:192.0.2.128" == Just "0000:0000:0000:0000:0000:ffff:c000:0280" +-- > maybeFullIPv6Addr "::ffff:192.0.2.128" == Just (IPv6Addr "0000:0000:0000:0000:0000:ffff:c000:0280") -- maybeFullIPv6Addr :: T.Text -> Maybe IPv6Addr -maybeFullIPv6Addr t = do - a <- maybeTokPureIPv6Addr t - ipv6TokensToText $ expandTokens $ fromDoubleColon a +maybeFullIPv6Addr t = + maybeTokPureIPv6Addr t >>= \m -> ipv6TokensToIPv6Addr $ expandTokens $ fromDoubleColon m --- | Returns Just the canonized 'IPv6Addr' of the given network interface, +-- | Returns 'Just' the reverse lookup domain name corresponding of the given IPv6 address, +-- as define in RFC 3596 Section 2.5, or 'Nothing'. +-- +-- > ip6arpa "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." +-- +ip6arpa :: T.Text -> Maybe T.Text +ip6arpa t = + case maybeFullIPv6Addr t of + Just (IPv6Addr a) -> Just $ revaddr a T.empty + Nothing -> Nothing + where + revaddr i o = + if i == T.empty then o `T.append` T.pack "ip6.arpa." + else do let c = T.last i + revaddr (T.init i) + (if c /= ':' then o `T.append` T.pack [c] `T.append` T.pack "." else o) + +-- | Returns 'Just' the canonized 'IPv6Addr' of the given network interface, -- or Nothing. -- -- > getIPv6AddrOf "eth0" @@ -65,5 +84,9 @@ getIPv6AddrOf s = do l <- networkInterfacesIPv6AddrList case lookup s l of - Just a -> return $ maybeIPv6Addr $ T.pack $ show a + Just a -> return $ maybeIPv6Addr $ T.pack $ show a Nothing -> return Nothing + +-- | Returns a random 'IPv6Addr' +randIPv6Addr :: IO IPv6Addr +randIPv6Addr = partialRandAddr 8 >>= \p -> return $ IPv6Addr $ ipv6TokensToText p diff --git a/Text/IPv6Addr/Internal.hs b/Text/IPv6Addr/Internal.hs --- a/Text/IPv6Addr/Internal.hs +++ b/Text/IPv6Addr/Internal.hs @@ -1,30 +1,30 @@ --------------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- -- | -- Module : Text.IPv6Addr --- Copyright : (c) Michel Boucey 2011-2012 --- License : BSD-style +-- Copyright : (c) Michel Boucey 2011-2013 +-- License : BSD-Style -- Maintainer : michel.boucey@gmail.com -- Stability : provisional -- --- Dealing with IPv6 address text representation, +-- Dealing with IPv6 address text representations, -- canonization and manipulations. -- --------------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- module Text.IPv6Addr.Internal - ( - colon + ( colon , doubleColon , sixteenBits , ipv4Addr , expandTokens , maybeIPv6AddrToken , maybeIPv6AddrTokens + , ipv4AddrToIPv6AddrTokens , ipv6TokensToText + , ipv6TokensToIPv6Addr , isIPv6Addr , maybeTokIPv6Addr , maybeTokPureIPv6Addr - , ipv4AddrToIPv6AddrTokens , fromDoubleColon , toDoubleColon , networkInterfacesIPv6AddrList @@ -55,23 +55,36 @@ tok5efe = T.pack "5efe" tok200 = T.pack "200" -tokenizeBy :: Char -> T.Text -> [T.Text] -tokenizeBy c = T.groupBy ((==) `on` (== c)) +tokenizedBy :: Char -> T.Text -> [T.Text] +tokenizedBy c = T.groupBy ((==) `on` (== c)) -- --- Validation of IPv6 adress tokens +-- Validation of IPv6 address tokens -- dot :: T.Text -> Maybe IPv4AddrToken -dot s = if s == tokdot then Just Dot else Nothing +dot t + | t == tokdot = Just Dot + | otherwise = Nothing +colon :: T.Text -> Maybe IPv6AddrToken +colon t + | t == tokcolon = Just Colon + | otherwise = Nothing + +doubleColon :: T.Text -> Maybe IPv6AddrToken +doubleColon t + | t == tokdcolon = Just DoubleColon + | otherwise = Nothing + +sixteenBits:: T.Text -> Maybe IPv6AddrToken eightBitsToken :: T.Text -> Maybe IPv4AddrToken eightBitsToken t = case decimal t of Right p -> do let i = fst p if i >= 0 && i <= 255 && snd p == T.empty then Just (EightBits t) else Nothing - Left _ -> Nothing + Left _ -> Nothing ipv4Token :: T.Text -> Maybe IPv4AddrToken ipv4Token t @@ -81,31 +94,19 @@ ipv4Addr :: T.Text -> Maybe IPv6AddrToken ipv4Addr t = do - let r = map ipv4Token $ tokenizeBy '.' t + let r = map ipv4Token $ tokenizedBy '.' t if (Nothing `notElem` r) && (length r == 7) then Just (IPv4Addr t) else Nothing -colon :: T.Text -> Maybe IPv6AddrToken -colon t = if t == tokcolon - then Just Colon - else Nothing - -doubleColon :: T.Text -> Maybe IPv6AddrToken -doubleColon t = if t == tokdcolon - then Just DoubleColon - else Nothing - -sixteenBits:: T.Text -> Maybe IPv6AddrToken sixteenBits t = if T.length t < 5 then do -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1) let t'= T.dropWhile (=='0') t if T.length t' < 5 && T.all isHexDigit t' - then if T.null t' - then Just AllZeros - -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3) - else Just $ SixteenBits $ T.toLower t' + then + -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3) + Just (if T.null t' then AllZeros else SixteenBits $ T.toLower t') else Nothing else Nothing @@ -115,12 +116,10 @@ where expTok AllZeros = SixteenBits tok4x0 expTok (SixteenBits s) = do let ls = T.length s - if ls < 4 - then SixteenBits (T.replicate (4 - ls) tok0 `T.append` s) - else SixteenBits s + SixteenBits (if ls < 4 then T.replicate (4 - ls) tok0 `T.append` s else s) expTok t = t --- | Returns Just one of the valid 'IPv6AddrToken', or Nothing. +-- | Returns 'Just' one of the valid 'IPv6AddrToken', or 'Nothing'. maybeIPv6AddrToken :: T.Text -> Maybe IPv6AddrToken maybeIPv6AddrToken t | isJust t' = t' @@ -140,10 +139,10 @@ ipv6TokenToText (IPv4Addr a) = a -- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'Text'. -ipv6TokensToText :: [IPv6AddrToken] -> Maybe T.Text -ipv6TokensToText l = Just $ T.concat $ map ipv6TokenToText l +ipv6TokensToText :: [IPv6AddrToken] -> T.Text +ipv6TokensToText l = T.concat $ map ipv6TokenToText l --- | Returns True if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address. +-- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address. isIPv6Addr :: [IPv6AddrToken] -> Bool isIPv6Addr [] = False isIPv6Addr [DoubleColon] = True @@ -181,20 +180,19 @@ foldr oneMoreIPv4Addr 0 where oneMoreIPv4Addr t c = case t of IPv4Addr _ -> c + 1 - otherwise -> c + otherwise -> c --- | Returns Just a list of 'IPv6AddrToken', or Nothing. +-- | Returns 'Just' a list of 'IPv6AddrToken', or 'Nothing'. maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken] -maybeIPv6AddrTokens t = mapM maybeIPv6AddrToken $ tokenizeBy ':' t +maybeIPv6AddrTokens t = mapM maybeIPv6AddrToken $ tokenizedBy ':' t --- | This is the main function which returns Just the list of a tokenized IPv6 --- address's text representation validated against RFC 4291 and canonized --- in conformation with RFC 5952, or Nothing. +-- | This is the main function which returns 'Just' the list of a tokenized IPv6 +-- address text representation validated against RFC 4291 and canonized +-- in conformation with RFC 5952, or 'Nothing'. maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken] maybeTokIPv6Addr t = do ltks <- maybeIPv6AddrTokens t if isIPv6Addr ltks - -- then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks else Nothing where ipv4AddrReplacement ltks' = @@ -202,7 +200,7 @@ then init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks') else ltks' --- | Returns Just the list of tokenized pure IPv6 address, always rewriting an +-- | Returns 'Just' the list of tokenized pure IPv6 address, always rewriting an -- embedded IPv4 address if present. maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken] maybeTokPureIPv6Addr t = @@ -242,7 +240,7 @@ || [DoubleColon,SixteenBits tok5efe,Colon] `isSuffixOf` itks) otherwise -> False --- | Rewrites Just an embedded 'IPv4Addr' into the corresponding list of pure +-- | Rewrites 'Just' an embedded 'IPv4Addr' into the corresponding list of pure -- IPv6Addr tokens. -- -- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"] @@ -265,7 +263,8 @@ else do let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks let fsts = fst s - let snds = if length(snd s) >= 1 then tail(snd s) else [] + let snds = if not (null (snd s)) then tail(snd s) else [] + -- let snds = if length(snd s) >= 1 then tail(snd s) else [] let fste = if null fsts then [] else fsts ++ [Colon] let snde = if null snds then [] else Colon : snds fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde @@ -294,8 +293,8 @@ longestLengthZerosRun x = maximum $ map longest x where longest t = case t of - (True,i) -> i - otherwise -> 0 + (True,i) -> i + otherwise -> 0 zerosRunsList x = map helper $ groupZerosRuns x where @@ -304,8 +303,10 @@ where lh = length h groupZerosRuns = group . filter (/= Colon) +ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr +ipv6TokensToIPv6Addr l = Just $ IPv6Addr $ ipv6TokensToText l + networkInterfacesIPv6AddrList :: IO [(String,IPv6)] -networkInterfacesIPv6AddrList = do - n <- getNetworkInterfaces - return $ map networkInterfacesIPv6Addr n +networkInterfacesIPv6AddrList = + getNetworkInterfaces >>= \n -> return $ map networkInterfacesIPv6Addr n where networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a) diff --git a/Text/IPv6Addr/Manip.hs b/Text/IPv6Addr/Manip.hs --- a/Text/IPv6Addr/Manip.hs +++ b/Text/IPv6Addr/Manip.hs @@ -1,20 +1,21 @@ --------------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- -- | -- Module : Text.IPv6Addr --- Copyright : (c) Michel Boucey 2011-212 --- License : BSD-style +-- Copyright : (c) Michel Boucey 2011-2013 +-- License : BSD-Style -- Maintainer : michel.boucey@gmail.com -- Stability : provisional -- --- Dealing with IPv6 address's text representation, +-- Dealing with IPv6 address text representations, -- canonization and manipulations. -- --------------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- module Text.IPv6Addr.Manip ( module Text.IPv6Addr.Internal , sixteenBitsArbToken + , partialRandAddr , macAddrToIPv6AddrTokens , getTokIPv6AddrOf , getTokMacAddrOf @@ -29,31 +30,29 @@ import Network.Info -import Text.IPv6Addr import Text.IPv6Addr.Internal import Text.IPv6Addr.Types --- | Returns an arbitrary 'SixteenBits' token based on a mask \"____\", each +-- | Returns 'Just' an arbitrary 'SixteenBits' token based on a mask \"____\", each -- underscore being replaced by a random hexadecimal digit. -- -- > sixteenBitsArbToken "_f__" == Just (SixteenBits "bfd4") -- sixteenBitsArbToken :: String -> IO (Maybe IPv6AddrToken) -sixteenBitsArbToken m = do - cs <- mapM getHex m - return $ sixteenBits $ T.pack cs +sixteenBitsArbToken m = + mapM getHex m >>= \cs -> return $ sixteenBits $ T.pack cs where getHex c = case c of '_' -> hexRand otherwise -> return c - where hexRand = do - r <- randomRIO(0,15) - return $ intToDigit r + where hexRand = randomRIO(0,15) >>= \r -> return $ intToDigit r -ipv6AddrRand :: IO (Maybe IPv6Addr) -ipv6AddrRand = do - l <- replicateM 8 (sixteenBitsArbToken "____") - return $ ipv6TokensToText $ intersperse Colon $ catMaybes l +-- | Generates a partial 'IPv6Addr' with n 'SixteenBits' +partialRandAddr :: Int -> IO [IPv6AddrToken] +partialRandAddr n = + if n < 9 then do l <- replicateM n $ sixteenBitsArbToken "____" + return $ intersperse Colon $ catMaybes l + else return [] -- | Given a MAC address, returns the corresponding 'IPv6AddrToken' list, or an empty list. -- @@ -75,17 +74,16 @@ trans (snd s,l2 ++ [T.concat $ fst s]) -- --- Functions based upon Network.Info to get local MAC and IPv6 adresses. +-- Functions based upon Network.Info to get local MAC and IPv6 addresses. -- networkInterfacesMacAddrList :: IO [(String,MAC)] -networkInterfacesMacAddrList = do - n <- getNetworkInterfaces - return $ map networkInterfacesMac n +networkInterfacesMacAddrList = + getNetworkInterfaces >>= \n -> return $ map networkInterfacesMac n where networkInterfacesMac (NetworkInterface n _ _ m) = (n,m) --- | Given a valid name of a local network interface, returns Just the list of --- tokens of the interface's IPv6 address. +-- | Given a valid name of a local network interface, returns 'Just' the list of +-- tokens of the interface's IPv6 address, or 'Nothing'. getTokIPv6AddrOf :: String -> IO (Maybe [IPv6AddrToken]) getTokIPv6AddrOf s = do l <- networkInterfacesIPv6AddrList @@ -93,8 +91,9 @@ Just a -> return $ maybeTokIPv6Addr $ T.pack $ show a Nothing -> return Nothing --- | Given the valid name of a local network interface, --- returns the corresponding list of 'IPv6AddrToken' of the interface's MAC Address. +-- | Given a valid name of a local network interface, +-- returns 'Just' the corresponding list of 'IPv6AddrToken' of the interface's MAC Address, +-- or 'Nothing'. getTokMacAddrOf :: String -> IO (Maybe [IPv6AddrToken]) getTokMacAddrOf s = do l <- networkInterfacesMacAddrList diff --git a/Text/IPv6Addr/Types.hs b/Text/IPv6Addr/Types.hs --- a/Text/IPv6Addr/Types.hs +++ b/Text/IPv6Addr/Types.hs @@ -1,22 +1,24 @@ --------------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- -- | -- Module : Text.IPv6Addr --- Copyright : (c) Michel Boucey 2011 --- License : BSD-style +-- Copyright : (c) Michel Boucey 2011-2013 +-- License : BSD-Style -- Maintainer : michel.boucey@gmail.com -- Stability : provisional -- --- Dealing with IPv6 address's text representation, +-- Dealing with IPv6 address text representations, -- canonization and manipulations. -- --------------------------------------------------------------------------------- +-- ----------------------------------------------------------------------------- module Text.IPv6Addr.Types where import qualified Data.Text as T -type IPv6Addr = T.Text +data IPv4AddrToken = Dot | EightBits T.Text deriving (Eq,Show) +data IPv6Addr = IPv6Addr T.Text deriving (Eq,Show) + data IPv6AddrToken = SixteenBits T.Text -- ^ A four hexadecimal digits group representing a 16-Bit chunk | AllZeros -- ^ An all zeros 16-Bit chunk @@ -24,7 +26,3 @@ | DoubleColon -- ^ A double-colon stands for a unique compression of many consecutive 16-Bit chunks | IPv4Addr T.Text -- ^ An embedded IPv4 address as representation of the last 32-Bit deriving (Eq,Show) - -data IPv4AddrToken - = Dot - | EightBits T.Text deriving (Eq,Show)