{-# LANGUAGE LambdaCase #-}

module Propellor.Property.Hostname where

import Propellor.Base
import qualified Propellor.Property.File as File
import Propellor.Types.Container
import Utility.Split

import Data.List

-- | Ensures that the hostname is set using best practices, to whatever
-- name the `Host` has.
--
-- Configures both </etc/hostname> and the current hostname.
-- (However, when used inside a chroot, avoids setting the current hostname
-- as that would impact the system outside the chroot.)
--
-- </etc/hosts> is also configured, with an entry for 127.0.1.1, which is
-- standard at least on Debian to set the FDQN.
--
-- Also, the </etc/hosts> 127.0.0.1 line is set to localhost. Putting any
-- other hostnames there is not best practices and can lead to annoying
-- messages from eg, apache.
sane :: Property UnixLike
sane :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
sane = ExtractDomain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
sane' ExtractDomain
extractDomain

sane' :: ExtractDomain -> Property UnixLike
sane' :: ExtractDomain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
sane' ExtractDomain
extractdomain = forall {k} (metatypes :: k).
SingI metatypes =>
Desc
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (Desc
"sane hostname") forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w ->
	forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtractDomain
-> Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setTo' ExtractDomain
extractdomain forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> Desc
hostName

-- Like `sane`, but you can specify the hostname to use, instead
-- of the default hostname of the `Host`.
setTo :: HostName -> Property UnixLike
setTo :: Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setTo = ExtractDomain
-> Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setTo' ExtractDomain
extractDomain

setTo' :: ExtractDomain -> HostName -> Property UnixLike
setTo' :: ExtractDomain
-> Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setTo' ExtractDomain
extractdomain Desc
hn = forall {k} (metatypes :: k).
SingI metatypes =>
Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties Desc
desc forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps
	[ Desc
"/etc/hostname" Desc
-> [Desc]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent` [Desc
basehost]
	, [(Desc, [Desc])]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
hostslines forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
		[ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Desc
domain
			then forall a. Maybe a
Nothing 
			else forall a. a -> Maybe a
Just (Desc
"127.0.1.1", [Desc
hn, Desc
basehost])
		, forall a. a -> Maybe a
Just (Desc
"127.0.0.1", [Desc
"localhost"])
		]
	, forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check Propellor Bool
safetochange forall a b. (a -> b) -> a -> b
$
		Desc
-> [Desc]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty Desc
"hostname" [Desc
basehost]
			forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	]
  where
	desc :: Desc
desc = Desc
"hostname " forall a. [a] -> [a] -> [a]
++ Desc
hn
	basehost :: Desc
basehost = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') Desc
hn
	domain :: Desc
domain = ExtractDomain
extractdomain Desc
hn
	
	safetochange :: Propellor Bool
safetochange = forall v. IsInfo v => Propellor v
askInfo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
		[] -> Bool
True
		[ContainerCapability]
caps -> ContainerCapability
HostnameContained forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ContainerCapability]
caps

	hostslines :: [(Desc, [Desc])]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
hostslines [(Desc, [Desc])]
ipsnames = 
		forall c.
(FileContent c, Eq c) =>
Desc
-> (c -> c)
-> Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.fileProperty Desc
desc ([(Desc, [Desc])] -> [Desc] -> [Desc]
addhostslines [(Desc, [Desc])]
ipsnames) Desc
"/etc/hosts"
	addhostslines :: [(String, [String])] -> [String] -> [String]
	addhostslines :: [(Desc, [Desc])] -> [Desc] -> [Desc]
addhostslines [(Desc, [Desc])]
ipsnames [Desc]
ls =
		let ips :: [Desc]
ips = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Desc, [Desc])]
ipsnames
		    hasip :: Desc -> Bool
hasip Desc
l = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Desc]
ips) (forall a. [a] -> Maybe a
headMaybe (Desc -> [Desc]
words Desc
l))
		    mkline :: (Desc, [Desc]) -> Desc
mkline (Desc
ip, [Desc]
names) = Desc
ip forall a. [a] -> [a] -> [a]
++ Desc
"\t" forall a. [a] -> [a] -> [a]
++ ([Desc] -> Desc
unwords [Desc]
names)
		in forall a b. (a -> b) -> [a] -> [b]
map (Desc, [Desc]) -> Desc
mkline [(Desc, [Desc])]
ipsnames forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Desc -> Bool
hasip) [Desc]
ls

-- | Makes </etc/resolv.conf> contain search and domain lines for 
-- the domain that the hostname is in.
searchDomain :: Property UnixLike
searchDomain :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
searchDomain = ExtractDomain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
searchDomain' ExtractDomain
extractDomain

searchDomain' :: ExtractDomain -> Property UnixLike
searchDomain' :: ExtractDomain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
searchDomain' ExtractDomain
extractdomain = forall {k} (metatypes :: k).
SingI metatypes =>
Desc
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Desc
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w ->
	(forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> Desc
hostName)
  where
	desc :: Desc
desc = Desc
"resolv.conf search and domain configured"
	go :: Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go Desc
hn =
		let domain :: Desc
domain = ExtractDomain
extractdomain Desc
hn
		in  forall c.
(FileContent c, Eq c) =>
Desc
-> (c -> c)
-> Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.fileProperty Desc
desc (Desc -> [Desc] -> [Desc]
use Desc
domain) Desc
"/etc/resolv.conf"
	use :: Desc -> [Desc] -> [Desc]
use Desc
domain [Desc]
ls = forall a. (a -> Bool) -> [a] -> [a]
filter Desc -> Bool
wanted forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub ([Desc]
ls forall a. [a] -> [a] -> [a]
++ [Desc]
cfgs)
	  where
		cfgs :: [Desc]
cfgs = [Desc
"domain " forall a. [a] -> [a] -> [a]
++ Desc
domain, Desc
"search " forall a. [a] -> [a] -> [a]
++ Desc
domain]
		wanted :: Desc -> Bool
wanted Desc
l
			| Desc
l forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Desc]
cfgs = Bool
True
			| Desc
"domain " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Desc
l = Bool
False
			| Desc
"search " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Desc
l = Bool
False
			| Bool
otherwise = Bool
True

-- Configures </etc/mailname> with the domain part of the hostname of the
-- `Host` it's used in.
mailname :: Property UnixLike
mailname :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
mailname = ExtractDomain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
mailname' ExtractDomain
extractDomain

mailname' :: ExtractDomain -> Property UnixLike
mailname' :: ExtractDomain
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
mailname' ExtractDomain
extractdomain = forall {k} (metatypes :: k).
SingI metatypes =>
Desc
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (Desc
"mailname set from hostname") forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w ->
	forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> Desc
hostName
  where
	go :: Desc
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go Desc
mn = Desc
"/etc/mailname" Desc
-> [Desc]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent` [if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Desc
mn' then Desc
mn else Desc
mn']
	  where
	 	mn' :: Desc
mn' = ExtractDomain
extractdomain Desc
mn

-- | 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 :: ExtractDomain
extractDomain Desc
hn = 
	let bits :: [Desc]
bits = forall a. Eq a => [a] -> [a] -> [[a]]
split Desc
"." Desc
hn
	in forall a. [a] -> [[a]] -> [a]
intercalate Desc
"." forall a b. (a -> b) -> a -> b
$
		if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Desc]
bits forall a. Ord a => a -> a -> Bool
> Int
2
			then forall a. Int -> [a] -> [a]
drop Int
1 [Desc]
bits
			else [Desc]
bits