From 19afb0e0bc079bfde470b5044aefd8c09c7610a4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 12:55:41 -0400 Subject: HostName: Improve domain extraction code. --- debian/changelog | 1 + src/Propellor/Property/Hostname.hs | 40 +++++++++++++++++++++++++++++++++----- 2 files changed, 36 insertions(+), 5 deletions(-) diff --git a/debian/changelog b/debian/changelog index 487826e1..0fd2cb1d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,7 @@ propellor (2.11.1) UNRELEASED; urgency=medium as chroots. Thanks, Ben Boeckel. * Added Mount.fstabbed property to generate /etc/fstab to replicate current mounts. + * HostName: Improve domain extraction code. -- Joey Hess Thu, 22 Oct 2015 20:24:18 -0400 diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs index 7766d497..78ec872f 100644 --- a/src/Propellor/Property/Hostname.hs +++ b/src/Propellor/Property/Hostname.hs @@ -4,6 +4,7 @@ import Propellor.Base import qualified Propellor.Property.File as File import Data.List +import Data.List.Utils -- | Ensures that the hostname is set using best practices. -- @@ -18,13 +19,21 @@ import Data.List -- other hostnames there is not best practices and can lead to annoying -- messages from eg, apache. sane :: Property NoInfo -sane = property ("sane hostname") (ensureProperty . setTo =<< asks hostName) +sane = sane' extractDomain + +sane' :: ExtractDomain -> Property NoInfo +sane' extractdomain = property ("sane hostname") $ + ensureProperty . setTo' extractdomain =<< asks hostName setTo :: HostName -> Property NoInfo -setTo hn = combineProperties desc go +setTo = setTo' extractDomain + +setTo' :: ExtractDomain -> HostName -> Property NoInfo +setTo' extractdomain hn = combineProperties desc go where desc = "hostname " ++ hn - (basehost, domain) = separate (== '.') hn + basehost = takeWhile (/= '.') hn + domain = extractdomain hn go = catMaybes [ Just $ "/etc/hostname" `File.hasContent` [basehost] @@ -47,11 +56,14 @@ setTo hn = combineProperties desc go -- | Makes contain search and domain lines for -- the domain that the hostname is in. searchDomain :: Property NoInfo -searchDomain = property desc (ensureProperty . go =<< asks hostName) +searchDomain = searchDomain' extractDomain + +searchDomain' :: ExtractDomain -> Property NoInfo +searchDomain' extractdomain = property desc (ensureProperty . go =<< asks hostName) where desc = "resolv.conf search and domain configured" go hn = - let (_basehost, domain) = separate (== '.') hn + let domain = extractdomain hn in File.fileProperty desc (use domain) "/etc/resolv.conf" use domain ls = filter wanted $ nub (ls ++ cfgs) where @@ -61,3 +73,21 @@ searchDomain = property desc (ensureProperty . go =<< asks hostName) | "domain " `isPrefixOf` l = False | "search " `isPrefixOf` l = False | otherwise = True + +-- | Function to extract the domain name from a HostName. +type ExtractDomain = HostName -> String + +-- | hostname of foo.example.com has a domain of example.com. +-- But, when the hostname is example.com, the domain is +-- example.com too. +-- +-- This doesn't work for eg, foo.co.uk, or when foo.sci.uni.edu +-- is in a sci.uni.edu subdomain. If you are in such a network, +-- provide your own ExtractDomain function to the properties above. +extractDomain :: ExtractDomain +extractDomain hn = + let bits = split "." hn + in intercalate "." $ + if length bits > 2 + then drop 1 bits + else bits -- cgit v1.2.3