summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--config-joey.hs4
-rw-r--r--debian/changelog5
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Info.hs3
-rw-r--r--src/Propellor/PrivData.hs2
-rw-r--r--src/Propellor/Property/Aiccu.hs50
-rw-r--r--src/Propellor/Property/Dns.hs89
-rw-r--r--src/Propellor/Property/File.hs10
-rw-r--r--src/Propellor/Property/Unbound.hs141
-rw-r--r--src/Propellor/Types/Dns.hs28
10 files changed, 239 insertions, 94 deletions
diff --git a/config-joey.hs b/config-joey.hs
index da755aad..65cf0d46 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -26,6 +26,7 @@ import qualified Propellor.Property.Gpg as Gpg
import qualified Propellor.Property.Systemd as Systemd
import qualified Propellor.Property.Journald as Journald
import qualified Propellor.Property.Chroot as Chroot
+import qualified Propellor.Property.Aiccu as Aiccu
import qualified Propellor.Property.OS as OS
import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost
import qualified Propellor.Property.HostingProvider.Linode as Linode
@@ -73,7 +74,8 @@ testvm = host "testvm.kitenet.net"
darkstar :: Host
darkstar = host "darkstar.kitenet.net"
- & ipv6 "2001:4830:1600:187::2" -- sixxs tunnel
+ & ipv6 "2001:4830:1600:187::2"
+ & Aiccu.hasConfig "T18376" "JHZ2-SIXXS"
& Apt.buildDep ["git-annex"] `period` Daily
diff --git a/debian/changelog b/debian/changelog
index 791cc04b..c5a42e49 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -13,6 +13,10 @@ propellor (2.8.0) UNRELEASED; urgency=medium
Thanks, Mario Lang
* Added Propellor.Property.Unbound for the caching DNS server.
Thanks, Félix Sipma.
+ * Added PTR to Dns.Record. While this is ignored by
+ Propellor.Property.Dns for now, since reverse DNS setup is not
+ implemented there yet, it can be used in other places, eg Unbound.
+ Thanks, Félix Sipma.
* PrivData converted to newtype (API change).
* Stopped stripping trailing newlines when setting PrivData;
this was previously done to avoid mistakes when pasting eg passwords
@@ -21,6 +25,7 @@ propellor (2.8.0) UNRELEASED; urgency=medium
value (without internal newlines) from PrivData.
* Allow storing arbitrary ByteStrings in PrivData, extracted using
privDataByteString.
+ * Added Aiccu module, contributed by Jelmer Vernooij.
-- Joey Hess <id@joeyh.name> Fri, 04 Sep 2015 10:36:40 -0700
diff --git a/propellor.cabal b/propellor.cabal
index f3c6bacd..b42f6859 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -70,6 +70,7 @@ Library
Exposed-Modules:
Propellor
Propellor.Property
+ Propellor.Property.Aiccu
Propellor.Property.Apache
Propellor.Property.Apt
Propellor.Property.Cmd
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 74614a1b..fed62ff9 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -74,13 +74,14 @@ addDNS r = pureInfoProperty (rdesc r) (toDnsInfo (S.singleton r))
rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
rdesc (SSHFP x y s) = unwords ["SSHFP", show x, show y, s]
rdesc (INCLUDE f) = unwords ["$INCLUDE", f]
+ rdesc (PTR x) = unwords ["PTR", x]
ddesc (AbsDomain domain) = domain
ddesc (RelDomain domain) = domain
ddesc RootDomain = "@"
hostMap :: [Host] -> M.Map HostName Host
-hostMap l = M.fromList $ zip (map hostName l) l
+hostMap l = M.fromList $ zip (map hostName l) l
aliasMap :: [Host] -> M.Map HostName Host
aliasMap = M.fromList . concat .
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index a28fb195..5df9fe0d 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -58,7 +58,7 @@ import Utility.FileSystemEncoding
--
-- > withPrivData (PrivFile pemfile) (Context "joeyh.name") $ \getdata ->
-- > property "joeyh.name ssl cert" $ getdata $ \privdata ->
--- > liftIO $ writeFile pemfile privdata
+-- > liftIO $ writeFile pemfile (privDataVal privdata)
-- > where pemfile = "/etc/ssl/certs/web.pem"
--
-- Note that if the value is not available, the action is not run
diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs
new file mode 100644
index 00000000..e8aaa7bb
--- /dev/null
+++ b/src/Propellor/Property/Aiccu.hs
@@ -0,0 +1,50 @@
+module Propellor.Property.Aiccu (
+ installed,
+ restarted,
+ confPath,
+ UserName,
+ TunnelId,
+ hasConfig,
+) where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.File as File
+
+installed :: Property NoInfo
+installed = Apt.installed ["aiccu"]
+
+restarted :: Property NoInfo
+restarted = Service.restarted "aiccu"
+
+confPath :: FilePath
+confPath = "/etc/aiccu.conf"
+
+type TunnelId = String
+
+config :: UserName -> TunnelId -> PrivData -> [File.Line]
+config u t p =
+ [ "protocol tic"
+ , "server tic.sixxs.net"
+ , "username " ++ u
+ , "password " ++ privDataVal p
+ , "ipv6_interface sixxs"
+ , "tunnel_id " ++ t
+ , "daemonize true"
+ , "automatic true"
+ , "requiretls true"
+ , "makebeats true"
+ ]
+
+-- | Configures an ipv6 tunnel using sixxs.net, with the given TunneId
+-- and sixx.net UserName.
+hasConfig :: TunnelId -> UserName -> Property HasInfo
+hasConfig t u = prop `onChange` restarted
+ where
+ prop = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $
+ property "aiccu configured" . writeConfig
+ writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
+ writeConfig getpassword = getpassword $ ensureProperty . go
+ go (Password _, p) = confPath `File.hasContentProtected` config u t p
+ go (f, _) = error $ "Unexpected type of privdata: " ++ show f
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index d854ec52..056733cd 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -28,7 +28,9 @@ import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
--- | Primary dns server for a domain.
+-- | Primary dns server for a domain, using bind.
+--
+-- Currently, this only configures bind to serve forward DNS, not reverse DNS.
--
-- Most of the content of the zone file is configured by setting properties
-- of hosts. For example,
@@ -69,14 +71,14 @@ primary hosts domain soa rs = setup <!> cleanup
zonefile = "/etc/bind/propellor/db." ++ domain
setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property HasInfo
-setupPrimary zonefile mknamedconffile hosts domain soa rs =
+setupPrimary zonefile mknamedconffile hosts domain soa rs =
withwarnings baseprop
`requires` servingZones
where
hostmap = hostMap hosts
-- Known hosts with hostname located in the domain.
indomain = M.elems $ M.filterWithKey (\hn _ -> inDomain domain $ AbsDomain $ hn) hostmap
-
+
(partialzone, zonewarnings) = genZone indomain hostmap domain soa
baseprop = infoProperty ("dns primary for " ++ domain) satisfy
(mempty `addInfo` addNamedConf conf) []
@@ -153,18 +155,18 @@ cleanupPrimary zonefile domain = check (doesFileExist zonefile) $
signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
signedPrimary recurrance hosts domain soa rs = setup <!> cleanup
where
- setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
+ setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
(props
& setupPrimary zonefile signedZoneFile hosts domain soa rs'
& zoneSigned domain zonefile
& forceZoneSigned domain zonefile `period` recurrance
)
`onChange` Service.reloaded "bind9"
-
+
cleanup = cleanupPrimary zonefile domain
`onChange` toProp (revert (zoneSigned domain zonefile))
`onChange` Service.reloaded "bind9"
-
+
-- Include the public keys into the zone file.
rs' = include PubKSK : include PubZSK : rs
include k = (RootDomain, INCLUDE (keyFn domain k))
@@ -243,7 +245,7 @@ confStanza c =
]
where
cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
- ipblock name l =
+ ipblock name l =
[ "\t" ++ name ++ " {" ] ++
(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++
[ "\t};" ]
@@ -286,38 +288,40 @@ dValue (RelDomain d) = d
dValue (AbsDomain d) = d ++ "."
dValue (RootDomain) = "@"
-rField :: Record -> String
-rField (Address (IPv4 _)) = "A"
-rField (Address (IPv6 _)) = "AAAA"
-rField (CNAME _) = "CNAME"
-rField (MX _ _) = "MX"
-rField (NS _) = "NS"
-rField (TXT _) = "TXT"
-rField (SRV _ _ _ _) = "SRV"
-rField (SSHFP _ _ _) = "SSHFP"
-rField (INCLUDE _) = "$INCLUDE"
+rField :: Record -> Maybe String
+rField (Address (IPv4 _)) = Just "A"
+rField (Address (IPv6 _)) = Just "AAAA"
+rField (CNAME _) = Just "CNAME"
+rField (MX _ _) = Just "MX"
+rField (NS _) = Just "NS"
+rField (TXT _) = Just "TXT"
+rField (SRV _ _ _ _) = Just "SRV"
+rField (SSHFP _ _ _) = Just "SSHFP"
+rField (INCLUDE _) = Just "$INCLUDE"
+rField (PTR _) = Nothing
-rValue :: Record -> String
-rValue (Address (IPv4 addr)) = addr
-rValue (Address (IPv6 addr)) = addr
-rValue (CNAME d) = dValue d
-rValue (MX pri d) = show pri ++ " " ++ dValue d
-rValue (NS d) = dValue d
-rValue (SRV priority weight port target) = unwords
+rValue :: Record -> Maybe String
+rValue (Address (IPv4 addr)) = Just addr
+rValue (Address (IPv6 addr)) = Just addr
+rValue (CNAME d) = Just $ dValue d
+rValue (MX pri d) = Just $ show pri ++ " " ++ dValue d
+rValue (NS d) = Just $ dValue d
+rValue (SRV priority weight port target) = Just $ unwords
[ show priority
, show weight
, show port
, dValue target
]
-rValue (SSHFP x y s) = unwords
+rValue (SSHFP x y s) = Just $ unwords
[ show x
, show y
, s
]
-rValue (INCLUDE f) = f
-rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
+rValue (INCLUDE f) = Just f
+rValue (TXT s) = Just $ [q] ++ filter (/= q) s ++ [q]
where
q = '"'
+rValue (PTR _) = Nothing
-- | Adjusts the serial number of the zone to always be larger
-- than the serial number in the Zone record,
@@ -375,27 +379,28 @@ readZonePropellorFile f = catchDefaultIO Nothing $
-- | Generating a zone file.
genZoneFile :: Zone -> String
genZoneFile (Zone zdomain soa rs) = unlines $
- header : genSOA soa ++ map (genRecord zdomain) rs
+ header : genSOA soa ++ mapMaybe (genRecord zdomain) rs
where
header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
-genRecord :: Domain -> (BindDomain, Record) -> String
-genRecord _ (_, record@(INCLUDE _)) = intercalate "\t"
- [ rField record
- , rValue record
- ]
-genRecord zdomain (domain, record) = intercalate "\t"
- [ domainHost zdomain domain
- , "IN"
- , rField record
- , rValue record
- ]
+genRecord :: Domain -> (BindDomain, Record) -> Maybe String
+genRecord zdomain (domain, record) = case (rField record, rValue record) of
+ (Nothing, _) -> Nothing
+ (_, Nothing) -> Nothing
+ (Just rfield, Just rvalue) -> Just $ intercalate "\t" $ case record of
+ INCLUDE _ -> [ rfield, rvalue ]
+ _ ->
+ [ domainHost zdomain domain
+ , "IN"
+ , rfield
+ , rvalue
+ ]
genSOA :: SOA -> [String]
-genSOA soa =
+genSOA soa =
-- "@ IN SOA ns1.example.com. root ("
[ intercalate "\t"
- [ dValue RootDomain
+ [ dValue RootDomain
, "IN"
, "SOA"
, dValue (sDomain soa)
@@ -468,7 +473,7 @@ genZone inzdomain hostmap zdomain soa =
l -> map (ret . Address) l
where
ret record = Right (c, record)
-
+
-- Adds any other DNS records for a host located in the zdomain.
hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
hostrecords h = map Right l
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 4563fe79..a1d3037f 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -10,7 +10,15 @@ type Line = String
-- | Replaces all the content of a file.
hasContent :: FilePath -> [Line] -> Property NoInfo
-f `hasContent` newcontent = fileProperty ("replace " ++ f)
+f `hasContent` newcontent = fileProperty
+ ("replace " ++ f)
+ (\_oldcontent -> newcontent) f
+
+-- | Replaces all the content of a file, ensuring that its modes do not
+-- allow it to be read or written by anyone other than the current user
+hasContentProtected :: FilePath -> [Line] -> Property NoInfo
+f `hasContentProtected` newcontent = fileProperty' writeFileProtected
+ ("replace " ++ f)
(\_oldcontent -> newcontent) f
-- | Ensures a file has contents that comes from PrivData.
diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs
index 950f669e..b982f370 100644
--- a/src/Propellor/Property/Unbound.hs
+++ b/src/Propellor/Property/Unbound.hs
@@ -4,24 +4,33 @@ module Propellor.Property.Unbound
( installed
, restarted
, reloaded
- , genAddressNoTtl
- , genAddress
- , genMX
- , genPTR
- , revIP
- , canonical
- , genZoneStatic
- , genZoneTransparent
+ , cachingDnsServer
) where
import Propellor
+import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
-import Data.List
-import Data.String.Utils (split, replace)
+import Data.List (find)
+type ConfSection = String
+
+type UnboundSetting = (UnboundKey, UnboundValue)
+
+type UnboundSection = (ConfSection, [UnboundSetting])
+
+type UnboundZone = (BindDomain, ZoneType)
+
+type UnboundHost = (BindDomain, Record)
+
+type UnboundKey = String
+
+type UnboundValue = String
+
+type ZoneType = String
+
installed :: Property NoInfo
installed = Apt.installed ["unbound"]
@@ -36,6 +45,75 @@ dValue (RelDomain d) = d
dValue (AbsDomain d) = d ++ "."
dValue (RootDomain) = "@"
+sectionHeader :: ConfSection -> String
+sectionHeader header = header ++ ":"
+
+config :: FilePath
+config = "/etc/unbound/unbound.conf.d/propellor.conf"
+
+-- | Provided a [UnboundSection], a [UnboundZone] and a [UnboundHost],
+-- cachingDnsServer ensure unbound is configured accordingly.
+--
+-- Example property:
+--
+-- > cachingDnsServer
+-- > [ ("remote-control", [("control-enable", "no")]
+-- > , ("server",
+-- > [ ("interface", "0.0.0.0")
+-- > , ("access-control", "192.168.1.0/24 allow")
+-- > , ("do-tcp", "no")
+-- > ])
+-- > [ (AbsDomain "example.com", "transparent")
+-- > , (AbsDomain $ reverseIP $ IPv4 "192.168.1", "static")
+-- > ]
+-- > [ (AbsDomain "example.com", Address $ IPv4 "192.168.1.2")
+-- > , (AbsDomain "myhost.example.com", Address $ IPv4 "192.168.1.2")
+-- > , (AbsDomain "myrouter.example.com", Address $ IPv4 "192.168.1.1")
+-- > , (AbsDomain "www.example.com", Address $ IPv4 "192.168.1.2")
+-- > , (AbsDomain "example.com", MX 10 "mail.example.com")
+-- > , (AbsDomain "mylaptop.example.com", Address $ IPv4 "192.168.1.2")
+-- > -- ^ connected via ethernet
+-- > , (AbsDomain "mywifi.example.com", Address $ IPv4 "192.168.2.1")
+-- > , (AbsDomain "mylaptop.example.com", Address $ IPv4 "192.168.2.2")
+-- > -- ^ connected via wifi, use round robin
+-- > , (AbsDomain "myhost.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
+-- > , (AbsDomain "myrouter.example.com", PTR $ reverseIP $ IPv4 "192.168.1.1")
+-- > , (AbsDomain "mylaptop.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
+-- > ]
+cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property NoInfo
+cachingDnsServer sections zones hosts =
+ config `hasContent` (comment : otherSections ++ serverSection)
+ `onChange` restarted
+ where
+ comment = "# deployed with propellor, do not modify"
+ serverSection = genSection (fromMaybe ("server", []) $ find ((== "server") . fst) sections)
+ ++ map genZone zones
+ ++ map (uncurry genRecord') hosts
+ otherSections = foldr ((++) . genSection) [] sections
+
+genSection :: UnboundSection -> [Line]
+genSection (section, settings) = sectionHeader section : map genSetting settings
+
+genSetting :: UnboundSetting -> Line
+genSetting (key, value) = " " ++ key ++ ": " ++ value
+
+genZone :: UnboundZone -> Line
+genZone (dom, zt) = " local-zone: \"" ++ dValue dom ++ "\" " ++ zt
+
+genRecord' :: BindDomain -> Record -> Line
+genRecord' dom r = " local-data: \"" ++ fromMaybe "" (genRecord dom r) ++ "\""
+
+genRecord :: BindDomain -> Record -> Maybe String
+genRecord dom (Address addr) = Just $ genAddressNoTtl dom addr
+genRecord dom (MX priority dest) = Just $ genMX dom priority dest
+genRecord dom (PTR revip) = Just $ genPTR dom revip
+genRecord _ (CNAME _) = Nothing
+genRecord _ (NS _) = Nothing
+genRecord _ (TXT _) = Nothing
+genRecord _ (SRV _ _ _ _) = Nothing
+genRecord _ (SSHFP _ _ _) = Nothing
+genRecord _ (INCLUDE _) = Nothing
+
genAddressNoTtl :: BindDomain -> IPAddr -> String
genAddressNoTtl dom = genAddress dom Nothing
@@ -45,43 +123,10 @@ genAddress dom ttl addr = case addr of
IPv6 _ -> genAddress' "AAAA" dom ttl addr
genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String
-genAddress' recordtype dom ttl addr = localData $ dValue dom ++ " " ++ maybe "" (\ttl' -> show ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr
-
-genMX :: BindDomain -> BindDomain -> Int -> String
-genMX dom dest priority = localData $ dValue dom ++ " " ++ "MX" ++ " " ++ show priority ++ " " ++ dValue dest
-
-genPTR :: BindDomain -> IPAddr -> String
-genPTR dom ip = localData $ revIP ip ++ ". " ++ "PTR" ++ " " ++ dValue dom
-
-revIP :: IPAddr -> String
-revIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"
-revIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonical addr) ++ ".ip6.arpa"
-
-canonical :: IPAddr -> IPAddr
-canonical (IPv4 addr) = IPv4 addr
-canonical (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr
- where
- canonicalGroup g = case length g of
- 0 -> "0000"
- 1 -> "000" ++ g
- 2 -> "00" ++ g
- 3 -> "0" ++ g
- _ -> g
- emptyGroups n = iterate (++ ":") "" !! n
- numberOfImplicitGroups a = 8 - length (split ":" $ replace "::" "" a)
- replaceImplicitGroups a = concat $ aux $ split "::" a
- where
- aux [] = []
- aux (x : xs) = x : emptyGroups (numberOfImplicitGroups a) : xs
-
-localData :: String -> String
-localData conf = " local-data: \"" ++ conf ++ "\""
-
-genZoneStatic :: BindDomain -> String
-genZoneStatic dom = localZone (dValue dom) "static"
+genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> show ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr
-genZoneTransparent :: BindDomain -> String
-genZoneTransparent dom = localZone (dValue dom) "transparent"
+genMX :: BindDomain -> Int -> BindDomain -> String
+genMX dom priority dest = dValue dom ++ " " ++ "MX" ++ " " ++ show priority ++ " " ++ dValue dest
-localZone :: String -> String -> String
-localZone zone confzone = " local-zone: \"" ++ zone ++ "\" " ++ confzone
+genPTR :: BindDomain -> ReverseIP -> String
+genPTR dom revip = revip ++ ". " ++ "PTR" ++ " " ++ dValue dom
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index d78c78fd..3497b3ed 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -10,6 +10,8 @@ import Data.Word
import Data.Monoid
import qualified Data.Map as M
import qualified Data.Set as S
+import Data.List
+import Data.String.Utils (split, replace)
type Domain = String
@@ -91,8 +93,34 @@ data Record
| SRV Word16 Word16 Word16 BindDomain
| SSHFP Int Int String
| INCLUDE FilePath
+ | PTR ReverseIP
deriving (Read, Show, Eq, Ord, Typeable)
+-- | An in-addr.arpa record corresponding to an IPAddr.
+type ReverseIP = String
+
+reverseIP :: IPAddr -> ReverseIP
+reverseIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"
+reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonicalIP addr) ++ ".ip6.arpa"
+
+-- | Converts an IP address (particularly IPv6) to canonical, fully
+-- expanded form.
+canonicalIP :: IPAddr -> IPAddr
+canonicalIP (IPv4 addr) = IPv4 addr
+canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr
+ where
+ canonicalGroup g
+ | l <= 4 = replicate (4 - l) '0' ++ g
+ | otherwise = error $ "IPv6 group " ++ g ++ "as more than 4 hex digits"
+ where
+ l = length g
+ emptyGroups n = iterate (++ ":") "" !! n
+ numberOfImplicitGroups a = 8 - length (split ":" $ replace "::" "" a)
+ replaceImplicitGroups a = concat $ aux $ split "::" a
+ where
+ aux [] = []
+ aux (x : xs) = x : emptyGroups (numberOfImplicitGroups a) : xs
+
getIPAddr :: Record -> Maybe IPAddr
getIPAddr (Address addr) = Just addr
getIPAddr _ = Nothing
generated by cgit v1.3-2-g0d8e (git 2.53.0) at 2026-06-14 04:12:20 +0000