diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,13 +1,25 @@ -2010-11-20 Michel Boucey +2010-10-26 Michel Boucey + - Version 0.3.1 released. + - The command-line tool 'ip6addrcan' now rewrites the + embedded IPv4 adress in hexadecimal digits to output + pure IPv6 text representation. But some IPv6 adresses + with well-known prefixes (IPv4-compatible, IPv4-mapped, + IPv4-translated, IPv4-translatable, ISATAP) keeps + visible the embedded IPv4 dotted representation to keep + visible in the text representation the fact they deals + with IPv4 to IPv6 transition process. + +2010-10-20 Michel Boucey + - Version 0.3 released. - The command-line tool 'ip6addrval' is renamed (for the last time) 'ip6addrcan'. This tool now outputs rewrited valid IPv6 addresses canonized in conformation with RFC 5952, which updates RFC 4291. - - ip6addrgen is not updated yet from RFC 4291 to RFC 5952. - Outputted adresses from ip6addrgen have to be pipelined - through ip6addrcan. + - 'ip6addrgen' is not updated yet from RFC 4291 to RFC 5952. + Outputted adresses from 'ip6addrgen' have to be pipelined + through 'ip6addrcan'. 2010-08-09 Michel Boucey diff --git a/ip6addr.cabal b/ip6addr.cabal --- a/ip6addr.cabal +++ b/ip6addr.cabal @@ -1,5 +1,5 @@ Name: ip6addr -Version: 0.3 +Version: 0.3.1 Author: Michel Boucey Maintainer: Michel Boucey Homepage: http://www.cybervisible.fr/ip6addr diff --git a/src/IP6AddrCan.hs b/src/IP6AddrCan.hs --- a/src/IP6AddrCan.hs +++ b/src/IP6AddrCan.hs @@ -41,7 +41,7 @@ Nothing -> hPutStrLn stderr i >> evalInputsErr is where a = removeCidrSuffix i -version = "ip6addrcan version 0.3" +version = "ip6addrcan version 0.3.1" help = "Usage: ip6addrcan [-v|-h] | [-e] [address ...]\n" diff --git a/src/IP6AddrGen.hs b/src/IP6AddrGen.hs --- a/src/IP6AddrGen.hs +++ b/src/IP6AddrGen.hs @@ -105,7 +105,7 @@ ([Help],_,_) -> putStrLn (usageInfo help options) >> exit (_,_,_) -> putStrLn (usageInfo help options) >> exit -version = "ip6addrgen version 0.2" +version = "ip6addrgen version 0.3.1" help = "Usage: ip6addrgen [-v|-h] | [-n] [-p]\n" diff --git a/src/IPv6Addr.hs b/src/IPv6Addr.hs --- a/src/IPv6Addr.hs +++ b/src/IPv6Addr.hs @@ -1,17 +1,23 @@ -module IPv6Addr (maybeIPv6Addr) where +module IPv6Addr where -import Data.Char (isDigit,isHexDigit,toLower) +import Data.Char (intToDigit,isDigit,isHexDigit,toLower) import Data.List (group,groupBy,intercalate,intersperse,elemIndex) import Data.Function (on) import Data.Maybe +import Numeric +type IPv6Addr = String + +data IPv4AddrToken = Dot | EightBits String deriving (Eq) + +data IPv6AddrToken = SixteenBits String | AllZeros | Colon | DoubleColon + | IPv4Addr String deriving (Eq) + tokenizedBy :: String -> Char -> [String] tokenizedBy s c = groupBy ((==) `on` ( == c)) s -- Parsing embedded IPv4 address -data IPv4AddrToken = Dot | EightBits String deriving (Eq,Show) - dot :: String -> Maybe IPv4AddrToken dot s = if s == "." then Just Dot else Nothing @@ -33,15 +39,10 @@ do let r = map ipv4Token (s `tokenizedBy` '.') if (Nothing `notElem` r) && (length r == 7) - then Just (IPv4Addr s) else Nothing + then Just (IPv4Addr s) else Nothing -- Parsing IPv6 Address -type IPv6Addr = String - -data IPv6AddrToken = SixteenBits String | AllZeros | Colon | DoubleColon - | IPv4Addr String deriving (Eq,Show) - colon :: String -> Maybe IPv6AddrToken colon s = if s == ":" then Just Colon else Nothing @@ -57,7 +58,7 @@ if length s' < 5 && all isHexDigit s' then case s' of "" -> Just AllZeros - -- Hexadecimal digits MUST be in lowercase (RFC 4.3) + -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3) otherwise -> Just (SixteenBits (map toLower s')) else Nothing else Nothing @@ -71,31 +72,34 @@ | otherwise = Nothing where s' = sixteenBits s -ipv6TokenToString :: IPv6AddrToken -> String -ipv6TokenToString (SixteenBits t) = t -ipv6TokenToString Colon = ":" -ipv6TokenToString DoubleColon = "::" +ipv6AddrTokenToString :: IPv6AddrToken -> String +ipv6AddrTokenToString (SixteenBits t) = t +ipv6AddrTokenToString Colon = ":" +ipv6AddrTokenToString DoubleColon = "::" -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1) -ipv6TokenToString AllZeros = "0" -ipv6TokenToString (IPv4Addr i) = i +ipv6AddrTokenToString AllZeros = "0" +ipv6AddrTokenToString (IPv4Addr i) = i +ipv6AddrToString :: [Maybe IPv6AddrToken] -> IPv6Addr +ipv6AddrToString t = concatMap ipv6AddrTokenToString (catMaybes t) + countIPv4Addr :: [Maybe IPv6AddrToken] -> Int countIPv4Addr ts = foldr oneMoreIPv4Token 0 ts where - oneMoreIPv4Token t c = - case t of - Just (IPv4Addr _) -> c + 1 - otherwise -> c + oneMoreIPv4Token t c = + case t of + Just (IPv4Addr _) -> c + 1 + otherwise -> c countDoubleColon :: [Maybe IPv6AddrToken] -> Int countDoubleColon ts = foldr oneMoreDoubleColon 0 ts where - oneMoreDoubleColon t c = - case t of - Just DoubleColon -> c + 1 - otherwise -> c + oneMoreDoubleColon t c = + case t of + Just DoubleColon -> c + 1 + otherwise -> c firstValidToken :: [Maybe IPv6AddrToken] -> Bool firstValidToken ts = @@ -129,16 +133,50 @@ maybeIPv6Addr :: String -> Maybe IPv6Addr maybeIPv6Addr "::" = Just "::" +maybeIPv6Addr "::1" = Just "::1" maybeIPv6Addr s = do - let s' = map ipv6AddrToken (s `tokenizedBy` ':') - if ipv6AddrConstraints s' + let ts = map ipv6AddrToken (s `tokenizedBy` ':') + if ipv6AddrConstraints ts then - (if Just DoubleColon `notElem` s' then - Just (replaceTheLongestZerosRun s') else - Just (replaceTheLongestZerosRun (expendDoubleColon s'))) + (if Just DoubleColon `notElem` ts + then Just $ ipv6AddrToString (ipv4AddrToHex $ replaceTheLongestZerosRun ts) + else Just $ ipv6AddrToString (ipv4AddrToHex $ replaceTheLongestZerosRun (expendDoubleColon ts))) else Nothing - + +-- The 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 they +-- deals with IPv4 to IPv6 transition process (RFC 5952 Section 5) : +-- +-- IPv4-compatible IPv6 address like "::1.2.3.4" +-- IPv4-mapped IPv6 address like "::ffff:1.2.3.4" +-- IPv4-translated address like "::ffff:0:1.2.3.4" +-- IPv4-translatable address like "64:ff9b::1.2.3.4" +-- ISATAP address like "fe80::5efe:1.2.3.4" +ipv4AddrToHex :: [Maybe IPv6AddrToken] -> [Maybe IPv6AddrToken] +ipv4AddrToHex [Just DoubleColon,Just (IPv4Addr a)] = + [Just DoubleColon,Just Colon,Just (IPv4Addr a)] +ipv4AddrToHex [Just DoubleColon,Just (SixteenBits "ffff"),Just Colon,Just (IPv4Addr a)] = + [Just DoubleColon,Just (SixteenBits "ffff"),Just Colon,Just (IPv4Addr a)] +ipv4AddrToHex [Just DoubleColon,Just (SixteenBits "ffff"),Just Colon,Just AllZeros,Just Colon,Just (IPv4Addr a)] = + [Just DoubleColon,Just (SixteenBits "ffff"),Just Colon,Just AllZeros,Just Colon,Just (IPv4Addr a)] +ipv4AddrToHex [Just (SixteenBits "64"),Just Colon,Just (SixteenBits "ff9b"),Just DoubleColon,Just (IPv4Addr a)] = + [Just (SixteenBits "64"),Just Colon,Just (SixteenBits "ff9b"),Just DoubleColon,Just (IPv4Addr a)] +ipv4AddrToHex [Just (SixteenBits "fe80"),Just DoubleColon,Just (SixteenBits "5efe"),Just Colon,Just (IPv4Addr a)] = + [Just (SixteenBits "fe80"),Just DoubleColon,Just (SixteenBits "5efe"),Just Colon,Just (IPv4Addr a)] +ipv4AddrToHex ts = + do + let t = last ts + case t of + Just (IPv4Addr a) -> do + let m = map (\x -> showIntAtBase 16 intToDigit (read x::Int) "") + $ filter (/= ".") (a `tokenizedBy` '.') + init ts ++ [Just (SixteenBits ((!!) m 0 ++ addZero((!!) m 1))),Just Colon,Just (SixteenBits ((!!) m 2 ++ addZero((!!) m 3)))] + where + addZero s = if length s < 2 then '0':s else s + otherwise -> ts + expendDoubleColon :: [Maybe IPv6AddrToken] -> [Maybe IPv6AddrToken] expendDoubleColon mit = do let s = splitAt (fromJust $ elemIndex (Just DoubleColon) mit) mit @@ -147,53 +185,55 @@ let fste = if null fsts then [] else fsts ++ [Just Colon] let snde = if null snds then [] else Just Colon : snds fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace mit) ++ snde - -quantityOfAllZerosTokenToReplace x = - 8 - foldl (\c x -> if (x /= Just DoubleColon) && (x /= Just Colon) - then c+1 else c) 0 x - -allZerosTokensReplacement x = intersperse (Just Colon) (replicate x (Just AllZeros)) + where + quantityOfAllZerosTokenToReplace x = + 8 - foldl (\c x -> if (x /= Just DoubleColon) && (x /= Just Colon) + then c+1 else c) 0 x + allZerosTokensReplacement x = + intersperse (Just Colon) (replicate x (Just AllZeros)) -- "the longest run of consecutive 16-bit 0 fields MUST be shortened" (RFC 5952, 4.2.3) -- All the stuff to deal with replacement of the longest zeros run by a double colon -longestLengthZerosRun x = maximum $ map longest x - where - longest t = - case t of - (True,i) -> i - otherwise -> 0 +longestLengthZerosRun :: (Num a, Ord a) => [(Bool, a)] -> a +longestLengthZerosRun x = + maximum $ map longest x + where + longest t = + case t of + (True,i) -> i + otherwise -> 0 +replaceTheLongestZerosRun :: [Maybe IPv6AddrToken] -> [Maybe IPv6AddrToken] +replaceTheLongestZerosRun s' = + zerosToDoubleColon s' (zerosRunToReplace $ zerosRunsList s') + where + zerosRunToReplace t = + let l = longestLengthZerosRun t + in (firstLongestZerosRunIndex t l,l) + firstLongestZerosRunIndex :: (Num b) => [(Bool, b)] -> b -> b -firstLongestZerosRunIndex x y = sum $ snd $ unzip $ takeWhile (/=(True,y)) x +firstLongestZerosRunIndex x y = + sum . snd . unzip $ takeWhile (/=(True,y)) x zerosRunsList :: [Maybe IPv6AddrToken] -> [(Bool, Int)] -zerosRunsList x = map helper $ groupZerosRuns x - where - helper h = - if head h == "0" - then (True,lh) - else (False,lh) - where lh = length h - -groupZerosRuns :: [Maybe IPv6AddrToken] -> [[String]] -groupZerosRuns lts = group $ filter (/=":") $ map ipv6TokenToString $ catMaybes lts - -onlyStringTokens :: [Maybe IPv6AddrToken] -> [String] -onlyStringTokens x = filter (/=":") $ map ipv6TokenToString $ catMaybes x - -replaceTheLongestZerosRun :: [Maybe IPv6AddrToken] -> IPv6Addr -replaceTheLongestZerosRun s' = zerosToDoubleColon (onlyStringTokens s') (zerosRunToReplace $ zerosRunsList s') - -zerosRunToReplace :: [(Bool, Int)] -> (Int, Int) -zerosRunToReplace t = - let l = longestLengthZerosRun t - in (firstLongestZerosRunIndex t l,l) +zerosRunsList x = + map helper $ groupZerosRuns x + where + helper h = + if head h == Just AllZeros + then (True,lh) else (False,lh) + where lh = length h + groupZerosRuns = + group . filter (/= Just Colon) -zerosToDoubleColon :: [String] -> (Int,Int) -> IPv6Addr +zerosToDoubleColon :: [Maybe IPv6AddrToken] -> (Int,Int) -> [Maybe IPv6AddrToken] -- No all zeros token, so no double colon replacement... -zerosToDoubleColon ls (_,0) = intercalate ":" ls --- "The symbol '::' MUST NOT be used to shorten just one 16-bit 0 field" (RFC 4.2.2) -zerosToDoubleColon ls (_,1) = intercalate ":" ls +zerosToDoubleColon ls (_,0) = ls +-- "The symbol '::' MUST NOT be used to shorten just one 16-bit 0 field" (RFC 5952 4.2.2) +zerosToDoubleColon ls (_,1) = ls zerosToDoubleColon ls (i,l) = - concat $ intersperse ":" (take i ls) ++ ["::"] ++ intersperse ":" (drop (i+l) ls) + let ls' = filter (/= Just Colon) ls + in intersperse (Just Colon) (take i ls') + ++ [Just DoubleColon] + ++ intersperse (Just Colon) (drop (i+l) ls')