diff --git a/IPv6Addr.cabal b/IPv6Addr.cabal --- a/IPv6Addr.cabal +++ b/IPv6Addr.cabal @@ -1,29 +1,41 @@ -name: IPv6Addr -version: 0.3.0.1 -license: BSD3 -license-file: LICENSE +Name: IPv6Addr +Version: 0.4 +License: BSD3 +License-File: LICENSE Copyright: Copyright © 2011-2013 - Michel Boucey -author: Michel Boucey -maintainer: Michel Boucey +Author: Michel Boucey +Maintainer: Michel Boucey Bug-Reports: mailto:michel.boucey@gmail.com -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 -cabal-version: >= 1.6 -source-repository head - type: git - location: https://github.com/MichelBoucey/IPv6Addr +Synopsis: Library to deal with IPv6 address text representations. +Description: Library to deal with IPv6 address text representations, canonization and manipulations. +Category: Network, Text +Build-Type: Simple +Cabal-Version: >= 1.8 +Source-Repository head + Type: git + Location: https://github.com/MichelBoucey/IPv6Addr + Library - Build-Depends: base >= 3 && <= 5, + Build-Depends: attoparsec, + base >= 3 && <= 5, bytestring >= 0.9, network-info >= 0.2, random, text - exposed-modules: Text.IPv6Addr + Exposed-Modules: Text.IPv6Addr Text.IPv6Addr.Internal Text.IPv6Addr.Manip Text.IPv6Addr.Types + +Test-Suite tests + Type: exitcode-stdio-1.0 + HS-Source-Dirs: tests + Main-Is: Main.hs + Build-Depends: base, + HUnit, + IPv6Addr, + test-framework, + test-framework-hunit, + text diff --git a/Text/IPv6Addr.hs b/Text/IPv6Addr.hs --- a/Text/IPv6Addr.hs +++ b/Text/IPv6Addr.hs @@ -1,11 +1,9 @@ -- ----------------------------------------------------------------------------- --- | -- Module : Text.IPv6Addr -- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-style -- Maintainer : michel.boucey@gmail.com --- Stability : provisional -- -- Dealing with IPv6 address text representations, canonization and manipulations. -- @@ -14,7 +12,7 @@ module Text.IPv6Addr ( - IPv6Addr + IPv6Addr (IPv6Addr) , maybeIPv6Addr , maybePureIPv6Addr , maybeFullIPv6Addr @@ -23,17 +21,12 @@ , 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 (catMaybes,fromJust,isJust) +import Control.Applicative ((<$>)) +import Data.Maybe (fromJust) 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.Manip (sixteenBitArbToken,partialRandAddr) import Text.IPv6Addr.Types -- | Returns 'Just' the text representation of a canonized @@ -57,24 +50,24 @@ -- maybeFullIPv6Addr :: T.Text -> Maybe IPv6Addr maybeFullIPv6Addr t = - maybeTokPureIPv6Addr t >>= \m -> ipv6TokensToIPv6Addr $ expandTokens $ fromDoubleColon m + 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'. -- --- > 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 (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." -- -ip6arpa :: T.Text -> Maybe T.Text +ip6arpa :: IPv6Addr -> T.Text ip6arpa t = - case maybeFullIPv6Addr t of - Just (IPv6Addr a) -> Just $ revaddr a T.empty - Nothing -> Nothing + rev (fromIPv6Addr $ fromJust $ maybeFullIPv6Addr $ fromIPv6Addr t) T.empty 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) + 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) -- | Returns 'Just' the canonized 'IPv6Addr' of the given network interface, -- or 'Nothing'. @@ -82,12 +75,9 @@ -- > getIPv6AddrOf "eth0" -- getIPv6AddrOf :: String -> IO (Maybe IPv6Addr) -getIPv6AddrOf s = do - l <- networkInterfacesIPv6AddrList - case lookup s l of - Just a -> return $ maybeIPv6Addr $ T.pack $ show a - Nothing -> return Nothing +getIPv6AddrOf s = + maybe Nothing (maybeIPv6Addr . T.pack . show) <$> (lookup s <$> networkInterfacesIPv6AddrList) -- | Returns a random 'IPv6Addr' randIPv6Addr :: IO IPv6Addr -randIPv6Addr = partialRandAddr 8 >>= \p -> return $ IPv6Addr $ ipv6TokensToText p +randIPv6Addr = IPv6Addr . ipv6TokensToText <$> partialRandAddr 8 diff --git a/Text/IPv6Addr/Internal.hs b/Text/IPv6Addr/Internal.hs --- a/Text/IPv6Addr/Internal.hs +++ b/Text/IPv6Addr/Internal.hs @@ -5,7 +5,6 @@ -- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com --- Stability : provisional -- -- Dealing with IPv6 address text representations, canonization and manipulations. -- @@ -13,12 +12,8 @@ -- ----------------------------------------------------------------------------- module Text.IPv6Addr.Internal - ( colon - , doubleColon - , sixteenBits - , ipv4Addr - , expandTokens - , maybeIPv6AddrToken + ( expandTokens + , macAddr , maybeIPv6AddrTokens , ipv4AddrToIPv6AddrTokens , ipv6TokensToText @@ -27,127 +22,48 @@ , maybeTokIPv6Addr , maybeTokPureIPv6Addr , fromDoubleColon + , fromIPv6Addr , toDoubleColon , networkInterfacesIPv6AddrList ) where import Control.Monad (replicateM) +import Data.Attoparsec.Text as A import Data.Char (isDigit,isHexDigit,toLower) -import Data.Function (on) +import Control.Applicative ((<|>)) import Data.List (group,isSuffixOf,elemIndex,elemIndices,intersperse) import Numeric (showHex) import qualified Data.Text as T -import Data.Text.Read (decimal) -import Data.Maybe (fromJust,isJust) +import qualified Data.Text.Read as R (decimal) +import Data.Maybe (fromJust) import Network.Info import Text.IPv6Addr.Types -tokdot = T.pack "." -tokcolon = T.pack ":" -tokdcolon = T.pack "::" tok0 = T.pack "0" -tok4x0 = T.pack "0000" -tok1 = T.pack "1" -tokffff = T.pack "ffff" -tok64 = T.pack "64" -tokff9b = T.pack "ff9b" -tokfe80 = T.pack "fe80" -tok5efe = T.pack "5efe" -tok200 = T.pack "200" -tokenizedBy :: Char -> T.Text -> [T.Text] -tokenizedBy c = T.groupBy ((==) `on` (== c)) - --- --- Validation of IPv6 address tokens --- - -dot :: T.Text -> Maybe IPv4AddrToken -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 - -ipv4Token :: T.Text -> Maybe IPv4AddrToken -ipv4Token t - | isJust(dot t) = Just Dot - | isJust(eightBitsToken t) = Just (EightBits t) - | otherwise = Nothing - -ipv4Addr :: T.Text -> Maybe IPv6AddrToken -ipv4Addr t = do - let r = map ipv4Token $ tokenizedBy '.' t - if (Nothing `notElem` r) && (length r == 7) - then Just (IPv4Addr t) else Nothing - -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 - -- 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 - -expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken] -expandTokens = - map expTok - where expTok AllZeros = SixteenBits tok4x0 - expTok (SixteenBits s) = do - let ls = T.length s - SixteenBits (if ls < 4 then T.replicate (4 - ls) tok0 `T.append` s else s) - expTok t = t +-- | Returns the 'Text' of an IPv6 address. +fromIPv6Addr :: IPv6Addr -> T.Text +fromIPv6Addr (IPv6Addr t) = t --- | Returns 'Just' one of the valid 'IPv6AddrToken', or 'Nothing'. -maybeIPv6AddrToken :: T.Text -> Maybe IPv6AddrToken -maybeIPv6AddrToken t - | isJust t' = t' - | isJust(colon t) = Just Colon - | isJust(doubleColon t) = Just DoubleColon - | isJust(ipv4Addr t) = Just (IPv4Addr t) - | otherwise = Nothing - where t' = sixteenBits t +-- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'Text'. +ipv6TokensToText :: [IPv6AddrToken] -> T.Text +ipv6TokensToText l = T.concat $ map ipv6TokenToText l -- | Returns the corresponding 'Text' of an IPv6 address token. ipv6TokenToText :: IPv6AddrToken -> T.Text -ipv6TokenToText (SixteenBits s) = s -ipv6TokenToText Colon = tokcolon -ipv6TokenToText DoubleColon = tokdcolon +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 -- ipv6TokenToText (IPv4Addr a) = a --- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'Text'. -ipv6TokensToText :: [IPv6AddrToken] -> T.Text -ipv6TokensToText l = T.concat $ map ipv6TokenToText l - -- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address. isIPv6Addr :: [IPv6AddrToken] -> Bool isIPv6Addr [] = False isIPv6Addr [DoubleColon] = True -isIPv6Addr [DoubleColon,SixteenBits tok1] = True +isIPv6Addr [DoubleColon,SixteenBit tok1] = True isIPv6Addr tks = diffNext tks && (do let cdctks = countDoubleColon tks @@ -157,61 +73,79 @@ firstValidToken tks && (case countIPv4Addr tks of 0 -> case lasttk of - SixteenBits _ -> lenconst - DoubleColon -> lenconst - AllZeros -> lenconst - otherwise -> False + SixteenBit _ -> lenconst + DoubleColon -> lenconst + AllZeros -> lenconst + _ -> False 1 -> case lasttk of - IPv4Addr _ -> - (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1) - otherwise -> False + IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1) + _ -> False otherwise -> False)) - where diffNext [_] = True - diffNext [a,a'] = a /= a' - diffNext (a:as) = (a /= head as) && diffNext as + where diffNext [] = False + diffNext [_] = True + diffNext (t:ts) = do + let h = head ts + case t of + SixteenBit _ -> case h of + SixteenBit _ -> False + AllZeros -> False + _ -> diffNext ts + AllZeros -> case h of + SixteenBit _ -> False + AllZeros -> False + _ -> diffNext ts + _ -> diffNext ts firstValidToken l = case head l of - SixteenBits _ -> True - DoubleColon -> True - AllZeros -> True - otherwise -> False + SixteenBit _ -> True + DoubleColon -> True + AllZeros -> True + _ -> False countDoubleColon l = length $ elemIndices DoubleColon l - -countIPv4Addr = - foldr oneMoreIPv4Addr 0 - where oneMoreIPv4Addr t c = case t of - IPv4Addr _ -> c + 1 - otherwise -> c + tok1 = T.pack "1" --- | Returns 'Just' a list of 'IPv6AddrToken', or 'Nothing'. -maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken] -maybeIPv6AddrTokens t = mapM maybeIPv6AddrToken $ tokenizedBy ':' t +countIPv4Addr = foldr oneMoreIPv4Addr 0 + where + oneMoreIPv4Addr t c = case t of + IPv4Addr _ -> c + 1 + otherwise -> c -- | 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 $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks - else Nothing - where ipv4AddrReplacement ltks' = - if ipv4AddrRewrite ltks' - then init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks') - else ltks' + case maybeIPv6AddrTokens t of + Just ltks -> if isIPv6Addr ltks + then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks + else Nothing + Nothing -> Nothing + where + ipv4AddrReplacement ltks = + if ipv4AddrRewrite ltks + then init ltks ++ ipv4AddrToIPv6AddrTokens (last ltks) + else ltks -- | Returns 'Just' the list of tokenized pure IPv6 address, always rewriting an -- embedded IPv4 address if present. maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken] -maybeTokPureIPv6Addr t = - do ltks <- maybeIPv6AddrTokens t - if isIPv6Addr ltks - then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks - else Nothing - where ipv4AddrReplacement ltks' = - init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks') +maybeTokPureIPv6Addr t = do + ltks <- maybeIPv6AddrTokens t + if isIPv6Addr ltks + then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks + else Nothing + where + ipv4AddrReplacement ltks' = init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks') +-- | Tokenize a 'Text' into 'Just' a list of 'IPv6AddrToken', or 'Nothing'. +maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken] +maybeIPv6AddrTokens s = + case readText s of + Done r l -> if r==T.empty then Just l else Nothing + Fail {} -> Nothing + where + readText s = feed (parse (many1 $ ipv4Addr <|> sixteenBit <|> doubleColon <|> colon) s) T.empty + -- | An embedded IPv4 address have to be rewritten to output a pure IPv6 Address -- text representation in hexadecimal digits. But some well-known prefixed IPv6 -- addresses have to keep visible in their text representation the fact that @@ -233,13 +167,16 @@ IPv4Addr _ -> do let itks = init tks not (itks == [DoubleColon] - || itks == [DoubleColon,SixteenBits tokffff,Colon] - || itks == [DoubleColon,SixteenBits tokffff,Colon,AllZeros,Colon] - || itks == [SixteenBits tok64,Colon,SixteenBits tokff9b,DoubleColon] - || [SixteenBits tok200,Colon,SixteenBits tok5efe,Colon] `isSuffixOf` itks - || [AllZeros,Colon,SixteenBits tok5efe,Colon] `isSuffixOf` itks - || [DoubleColon,SixteenBits tok5efe,Colon] `isSuffixOf` itks) - otherwise -> False + || itks == [DoubleColon,SixteenBit tokffff,Colon] + || itks == [DoubleColon,SixteenBit tokffff,Colon,AllZeros,Colon] + || itks == [SixteenBit (T.pack "64"),Colon,SixteenBit (T.pack "ff9b"),DoubleColon] + || [SixteenBit (T.pack "200"),Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks + || [AllZeros,Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks + || [DoubleColon,SixteenBit tok5efe,Colon] `isSuffixOf` itks) + _ -> False + where + tokffff = T.pack "ffff" + tok5efe = T.pack "5efe" -- | Rewrites 'Just' an embedded 'IPv4Addr' into the corresponding list of pure -- 'IPv6Addr' tokens. @@ -251,29 +188,36 @@ case t of IPv4Addr a -> do let m = toHex a - [fromJust $ sixteenBits ((!!) m 0 `T.append` addZero ((!!) m 1)) - ,Colon - ,fromJust $ sixteenBits ((!!) m 2 `T.append` addZero ((!!) m 3))] - _ -> [t] - where toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a - addZero d = if T.length d == 1 then tok0 `T.append` d else d + [ SixteenBit ((!!) m 0 `T.append` addZero ((!!) m 1)) + , Colon + , 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 + addZero d = if T.length d == 1 then tok0 `T.append` d else d +expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken] +expandTokens = map expandToken + where expandToken (SixteenBit s) = SixteenBit $ T.justifyRight 4 '0' s + expandToken AllZeros = SixteenBit $ T.pack "0000" + expandToken t = t + fromDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken] fromDoubleColon tks = - if DoubleColon `notElem` tks then tks - else do - let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks - let fsts = fst s - 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 - where quantityOfAllZerosTokenToReplace x = - ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x - where - ntks tks = if countIPv4Addr tks == 1 then 7 else 8 - allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros) + if DoubleColon `notElem` tks + then tks + else do let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks + let fsts = fst s + let snds = if not (null (snd s)) 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 + where + allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros) + quantityOfAllZerosTokenToReplace x = + ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x + where + ntks tks = if countIPv4Addr tks == 1 then 7 else 8 toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken] toDoubleColon tks = @@ -286,22 +230,20 @@ zerosToDoubleColon ls (_,1) = ls zerosToDoubleColon ls (i,l) = let ls' = filter (/= Colon) ls - in intersperse Colon (take i ls') ++ [DoubleColon] ++ intersperse Colon (drop (i+l) ls') + in intersperse Colon (Prelude.take i ls') ++ [DoubleColon] ++ intersperse Colon (drop (i+l) ls') zerosRunToReplace t = let l = longestLengthZerosRun t in (firstLongestZerosRunIndex t l,l) - where firstLongestZerosRunIndex x y = sum . snd . unzip $ takeWhile (/=(True,y)) x - longestLengthZerosRun x = - maximum $ map longest x - where longest t = case t of - (True,i) -> i - otherwise -> 0 - zerosRunsList x = - map helper $ groupZerosRuns x where - helper h = - (head h == AllZeros, lh) - where lh = length h + firstLongestZerosRunIndex x y = sum . snd . unzip $ Prelude.takeWhile (/=(True,y)) x + longestLengthZerosRun x = + maximum $ map longest x + where longest t = case t of + (True,i) -> i + _ -> 0 + zerosRunsList x = map helper $ groupZerosRuns x + where + helper h = (head h == AllZeros, lh) where lh = length h groupZerosRuns = group . filter (/= Colon) ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr @@ -310,4 +252,71 @@ networkInterfacesIPv6AddrList :: IO [(String,IPv6)] networkInterfacesIPv6AddrList = getNetworkInterfaces >>= \n -> return $ map networkInterfacesIPv6Addr n - where networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a) + where + networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a) + +fullSixteenBit :: T.Text -> Maybe IPv6AddrToken +fullSixteenBit t = + case parse fourHexaChars t of + Done a b -> if a==T.empty then Just $ SixteenBit $ T.pack b else Nothing + _ -> Nothing + +macAddr :: Parser (Maybe [IPv6AddrToken]) +macAddr = do + n1 <- count 2 hexaChar <*. T.pack ":" + n2 <- count 2 hexaChar <*. T.pack ":" + n3 <- count 2 hexaChar <*. T.pack ":" + n4 <- count 2 hexaChar <*. T.pack ":" + n5 <- count 2 hexaChar <*. T.pack ":" + n6 <- count 2 hexaChar + return $ maybeIPv6AddrTokens $ T.concat $ map T.pack [n1,n2,n3,n4,n5,n6] + +sixteenBit :: Parser IPv6AddrToken +sixteenBit = do + r <- fourHexaChars <|> 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' + then AllZeros + -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3) + else SixteenBit $ T.toLower r' + +ipv4Addr :: Parser IPv6AddrToken +ipv4Addr = do + n1 <- manyDigits <*. dot + if n1 /= T.empty + then do n2 <- manyDigits <*. dot + if n2 /= T.empty + then do n3 <- manyDigits <*. dot + if n3 /= T.empty + then do n4 <- manyDigits + if n4 /= T.empty + then return $ IPv4Addr $ T.intercalate dot [n1,n2,n3,n4] + else parserFailure + else parserFailure + else parserFailure + else parserFailure + where + parserFailure = fail "ipv4Addr parsing failure" + dot = T.pack "." + manyDigits = do + ds <- takeWhile1 isDigit + case R.decimal ds of + Right (n,_) -> return (if n < 256 then T.pack $ show n else T.empty) + Left _ -> return T.empty + +doubleColon :: Parser IPv6AddrToken +doubleColon = do + string $ T.pack "::" + return DoubleColon + +colon :: Parser IPv6AddrToken +colon = do + string $ T.pack ":" + return Colon + +fourHexaChars :: Parser String +fourHexaChars = 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 @@ -5,7 +5,6 @@ -- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com --- Stability : provisional -- -- Dealing with IPv6 address text representations, canonization and manipulations. -- @@ -13,91 +12,75 @@ -- ----------------------------------------------------------------------------- module Text.IPv6Addr.Manip - ( - module Text.IPv6Addr.Internal - , sixteenBitsArbToken + ( sixteenBitArbToken , partialRandAddr , macAddrToIPv6AddrTokens , getTokIPv6AddrOf , getTokMacAddrOf ) where +import Control.Applicative ((<$>)) import Control.Monad (replicateM) +import Data.Attoparsec.Text as A import Data.Char (intToDigit,isHexDigit) import Data.List (intersperse) -import Data.Maybe (catMaybes,fromJust) +import Data.Maybe (fromJust) import qualified Data.Text as T -import System.Random (randomRIO) - import Network.Info +import System.Random (randomRIO) import Text.IPv6Addr.Internal import Text.IPv6Addr.Types --- | Returns 'Just' an arbitrary 'SixteenBits' token based on a mask \"____\", each +-- | Returns 'Just' an arbitrary 'SixteenBit' token based on a mask \"____\", each -- underscore being replaced by a random hexadecimal digit. -- --- > sixteenBitsArbToken "_f__" == Just (SixteenBits "bfd4") +-- > sixteenBitArbToken "_f__" == Just (SixteenBit "bfd4") -- -sixteenBitsArbToken :: String -> IO (Maybe IPv6AddrToken) -sixteenBitsArbToken m = - mapM getHex m >>= \cs -> return $ sixteenBits $ T.pack cs - where getHex c = - case c of - '_' -> hexRand - otherwise -> return c - where hexRand = randomRIO(0,15) >>= \r -> return $ intToDigit r +sixteenBitArbToken :: String -> IO IPv6AddrToken +sixteenBitArbToken m = + mapM getHex m >>= \g -> return $ SixteenBit $ T.dropWhile (=='0') $ T.pack g + where + getHex c + | c == '_' = randomRIO(0,15) >>= \r -> return $ intToDigit r + | otherwise = return c --- | Generates a partial 'IPv6Addr' with n 'SixteenBits' +-- | Generates a partial 'IPv6Addr' with n 'SixteenBit' partialRandAddr :: Int -> IO [IPv6AddrToken] -partialRandAddr n = - if n < 9 then do l <- replicateM n $ sixteenBitsArbToken "____" - return $ intersperse Colon $ catMaybes l - else return [] +partialRandAddr n + | n > 0 && n < 9 = intersperse Colon <$> replicateM n (sixteenBitArbToken "____") + | otherwise = return [] -- | Given a MAC address, returns the corresponding 'IPv6AddrToken' list, or an empty list. -- --- > macAddrToIPv6AddrTokens "fa:1d:58:cc:95:16" == [SixteenBits "fa1d",Colon,SixteenBits "58cc",Colon,SixteenBits "9516"] +-- > macAddrToIPv6AddrTokens "fa:1d:58:cc:95:16" == [SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"] -- -macAddrToIPv6AddrTokens :: T.Text -> [IPv6AddrToken] -macAddrToIPv6AddrTokens mac = - if T.length mac == 17 - then do - let p = snd $ trans (T.split (==':') mac,[]) - if length p == 3 - then intersperse Colon $ map (fromJust . maybeIPv6AddrToken) p - else [] - else [] - where - trans ([],l) = ([],l) - trans (l1,l2) = do - let s = splitAt 2 l1 - trans (snd s,l2 ++ [T.concat $ fst s]) +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 + _ -> Nothing -- -- Functions based upon Network.Info to get local MAC and IPv6 addresses. -- - -networkInterfacesMacAddrList :: IO [(String,MAC)] -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, or 'Nothing'. +-- +-- > getTokIPv6AddrOf "eth0" == Just [SixteenBit "fe80",DoubleColon,SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"] +-- getTokIPv6AddrOf :: String -> IO (Maybe [IPv6AddrToken]) -getTokIPv6AddrOf s = do - l <- networkInterfacesIPv6AddrList - case lookup s l of - Just a -> return $ maybeTokIPv6Addr $ T.pack $ show a - Nothing -> return Nothing +getTokIPv6AddrOf s = maybe Nothing (maybeTokIPv6Addr. T.pack . show) <$> (lookup s <$> networkInterfacesIPv6AddrList) -- | 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 "eth0" == Just [SixteenBit "fa1d",Colon,SixteenBit "58cc",Colon,SixteenBit "9516"] +-- getTokMacAddrOf :: String -> IO (Maybe [IPv6AddrToken]) -getTokMacAddrOf s = do - l <- networkInterfacesMacAddrList - case lookup s l of - Just a -> return $ Just $ macAddrToIPv6AddrTokens $ T.pack $ show a - Nothing -> return Nothing +getTokMacAddrOf s = + maybe Nothing (macAddrToIPv6AddrTokens . T.pack . show) <$> (lookup s <$> networkInterfacesMacAddrList) + where + networkInterfacesMacAddrList = getNetworkInterfaces >>= \n -> return $ map networkInterfacesMac n + where networkInterfacesMac (NetworkInterface n _ _ m) = (n,m) diff --git a/Text/IPv6Addr/Types.hs b/Text/IPv6Addr/Types.hs --- a/Text/IPv6Addr/Types.hs +++ b/Text/IPv6Addr/Types.hs @@ -5,7 +5,6 @@ -- Copyright : (c) Michel Boucey 2011-2013 -- License : BSD-Style -- Maintainer : michel.boucey@gmail.com --- Stability : provisional -- -- Dealing with IPv6 address text representations, canonization and manipulations. -- @@ -16,12 +15,10 @@ import qualified Data.Text as T -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 + = SixteenBit T.Text -- ^ A four hexadecimal digits group representing a 16-Bit chunk | AllZeros -- ^ An all zeros 16-Bit chunk | Colon -- ^ A separator between 16-Bit chunks | DoubleColon -- ^ A double-colon stands for a unique compression of many consecutive 16-Bit chunks diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.Maybe +import Data.Text +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit + +import Text.IPv6Addr + +main = defaultMain $ hUnitTestToTests tests + +tests = TestList + [ (~?=) (maybeIPv6Addr ":") Nothing + , (~?=) (maybeIPv6Addr "::") (Just (IPv6Addr "::")) + , (~?=) (maybeIPv6Addr ":::") Nothing + , (~?=) (maybeIPv6Addr "::::") Nothing + , (~?=) (maybeIPv6Addr "::df0::") Nothing + , (~?=) (maybeIPv6Addr "0:0:0:0:0:0:0") Nothing + , (~?=) (maybeIPv6Addr "0:0:0:0:0:0:0:0") (Just (IPv6Addr "::")) + , (~?=) (maybeIPv6Addr "0:0:0:0:0:0:0:0:0") Nothing + , (~?=) (maybeIPv6Addr "1") Nothing + , (~?=) (maybeIPv6Addr "::1") (Just (IPv6Addr "::1")) + , (~?=) (maybeIPv6Addr "::1:") Nothing + , (~?=) (maybeIPv6Addr "0000:0000:0000:0000:0000:0000:0000:0001") (Just (IPv6Addr "::1")) + , (~?=) (maybeIPv6Addr "a") Nothing + , (~?=) (maybeIPv6Addr "ab") Nothing + , (~?=) (maybeIPv6Addr "abc") Nothing + , (~?=) (maybeIPv6Addr "abcd") Nothing + , (~?=) (maybeIPv6Addr "abcd:") Nothing + , (~?=) (maybeIPv6Addr "abcd::") (Just (IPv6Addr "abcd::")) + , (~?=) (maybeIPv6Addr "abcd:::") Nothing + , (~?=) (maybeIPv6Addr "abcde::") Nothing + , (~?=) (maybeIPv6Addr "a::") (Just (IPv6Addr "a::")) + , (~?=) (maybeIPv6Addr "0a::") (Just (IPv6Addr "a::")) + , (~?=) (maybeIPv6Addr "00a::") (Just (IPv6Addr "a::")) + , (~?=) (maybeIPv6Addr "000a::") (Just (IPv6Addr "a::")) + , (~?=) (maybeIPv6Addr "0000a::") Nothing + , (~?=) (maybeIPv6Addr "adb6") Nothing + , (~?=) (maybeIPv6Addr "adb6ce67") Nothing + , (~?=) (maybeIPv6Addr "adb6:ce67") Nothing + , (~?=) (maybeIPv6Addr "adb6::ce67") (Just (IPv6Addr "adb6::ce67")) + , (~?=) (maybeIPv6Addr "::1.2.3.4") (Just (IPv6Addr "::1.2.3.4")) + , (~?=) (maybeIPv6Addr "::ffff:1.2.3.4") (Just (IPv6Addr "::ffff:1.2.3.4")) + , (~?=) (maybeIPv6Addr "::ffff:0:1.2.3.4") (Just (IPv6Addr "::ffff:0:1.2.3.4")) + , (~?=) (maybeIPv6Addr "64:ff9b::1.2.3.4") (Just (IPv6Addr "64:ff9b::1.2.3.4")) + , (~?=) (maybeIPv6Addr "fe80::5efe:1.2.3.4") (Just (IPv6Addr "fe80::5efe:1.2.3.4")) + , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:1257:0000:211E:729C") (Just (IPv6Addr "fe80:cd00:0:cde:1257:0:211e:729c")) + , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:1257:0000:211E:729X") Nothing + , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:1257:0000:211E:729CX") Nothing + , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:0000:211E:729C") Nothing + , (~?=) (maybeIPv6Addr "FE80:CD00:0000:0CDE:FFFF:1257:0000:211E:729C") Nothing + , (~?=) (maybeIPv6Addr "1111:2222:3333:4444:5555:6666:7777:8888") (Just (IPv6Addr "1111:2222:3333:4444:5555:6666:7777:8888")) + , (~?=) (maybeIPv6Addr ":1111:2222:3333:4444:5555:6666:7777:8888") Nothing + , (~?=) (maybeIPv6Addr "1111:2222:3333:4444:5555:6666:7777:8888:") Nothing + , (~?=) (maybeIPv6Addr "1111::3333:4444:5555:6666::8888") Nothing + , (~?=) (maybeIPv6Addr "AAAA:BBBB:CCCC:DDDD:EEEE:FFFF:0000:0000") (Just (IPv6Addr "aaaa:bbbb:cccc:dddd:eeee:ffff::")) + , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:0001") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1")) + , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:001") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1")) + , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:01") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1")) + , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:eeee:1")) + , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd::1") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:0:1")) + , (~?=) (maybeIPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:0:1") (Just (IPv6Addr "2001:db8:aaaa:bbbb:cccc:dddd:0:1")) + , (~?=) (maybeIPv6Addr "2001:db8:0:0:1:0:0:1") (Just (IPv6Addr "2001:db8::1:0:0:1")) + , (~?=) (maybeIPv6Addr "2001:db8:0:1:0:0:0:1") (Just (IPv6Addr "2001:db8:0:1::1")) + , (~?=) (maybeIPv6Addr "2001:DB8:0:0:0::1") (Just (IPv6Addr "2001:db8::1")) + , (~?=) (maybeIPv6Addr "2001:0DB8:0:0::1") (Just (IPv6Addr "2001:db8::1")) + , (~?=) (maybeIPv6Addr "2001:0dB8:0::1") (Just (IPv6Addr "2001:db8::1")) + , (~?=) (maybeIPv6Addr "2001:db8::1") (Just (IPv6Addr "2001:db8::1")) + , (~?=) (maybeIPv6Addr "2001:db8:0:1::1") (Just (IPv6Addr "2001:db8:0:1::1")) + , (~?=) (maybeIPv6Addr "2001:0db8:0:1:0:0:0:1") (Just (IPv6Addr "2001:db8:0:1::1")) + , (~?=) (maybeIPv6Addr "2001:DB8::1:1:1:1:1") (Just (IPv6Addr "2001:db8:0:1:1:1:1:1")) + , (~?=) (maybeIPv6Addr "2001:DB8::1:1:0:1:1") (Just (IPv6Addr "2001:db8:0:1:1:0:1:1")) + , (~?=) (maybeIPv6Addr "fe80") Nothing + , (~?=) (maybeIPv6Addr "fe80::") (Just (IPv6Addr "fe80::")) + , (~?=) (maybeIPv6Addr "0:0:0:0:0:ffff:192.0.2.1") (Just (IPv6Addr "::ffff:192.0.2.1")) + , (~?=) (maybeIPv6Addr "::192.0.2.1") (Just (IPv6Addr "::192.0.2.1")) + , (~?=) (maybeIPv6Addr "192.0.2.1::") Nothing + , (~?=) (maybeIPv6Addr "::ffff:192.0.2.1") (Just (IPv6Addr "::ffff:192.0.2.1")) + , (~?=) (maybeIPv6Addr "fe80:0:0:0:0:0:0:0") (Just (IPv6Addr "fe80::")) + , (~?=) (maybeIPv6Addr "fe80:0000:0000:0000:0000:0000:0000:0000") (Just (IPv6Addr "fe80::")) + , (~?=) (maybeIPv6Addr "2001:db8:Bad:0:0::0:1") (Just (IPv6Addr "2001:db8:bad::1")) + , (~?=) (maybeIPv6Addr "2001:0:0:1:b:0:0:A") (Just (IPv6Addr "2001::1:b:0:0:a")) + , (~?=) (maybeIPv6Addr "2001:0:0:1:000B:0:0:0") (Just (IPv6Addr "2001:0:0:1:b::")) + , (~?=) (maybeIPv6Addr "2001:0DB8:85A3:0000:0000:8A2E:0370:7334") (Just (IPv6Addr "2001:db8:85a3::8a2e:370:7334")) + , (~?=) (maybePureIPv6Addr "0:0:0:0:0:ffff:192.0.2.1") (Just (IPv6Addr "::ffff:c000:201")) + , (~?=) (maybePureIPv6Addr "::ffff:192.0.2.1") (Just (IPv6Addr "::ffff:c000:201")) + , (~?=) (maybeFullIPv6Addr "::") (Just (IPv6Addr "0000:0000:0000:0000:0000:0000:0000:0000")) + , (~?=) (maybeFullIPv6Addr "0:0:0:0:0:0:0:0") (Just (IPv6Addr "0000:0000:0000:0000:0000:0000:0000:0000")) + , (~?=) (maybeFullIPv6Addr "::1") (Just (IPv6Addr "0000:0000:0000:0000:0000:0000:0000:0001")) + , (~?=) (maybeFullIPv6Addr "2001:db8::1") (Just (IPv6Addr "2001:0db8:0000:0000:0000:0000:0000:0001")) + , (~?=) (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." + ]