diff --git a/ChangeLog b/ChangeLog deleted file mode 100644 --- a/ChangeLog +++ /dev/null @@ -1,56 +0,0 @@ -2011-01-13 Michel Boucey - - Version 0.3.3 released. - - ip6addrgen now deals with leading zeros in 16bits - token. - -2010-10-28 Michel Boucey - - - Version 0.3.2 released. - - Fixed a mis pattern matching in version 0.3.1. - - Better pattern matching ISATAP adresses to keep - their IPv4 dotted representation in IPv6 addresses. - -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'. - -2010-08-09 Michel Boucey - - - Version 0.2 released. - - The command-line tool 'ip6addr' is renamed 'ip6addrval'. - This tool now validates CIDR suffix if exists and - outputs IPv6 adresses with CIDR prefixes cutted off. - - The command-line tool 'ip6addrgen' is added. - This tool generates random IPv6 adresses. - Two options : -n to provide a count of IPv6 adresses - to output, -p to provide an uncompressed prefix to apply - to each outputted address. - -2009-09-11 Michel Boucey - - - Version 0.1.1 released. - - Fixed three bugs in IPv6 address validation. - - Added a test written in Perl. - -2009-06-26 Michel Boucey - - - Version 0.1 released. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,13 +1,30 @@ -ip6addr provides command-line tools (written in Haskell) to deal with text representation of IPv6 Addresses: - -- ip6addrcan parses and canonizes IPv6 addresses against RFC 4291 and RFC 5952. - -- ip6addrgen generates random IPv6 addresses. - -Copyright (c) 2009-2011, Michel Boucey 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. The name of the author may not 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 HOLDER 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. +Copyright (c) 2015, Michel Boucey + +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 Michel Boucey nor the names of other + 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. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,59 @@ +-- ----------------------------------------------------------------------------- +-- +-- Copyright : (c) Michel Boucey 2015 +-- License : BSD-Style +-- Maintainer : michel.boucey@gmail.com +-- +-- commandline tool to generate IPv6 address text representations +-- +-- ----------------------------------------------------------------------------- + +{-# LANGUAGE DeriveDataTypeable,OverloadedStrings #-} + +import Control.Applicative ((<$>)) +import Control.Monad (replicateM_) +import Data.Text as T (append,pack) +import Data.Text.IO as TIO (putStrLn,hPutStrLn) +import System.Console.CmdArgs +import System.Exit +import System.IO (stderr) +import Text.IPv6Addr + +data Input =Input + { output :: String + , address :: String + , quantity :: Int + } deriving (Show,Data,Typeable) + +ip6addrInput :: Input +ip6addrInput = Input + { address = "" &= typ " " + , output = "canonical" &= typ " [pure|canonical|full|arpa|random]" &= help "(default=canonical)" + , quantity = 1 &= help "Amount of random addresses to generate" &= typ " " + } &= summary "ip6addr version 0.4 (C) Michel Boucey 2015" + &= program "ip6addr" + &= helpArg [name "h"] + &= details ["Examples:"," ip6addr -a 0:0::FFFF:192.0.2.128"," ip6addr -o full -a ::1"," ip6addr -o random -q 10",""] + +main :: IO () +main = do + a <- cmdArgs ip6addrInput + if output a == "random" + then replicateM_ (quantity a) putRandAddr >> exitSuccess + else do let m = address a + case output a of + "canonical" -> out maybeIPv6Addr m fromIPv6Addr + "full" -> out maybeFullIPv6Addr m fromIPv6Addr + "arpa" -> out maybePureIPv6Addr m toIP6ARPA + "pure" -> out maybePureIPv6Addr m fromIPv6Addr + _ -> hPutStrLn stderr "See help" + >> exitFailure + where + putRandAddr = fromIPv6Addr <$> randIPv6Addr >>= TIO.putStrLn + out t i o = + if i /= "" + then do let p = T.pack i + case t p of + Nothing -> hPutStrLn stderr ("'" `T.append` p `T.append` "' is not an IPv6 address") >> exitFailure + Just a -> TIO.putStrLn (o a) >> exitSuccess + else Prelude.putStrLn "See help" >> exitFailure diff --git a/ip6addr.cabal b/ip6addr.cabal --- a/ip6addr.cabal +++ b/ip6addr.cabal @@ -1,29 +1,24 @@ -Name: ip6addr -Version: 0.3.3 -Author: Michel Boucey -Maintainer: Michel Boucey -Homepage: http://www.cybervisible.fr/ip6addr -Category: Network,Console -Synopsis: Command-line tools to deal with IPv6 Addresses text representation -Description: ip6addr consists of two command-line tools: ip6addrcan which filters IPv6 addresses parsed against RFC 4291 and canonized them in conformation with RFC 5952. By default, ip6addrcan outputs only validated inputs, i.e. IPv6 addresses, removing CIDR suffix if necessary. Already compressed IPv6 adresses are recomputed. -e option throws out discarded inputs to stderr (which have of course to be redirected). The second command-line tool, ip6addrgen, generates random IPv6 adresses. -p option allows to provide a prefix to all IPv6 adresses to generate. -n option allows to provide the amount of IPv6 addresses to generate. Outputted IPv6 addresses have no more to be pipelined through ip6addrcan to be canonized. -License: BSD3 -License-File: LICENSE -Build-Type: Simple -Cabal-Version: >= 1.2 - -extra-source-files:src/IPv6Addr.hs, - src/CidrSuffix.hs, - ChangeLog +name: ip6addr +version: 0.4.0.0 +synopsis: commandline tool to generate IPv6 address text representations +description: commandline tool to generate IPv6 address text representations +license: BSD3 +license-file: LICENSE +author: Michel Boucey +maintainer: michel.boucey@gmail.com +homepage: https://github.com/MichelBoucey/ip6addr +Copyright: Copyright © 2011-2015 - Michel Boucey +Category: Network,Console +build-type: Simple +cabal-version: >=1.10 -Executable ip6addrcan - Hs-Source-Dirs: src - GHC-Options: -O2 - Main-Is: IP6AddrCan.hs - Build-Depends: base >= 4 && <= 5 +Source-Repository head + Type: git + Location: https://github.com/MichelBoucey/ip6addr.git -Executable ip6addrgen - Hs-Source-Dirs: src - GHC-Options: -O2 - Main-Is: IP6AddrGen.hs - Build-Depends: base >= 4 && <= 5, - random +executable ip6addr + GHC-Options: -O2 -Wall + main-is: Main.hs + other-extensions: DeriveDataTypeable, OverloadedStrings + build-depends: base >=4.7 && <4.8, cmdargs,IPv6Addr >= 0.5, text >= 1.2 + default-language: Haskell2010 diff --git a/src/CidrSuffix.hs b/src/CidrSuffix.hs deleted file mode 100644 --- a/src/CidrSuffix.hs +++ /dev/null @@ -1,23 +0,0 @@ -module CidrSuffix (removeCidrSuffix) where - -import Data.Char (isDigit) -import Data.List (groupBy) -import Data.Function (on) - -isCidrSuffix :: String -> Bool -isCidrSuffix s = - (all isDigit s && ((length s > 1 && head s /= '0')||(length s == 1))) - && (t >= 0 && t <= 128) - where t = read s::Int - -removeCidrSuffix :: String -> String -removeCidrSuffix [] = [] -removeCidrSuffix s - | l == 1 = s - | l == 3 = - if g !! 1 == "/" && isCidrSuffix (last g) - then head g else [] - | otherwise = [] - where - g = groupBy ((==) `on` (=='/')) s - l = length g diff --git a/src/IP6AddrCan.hs b/src/IP6AddrCan.hs deleted file mode 100644 --- a/src/IP6AddrCan.hs +++ /dev/null @@ -1,51 +0,0 @@ -import System.IO -import System.Exit -import System.Environment -import System.Console.GetOpt - --- local import -import IPv6Addr -import CidrSuffix - -data Flag = Help | Version | Stderr deriving (Show,Eq) - -options :: [OptDescr Flag] -options = - [Option "v" [] (NoArg Version) "Show version number" - ,Option "e" [] (NoArg Stderr) "Throw out discarded inputs to stderr" - ,Option "h" [] (NoArg Help) "Show usage"] - -parseArgs args = case getOpt RequireOrder options args of - ([],[],[]) -> evalInputs . lines =<< getContents - ([Version],[],[]) -> putStrLn version >> exit - ([Help],[],[]) -> putStrLn (usageInfo help options) >> exit - ([Stderr],[],[]) -> evalInputsErr . lines =<< getContents - ([Stderr],inputs,[]) -> evalInputsErr inputs - ([],inputs,[]) -> evalInputs inputs - (_,_,errs) -> hPutStr stderr (concat errs ++ usageInfo help options) - >> exitWith (ExitFailure 1) - -evalInputs :: [String] -> IO () -evalInputs [] = exit -evalInputs (i:is) = - case maybeIPv6Addr a of - Just b -> putStrLn b >> evalInputs is - Nothing -> evalInputs is - where a = removeCidrSuffix i - -evalInputsErr :: [String] -> IO () -evalInputsErr [] = exit -evalInputsErr (i:is) = - case maybeIPv6Addr a of - Just b -> putStrLn b >> evalInputsErr is - Nothing -> hPutStrLn stderr i >> evalInputsErr is - where a = removeCidrSuffix i - -version = "ip6addrcan version 0.3.3" - -help = "Usage: ip6addrcan [-v|-h] | [-e] [address ...]\n" - -exit = exitWith ExitSuccess - -main :: IO () -main = getArgs >>= parseArgs diff --git a/src/IP6AddrGen.hs b/src/IP6AddrGen.hs deleted file mode 100644 --- a/src/IP6AddrGen.hs +++ /dev/null @@ -1,115 +0,0 @@ -import System.IO -import System.Exit -import Control.Monad (replicateM,replicateM_) -import System.Environment -import System.Console.GetOpt -import Data.List (groupBy,intercalate) -import System.Random (randomRIO) -import Data.Char (isDigit,intToDigit,toLower,isHexDigit) -import Data.Function (on) - --- IPv6 address prefix validation and random rewrite of trailing zero(s) - -tokenizeIPv6Input :: String -> [String] -tokenizeIPv6Input = groupBy ((==) `on` (==':')) - -is16bitsToken :: String -> Bool -is16bitsToken s = l < 5 && l > 0 && all isHexDigit s where l = length s - -ipv6PrefixToken :: String -> Char -ipv6PrefixToken s - | s == ":" = 'c' - | is16bitsToken s = '6' - | otherwise = '?' - -inputIPv6PrefixToInternalRep :: [String] -> String -inputIPv6PrefixToInternalRep = map ipv6PrefixToken - -readLast16bitsTokenOfPrefix :: (Monad m) => String -> m (String,Int) -readLast16bitsTokenOfPrefix s = - let p = span (== '0') $ reverse s in return (reverse(snd p),length (fst p)) - -prefixRewrite :: String -> IO () -prefixRewrite s = - do - t <- readLast16bitsTokenOfPrefix s - putStr $ dropWhile (=='0') $ map toLower $fst t - g <- genNhex $ snd t - putStr g - --- IPv6 Address random generation - -genRandomHex :: IO Char -genRandomHex = - do - r <- randomRIO(0,15)::IO Int - return (toLower $ intToDigit r) - -genNhex :: Int -> IO String -genNhex n = replicateM n genRandomHex - -n16bitsToken :: Int -> IO () -n16bitsToken n = replicateM n (fmap (dropWhile (=='0')) $ genNhex 4) >>= putStr . intercalate ":" - -count16bitsToken :: String -> Int -count16bitsToken = foldl (\x y -> if y == '6' then x+1 else x) 0 - -mkRandomIPv6Addr :: IO () -mkRandomIPv6Addr = n16bitsToken 8 >> putStr "\n" - -mkRandomIPv6AddrWithPrefix :: String -> String -> IO () -mkRandomIPv6AddrWithPrefix s p = - do - let c = count16bitsToken p - if c < 9 then - do - prefixRewrite s - if c == 8 then putStr "" else putStr ":" - n16bitsToken (8 - c) - putStr "\n" - else putStr "Prefix too long\n" >> exit - -ipv6AddrGen :: Int -> String -> IO () -ipv6AddrGen n [] = replicateM_ n mkRandomIPv6Addr -ipv6AddrGen n s = - let p = inputIPv6PrefixToInternalRep $ tokenizeIPv6Input s in - if ('?' `notElem` p) && (head p /= 'c') && (last p /= 'c') - then replicateM_ n (mkRandomIPv6AddrWithPrefix s p) - else putStr "Bad input for -p option\n" - --- GetOpt stuff - -data Flag = Help | Version | Count String | Prefix String deriving (Show) - -options :: [OptDescr Flag] -options = - [Option "n" [] (ReqArg Count "count") "Number of IPv6 adresses to output" - ,Option "p" [] (ReqArg Prefix "prefix") "An uncompressed IPv6 prefix" - ,Option "v" [] (NoArg Version) "Show version number" - ,Option "h" [] (NoArg Help) "Show usage"] - -safeReadN :: String -> String -> IO () -safeReadN n p = - if all isDigit n - then ipv6AddrGen (read n :: Int) p >> exit - else putStrLn "Bad input for -n option" >> exit - -parseArgs :: [String] -> IO () -parseArgs args = - case getOpt RequireOrder options args of - ([Count n],_,_) -> safeReadN n "" - ([Prefix p],_,_) -> ipv6AddrGen 1 p >> exit - ([Count n,Prefix p],_,_) -> safeReadN n p - ([Prefix p,Count n],_,_) -> safeReadN n p - ([Version],_,_) -> putStrLn version >> exit - ([Help],_,_) -> putStrLn (usageInfo help options) >> exit - (_,_,_) -> putStrLn (usageInfo help options) >> exit - -version = "ip6addrgen version 0.3.3" - -help = "Usage: ip6addrgen [-v|-h] | [-n] [-p]\n" - -exit = exitWith ExitSuccess - -main :: IO () -main = getArgs >>= parseArgs diff --git a/src/IPv6Addr.hs b/src/IPv6Addr.hs deleted file mode 100644 --- a/src/IPv6Addr.hs +++ /dev/null @@ -1,242 +0,0 @@ -module IPv6Addr where - -import Data.Char (intToDigit,isDigit,isHexDigit,toLower) -import Data.List (group,groupBy,intercalate,intersperse,elemIndex,isSuffixOf) -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 - -dot :: String -> Maybe IPv4AddrToken -dot s = if s == "." then Just Dot else Nothing - -eightBitsToken :: String -> Maybe IPv4AddrToken -eightBitsToken s = - let t = read s::Int - in - if not(null s) && all isDigit s && t >= 0 && t <= 255 - then Just (EightBits s) else Nothing - -ipv4Token :: String -> Maybe IPv4AddrToken -ipv4Token s - | isJust(dot s) = Just Dot - | isJust(eightBitsToken s) = Just (EightBits s) - | otherwise = Nothing - -ipv4Addr :: String -> Maybe IPv6AddrToken -ipv4Addr s = - do - let r = map ipv4Token (s `tokenizedBy` '.') - if (Nothing `notElem` r) && (length r == 7) - then Just (IPv4Addr s) else Nothing - --- Parsing IPv6 Address - -colon :: String -> Maybe IPv6AddrToken -colon s = if s == ":" then Just Colon else Nothing - -doubleColon :: String -> Maybe IPv6AddrToken -doubleColon s = if s == "::" then Just DoubleColon else Nothing - -sixteenBits:: String -> Maybe IPv6AddrToken -sixteenBits s = - if length s < 5 then - do - -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1) - let s'= dropWhile (=='0') s - if length s' < 5 && all isHexDigit s' - then case s' of - "" -> Just AllZeros - -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3) - otherwise -> Just (SixteenBits (map toLower s')) - else Nothing - else Nothing - -ipv6AddrToken :: String -> Maybe IPv6AddrToken -ipv6AddrToken s - | isJust s' = s' - | isJust(colon s) = Just Colon - | isJust(doubleColon s) = Just DoubleColon - | isJust(ipv4Addr s) = Just (IPv4Addr s) - | otherwise = Nothing - where s' = sixteenBits s - -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) -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 - -countDoubleColon :: [Maybe IPv6AddrToken] -> Int -countDoubleColon ts = - foldr oneMoreDoubleColon 0 ts - where - oneMoreDoubleColon t c = - case t of - Just DoubleColon -> c + 1 - otherwise -> c - -firstValidToken :: [Maybe IPv6AddrToken] -> Bool -firstValidToken ts = - case head ts of - Just (SixteenBits _) -> True - Just DoubleColon -> True - Just AllZeros -> True - otherwise -> False - -ipv6AddrConstraints :: [Maybe IPv6AddrToken] -> Bool -ipv6AddrConstraints [] = False -ipv6AddrConstraints [Just DoubleColon] = True -ipv6AddrConstraints [Just DoubleColon,Just (SixteenBits "1")] = True -ipv6AddrConstraints ts = - do - let cdcts = countDoubleColon ts - let lents = length ts - let lastt = last ts - let lenconst = ( (lents == 15 && cdcts <= 0) || (lents < 15 && cdcts == 1) ) - ((firstValidToken ts && all isJust ts) && - (case countIPv4Addr ts of - 0 -> case lastt of - Just (SixteenBits _) -> lenconst - Just DoubleColon -> lenconst - Just AllZeros -> lenconst - otherwise -> False - 1 -> case lastt of - Just (IPv4Addr _) -> (lents == 13 && cdcts <= 0) || (lents < 13 && cdcts == 1) - otherwise -> False - otherwise -> False)) - -maybeIPv6Addr :: String -> Maybe IPv6Addr -maybeIPv6Addr "::" = Just "::" -maybeIPv6Addr "::1" = Just "::1" -maybeIPv6Addr s = - do - let ts = map ipv6AddrToken (s `tokenizedBy` ':') - if ipv6AddrConstraints ts - then - (if Just DoubleColon `notElem` ts - then Just $ ipv6AddrToString (ipv4AddrToHex $ replaceTheLongestZerosRun ts) - else Just $ ipv6AddrToString (ipv4AddrToHex $ replaceTheLongestZerosRun (expandDoubleColon 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 (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 ts = - case last ts of - Just (IPv4Addr a) -> - do - let its = init ts - if [Just (SixteenBits "200"),Just Colon,Just (SixteenBits "5efe"),Just Colon] `isSuffixOf` its - || [Just AllZeros,Just Colon,Just (SixteenBits "5efe"),Just Colon] `isSuffixOf` its - || [Just DoubleColon,Just (SixteenBits "5efe"),Just Colon] `isSuffixOf` its - then ts - else do - let m = map (\x -> showIntAtBase 16 intToDigit (read x::Int) "") - $ filter (/= ".") (a `tokenizedBy` '.') - its ++ [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 - -expandDoubleColon :: [Maybe IPv6AddrToken] -> [Maybe IPv6AddrToken] -expandDoubleColon mit = do - let s = splitAt (fromJust $ elemIndex (Just DoubleColon) mit) mit - let fsts = fst s - let snds = if length(snd s) >= 1 then tail(snd s) else [] - 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 - 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 :: (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 - -zerosRunsList :: [Maybe IPv6AddrToken] -> [(Bool, Int)] -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 :: [Maybe IPv6AddrToken] -> (Int,Int) -> [Maybe IPv6AddrToken] --- No all zeros token, so no double colon replacement... -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) = - let ls' = filter (/= Just Colon) ls - in intersperse (Just Colon) (take i ls') - ++ [Just DoubleColon] - ++ intersperse (Just Colon) (drop (i+l) ls')