    {-# 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 UnixLike
    sane = ExtractDomain -> Property UnixLike
    sane' ExtractDomain
    extractDomain

    sane' :: ExtractDomain -> Property UnixLike
    sane' :: ExtractDomain -> Property UnixLike
    sane' extractdomain :: ExtractDomain
    extractdomain = Desc
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
        -> Propellor Result)
    -> Property UnixLike
    forall k (metatypes :: k).
    SingI metatypes =>
    Desc
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' ("sane hostname") ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
      -> Propellor Result)
     -> Property UnixLike)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
        -> Propellor Result)
    -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $ \w :: OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    w ->
    	OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Property UnixLike -> Propellor Result
    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 (Property UnixLike -> Propellor Result)
    -> (Desc -> Property UnixLike) -> Desc -> Propellor Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExtractDomain -> Desc -> Property UnixLike
    setTo' ExtractDomain
    extractdomain (Desc -> Propellor Result) -> Propellor Desc -> Propellor Result
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (Host -> Desc) -> Propellor Desc
    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 UnixLike
    setTo = ExtractDomain -> Desc -> Property UnixLike
    setTo' ExtractDomain
    extractDomain

    setTo' :: ExtractDomain -> HostName -> Property UnixLike
    setTo' :: ExtractDomain -> Desc -> Property UnixLike
    setTo' extractdomain :: ExtractDomain
    extractdomain hn :: Desc
    hn = Desc -> Props UnixLike -> Property UnixLike
    forall k (metatypes :: k).
    SingI metatypes =>
    Desc
    -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
    combineProperties Desc
    desc (Props UnixLike -> Property UnixLike)
    -> Props UnixLike -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $ [Property UnixLike] -> Props UnixLike
    forall k (metatypes :: k).
    [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
    toProps
    	[ "/etc/hostname" Desc -> [Desc] -> Property UnixLike
    `File.hasContent` [Desc
    basehost]
    	, [(Desc, [Desc])] -> Property UnixLike
    hostslines ([(Desc, [Desc])] -> Property UnixLike)
    -> [(Desc, [Desc])] -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $ [Maybe (Desc, [Desc])] -> [(Desc, [Desc])]
    forall a. [Maybe a] -> [a]
    catMaybes
    		[ if Desc -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Desc
    domain
    			then Maybe (Desc, [Desc])
    forall a. Maybe a
    Nothing
    			else (Desc, [Desc]) -> Maybe (Desc, [Desc])
    forall a. a -> Maybe a
    Just ("127.0.1.1", [Desc
    hn, Desc
    basehost])
    		, (Desc, [Desc]) -> Maybe (Desc, [Desc])
    forall a. a -> Maybe a
    Just ("127.0.0.1", ["localhost"])
    		]
    	, Propellor Bool -> Property UnixLike -> Property UnixLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check Propellor Bool
    safetochange (Property UnixLike -> Property UnixLike)
    -> Property UnixLike -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $
    		Desc -> [Desc] -> UncheckedProperty UnixLike
    cmdProperty "hostname" [Desc
    basehost]
    			UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    NoChange
    	]
      where
    	desc :: Desc
    desc = "hostname " Desc -> ExtractDomain
    forall a. [a] -> [a] -> [a]
    ++ Desc
    hn
    	basehost :: Desc
    basehost = (Char -> Bool) -> ExtractDomain
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '.') Desc
    hn
    	domain :: Desc
    domain = ExtractDomain
    extractdomain Desc
    hn

    	safetochange :: Propellor Bool
    safetochange = Propellor [ContainerCapability]
    forall v. IsInfo v => Propellor v
    askInfo Propellor [ContainerCapability]
    -> ([ContainerCapability] -> Propellor Bool) -> Propellor Bool
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Propellor Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Propellor Bool)
    -> ([ContainerCapability] -> Bool)
    -> [ContainerCapability]
    -> Propellor Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . \case
    		[] -> Bool
    True
    		caps :: [ContainerCapability]
    caps -> ContainerCapability
    HostnameContained ContainerCapability -> [ContainerCapability] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ContainerCapability]
    caps

    	hostslines :: [(Desc, [Desc])] -> Property UnixLike
    hostslines ipsnames :: [(Desc, [Desc])]
    ipsnames =
    		Desc -> ([Desc] -> [Desc]) -> Desc -> Property UnixLike
    forall c.
    (FileContent c, Eq c) =>
    Desc -> (c -> c) -> Desc -> Property UnixLike
    File.fileProperty Desc
    desc ([(Desc, [Desc])] -> [Desc] -> [Desc]
    addhostslines [(Desc, [Desc])]
    ipsnames) "/etc/hosts"
    	addhostslines :: [(String, [String])] -> [String] -> [String]
    	addhostslines :: [(Desc, [Desc])] -> [Desc] -> [Desc]
    addhostslines ipsnames :: [(Desc, [Desc])]
    ipsnames ls :: [Desc]
    ls =
    		let ips :: [Desc]
    ips = ((Desc, [Desc]) -> Desc) -> [(Desc, [Desc])] -> [Desc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Desc, [Desc]) -> Desc
    forall a b. (a, b) -> a
    fst [(Desc, [Desc])]
    ipsnames
    		    hasip :: Desc -> Bool
    hasip l :: Desc
    l = Bool -> (Desc -> Bool) -> Maybe Desc -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Desc -> [Desc] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Desc]
    ips) ([Desc] -> Maybe Desc
    forall a. [a] -> Maybe a
    headMaybe (Desc -> [Desc]
    words Desc
    l))
    		    mkline :: (Desc, [Desc]) -> Desc
    mkline (ip :: Desc
    ip, names :: [Desc]
    names) = Desc
    ip Desc -> ExtractDomain
    forall a. [a] -> [a] -> [a]
    ++ "\t" Desc -> ExtractDomain
    forall a. [a] -> [a] -> [a]
    ++ ([Desc] -> Desc
    unwords [Desc]
    names)
    		in ((Desc, [Desc]) -> Desc) -> [(Desc, [Desc])] -> [Desc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Desc, [Desc]) -> Desc
    mkline [(Desc, [Desc])]
    ipsnames [Desc] -> [Desc] -> [Desc]
    forall a. [a] -> [a] -> [a]
    ++ (Desc -> Bool) -> [Desc] -> [Desc]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Desc -> Bool) -> Desc -> Bool
    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 UnixLike
    searchDomain = ExtractDomain -> Property UnixLike
    searchDomain' ExtractDomain
    extractDomain

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

    mailname' :: ExtractDomain -> Property UnixLike
    mailname' :: ExtractDomain -> Property UnixLike
    mailname' extractdomain :: ExtractDomain
    extractdomain = Desc
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
        -> Propellor Result)
    -> Property UnixLike
    forall k (metatypes :: k).
    SingI metatypes =>
    Desc
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' ("mailname set from hostname") ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
      -> Propellor Result)
     -> Property UnixLike)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
        -> Propellor Result)
    -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $ \w :: OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    w ->
    	OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Property UnixLike -> Propellor Result
    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 (Property UnixLike -> Propellor Result)
    -> (Desc -> Property UnixLike) -> Desc -> Propellor Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Desc -> Property UnixLike
    go (Desc -> Propellor Result) -> Propellor Desc -> Propellor Result
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (Host -> Desc) -> Propellor Desc
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Host -> Desc
    hostName
      where
    	go :: Desc -> Property UnixLike
    go mn :: Desc
    mn = "/etc/mailname" Desc -> [Desc] -> Property UnixLike
    `File.hasContent` [if Desc -> Bool
    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 hn :: Desc
    hn =
    	let bits :: [Desc]
    bits = Desc -> Desc -> [Desc]
    forall a. Eq a => [a] -> [a] -> [[a]]
    split "." Desc
    hn
    	in Desc -> [Desc] -> Desc
    forall a. [a] -> [[a]] -> [a]
    intercalate "." ([Desc] -> Desc) -> [Desc] -> Desc
    forall a b. (a -> b) -> a -> b
    $
    		if [Desc] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Desc]
    bits Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 2
    			then Int -> [Desc] -> [Desc]
    forall a. Int -> [a] -> [a]
    drop 1 [Desc]
    bits
    			else [Desc]
    bits