{-# LANGUAGE FlexibleInstances, TypeFamilies #-}

module Propellor.Property.Systemd (
	-- * Services
	ServiceName,
	started,
	stopped,
	enabled,
	disabled,
	masked,
	running,
	restarted,
	networkd,
	journald,
	logind,
	escapePath,
	-- * Configuration
	installed,
	Option,
	configured,
	daemonReloaded,
	-- * Journal
	persistentJournal,
	journaldConfigured,
	-- * Logind
	logindConfigured,
	killUserProcesses,
	-- * Containers and machined
	machined,
	MachineName,
	Container,
	container,
	debContainer,
	nspawned,
	-- * Container configuration
	containerCfg,
	resolvConfed,
	linkJournal,
	privateNetwork,
	module Propellor.Types.Container,
	Proto(..),
	Publishable,
	publish,
	Bindable,
	bind,
	bindRo,
) where

import Propellor.Base
import Propellor.Types.Chroot
import Propellor.Types.Container
import Propellor.Container
import Propellor.Types.Info
import qualified Propellor.Property.Chroot as Chroot
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import Propellor.Property.Systemd.Core
import Utility.Split

import Data.List
import Data.Char
import qualified Data.Map as M
import Text.Printf

type ServiceName = String

type MachineName = String

data Container = Container MachineName Chroot.Chroot Host
	deriving (Int -> Container -> ShowS
[Container] -> ShowS
Container -> String
(Int -> Container -> ShowS)
-> (Container -> String)
-> ([Container] -> ShowS)
-> Show Container
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Container] -> ShowS
$cshowList :: [Container] -> ShowS
show :: Container -> String
$cshow :: Container -> String
showsPrec :: Int -> Container -> ShowS
$cshowsPrec :: Int -> Container -> ShowS
Show)

instance IsContainer Container where
	containerProperties :: Container -> [ChildProperty]
containerProperties (Container String
_ Chroot
_ Host
h) = Host -> [ChildProperty]
forall c. IsContainer c => c -> [ChildProperty]
containerProperties Host
h
	containerInfo :: Container -> Info
containerInfo (Container String
_ Chroot
_ Host
h) = Host -> Info
forall c. IsContainer c => c -> Info
containerInfo Host
h
	setContainerProperties :: Container -> [ChildProperty] -> Container
setContainerProperties (Container String
n Chroot
c Host
h) [ChildProperty]
ps = String -> Chroot -> Host -> Container
Container String
n Chroot
c (Host -> [ChildProperty] -> Host
forall c. IsContainer c => c -> [ChildProperty] -> c
setContainerProperties Host
h [ChildProperty]
ps)

-- | Starts a systemd service.
--
-- Note that this does not configure systemd to start the service on boot,
-- it only ensures that the service is currently running.
started :: ServiceName -> Property Linux
started :: String -> Property Linux
started String
n = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"systemctl" [String
"start", String
n]
	UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> String -> p
`describe` (String
"service " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" started")

-- | Stops a systemd service.
stopped :: ServiceName -> Property Linux
stopped :: String -> Property Linux
stopped String
n = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"systemctl" [String
"stop", String
n]
	UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> String -> p
`describe` (String
"service " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" stopped")

-- | Enables a systemd service.
--
-- This does not ensure the service is started, it only configures systemd
-- to start it on boot.
enabled :: ServiceName -> Property Linux
enabled :: String -> Property Linux
enabled String
n = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"systemctl" [String
"enable", String
n]
	UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> String -> p
`describe` (String
"service " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" enabled")

-- | Disables a systemd service.
disabled :: ServiceName -> Property Linux
disabled :: String -> Property Linux
disabled String
n = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"systemctl" [String
"disable", String
n]
	UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> String -> p
`describe` (String
"service " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" disabled")

-- | Masks a systemd service.
masked :: ServiceName -> RevertableProperty Linux Linux
masked :: String -> RevertableProperty Linux Linux
masked String
n = Property Linux
systemdMask Property Linux -> Property Linux -> RevertableProperty Linux Linux
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property Linux
systemdUnmask
  where
	systemdMask :: Property Linux
systemdMask = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"systemctl" [String
"mask", String
n]
		UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> String -> p
`describe` (String
"service " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" masked")
	systemdUnmask :: Property Linux
systemdUnmask = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"systemctl" [String
"unmask", String
n]
		UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> String -> p
`describe` (String
"service " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" unmasked")

-- | Ensures that a service is both enabled and started
running :: ServiceName -> Property Linux
running :: String -> Property Linux
running String
n = String -> Property Linux
started String
n Property Linux
-> Property Linux -> CombinedType (Property Linux) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> Property Linux
enabled String
n

-- | Restarts a systemd service.
restarted :: ServiceName -> Property Linux
restarted :: String -> Property Linux
restarted String
n = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"systemctl" [String
"restart", String
n]
	UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall p. IsProp p => p -> String -> p
`describe` (String
"service " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" restarted")

-- | The systemd-networkd service.
networkd :: ServiceName
networkd :: String
networkd = String
"systemd-networkd"

-- | The systemd-journald service.
journald :: ServiceName
journald :: String
journald = String
"systemd-journald"

-- | The systemd-logind service.
logind :: ServiceName
logind :: String
logind = String
"systemd-logind"

-- | Enables persistent storage of the journal.
persistentJournal :: Property DebianLike
persistentJournal :: Property DebianLike
persistentJournal = IO Bool -> Property DebianLike -> Property DebianLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesDirectoryExist String
dir) (Property DebianLike -> Property DebianLike)
-> Property DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
	String -> Props DebianLike -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
"persistent systemd journal" (Props DebianLike -> Property DebianLike)
-> Props DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
		Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"install" [String
"-d", String
"-g", String
"systemd-journal", String
dir]
			UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
		Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& [String] -> Property DebianLike
Apt.installed [String
"acl"]
		Props DebianLike
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"setfacl" [String
"-R", String
"-nm", String
"g:adm:rx,d:g:adm:rx", String
dir]
			UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
		Props DebianLike
-> Property Linux
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> Property Linux
started String
"systemd-journal-flush"
  where
	dir :: String
dir = String
"/var/log/journal"

type Option = String

-- | Ensures that an option is configured in one of systemd's config files.
-- Does not ensure that the relevant daemon notices the change immediately.
--
-- This assumes that there is only one [Header] per file, which is
-- currently the case for files like journald.conf and system.conf.
-- And it assumes the file already exists with
-- the right [Header], so new lines can just be appended to the end.
configured :: FilePath -> Option -> String -> Property Linux
configured :: String -> String -> String -> Property Linux
configured String
cfgfile String
option String
value = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> Props
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc (Props
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Props
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
	Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
-> ([String] -> [String])
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall c.
(FileContent c, Eq c) =>
String
-> (c -> c)
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.fileProperty String
desc ((String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
removeother) String
cfgfile
	Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
-> String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.containsLine String
cfgfile String
line
  where
	setting :: String
setting = String
option String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"="
	line :: String
line = String
setting String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
value
	desc :: String
desc = String
cfgfile String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line
	removeother :: String -> Maybe String
removeother String
l
		| String
setting String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l Bool -> Bool -> Bool
&& String
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
line = Maybe String
forall a. Maybe a
Nothing
		| Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just String
l

-- | Causes systemd to reload its configuration files.
daemonReloaded :: Property Linux
daemonReloaded :: Property Linux
daemonReloaded = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property Linux)
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"systemctl" [String
"daemon-reload"]
	UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Result
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange

-- | Configures journald, restarting it so the changes take effect.
journaldConfigured :: Option -> String -> Property Linux
journaldConfigured :: String -> String -> Property Linux
journaldConfigured String
option String
value =
	String -> String -> String -> Property Linux
configured String
"/etc/systemd/journald.conf" String
option String
value
		Property Linux
-> Property Linux -> CombinedType (Property Linux) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` String -> Property Linux
restarted String
journald

-- | Configures logind, restarting it so the changes take effect.
logindConfigured :: Option -> String -> Property Linux
logindConfigured :: String -> String -> Property Linux
logindConfigured String
option String
value =
	String -> String -> String -> Property Linux
configured String
"/etc/systemd/logind.conf" String
option String
value
		Property Linux
-> Property Linux -> CombinedType (Property Linux) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` String -> Property Linux
restarted String
logind

-- | Configures whether leftover processes started from the
-- user's login session are killed after the user logs out.
--
-- The default configuration varies depending on the version of systemd.
--
-- Revert the property to ensure that screen sessions etc keep running:
--
-- >	! killUserProcesses
killUserProcesses :: RevertableProperty Linux Linux
killUserProcesses :: RevertableProperty Linux Linux
killUserProcesses = String -> Property Linux
set String
"yes" Property Linux -> Property Linux -> RevertableProperty Linux Linux
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> String -> Property Linux
set String
"no"
  where
	set :: String -> Property Linux
set = String -> String -> Property Linux
logindConfigured String
"KillUserProcesses"

-- | Ensures machined and machinectl are installed
machined :: Property Linux
machined :: Property Linux
machined = Property DebianLike
installeddebian Property DebianLike -> Property Linux -> Property Linux
forall k ka kb (c :: k) (a :: ka) (b :: kb).
(HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
 DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
 SingI c) =>
Property (MetaTypes a)
-> Property (MetaTypes b) -> Property (MetaTypes c)
`pickOS` Property Linux
assumeinstalled
  where
	installeddebian :: Property DebianLike
	installeddebian :: Property DebianLike
installeddebian = String
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe System -> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS String
"machined installed" ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Maybe System -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe System -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Maybe System
o ->
		case Maybe System
o of
			-- Split into separate debian package since systemd 225.
			(Just (System (Debian DebianKernel
_ DebianSuite
suite) Architecture
_))
				| Bool -> Bool
not (DebianSuite -> Bool
isStable DebianSuite
suite) Bool -> Bool -> Bool
|| DebianSuite
suite DebianSuite -> DebianSuite -> Bool
forall a. Eq a => a -> a -> Bool
/= (String -> DebianSuite
Stable String
"jessie") ->
					OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property DebianLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property DebianLike -> Propellor Result)
-> Property DebianLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ [String] -> Property DebianLike
Apt.installed [String
"systemd-container"]
			Maybe System
_ -> Propellor Result
noChange
	assumeinstalled :: Property Linux
	assumeinstalled :: Property Linux
assumeinstalled = Property Linux
forall k (t :: k). SingI t => Property (MetaTypes t)
doNothing

-- | Defines a container with a given machine name,
-- and how to create its chroot if not already present.
--
-- Properties can be added to configure the Container. At a minimum,
-- add a property such as `osDebian` to specify the operating system
-- to bootstrap.
--
-- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props
-- >    & osDebian Unstable X86_64
-- >    & Apt.installedRunning "apache2"
-- >    & ...
container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
container :: String -> (String -> Chroot) -> Container
container String
name String -> Chroot
mkchroot =
	let c :: Container
c = String -> Chroot -> Host -> Container
Container String
name Chroot
chroot Host
h
	in Container
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
-> Container
forall c metatypes. IsContainer c => c -> Props metatypes -> c
setContainerProps Container
c (Props
   (MetaTypes
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux])
 -> Container)
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
-> Container
forall a b. (a -> b) -> a -> b
$ Container
-> Props
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall c.
IsContainer c =>
c
-> Props
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
containerProps Container
c
		Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&^"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
&^ RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
resolvConfed
		Props
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
-> Props
     (MetaTypes
        (Combine
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux]
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&^"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
&^ RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
linkJournal
  where
	chroot :: Chroot
chroot = String -> Chroot
mkchroot (ShowS
containerDir String
name)
	h :: Host
h = String -> [ChildProperty] -> Info -> Host
Host String
name (Chroot -> [ChildProperty]
forall c. IsContainer c => c -> [ChildProperty]
containerProperties Chroot
chroot) (Chroot -> Info
forall c. IsContainer c => c -> Info
containerInfo Chroot
chroot)

-- | Defines a container with a given machine name, with the chroot
-- created using debootstrap.
--
-- Properties can be added to configure the Container. At a minimum,
-- add a property such as `osDebian` to specify the operating system
-- to bootstrap.
--
-- > debContainer "webserver" $ props
-- >    & osDebian Unstable X86_64
-- >    & Apt.installedRunning "apache2"
-- >    & ...
debContainer :: MachineName -> Props metatypes -> Container
debContainer :: String -> Props metatypes -> Container
debContainer String
name Props metatypes
ps = String -> (String -> Chroot) -> Container
container String
name ((String -> Chroot) -> Container)
-> (String -> Chroot) -> Container
forall a b. (a -> b) -> a -> b
$ \String
d -> DebootstrapConfig -> String -> Props metatypes -> Chroot
forall metatypes.
DebootstrapConfig -> String -> Props metatypes -> Chroot
Chroot.debootstrapped DebootstrapConfig
forall a. Monoid a => a
mempty String
d Props metatypes
ps

-- | Runs a container using systemd-nspawn.
--
-- A systemd unit is set up for the container, so it will automatically
-- be started on boot.
--
-- Systemd is automatically installed inside the container, and will
-- communicate with the host's systemd. This allows systemctl to be used to
-- examine the status of services running inside the container.
--
-- When the host system has persistentJournal enabled, journactl can be
-- used to examine logs forwarded from the container.
--
-- Reverting this property stops the container, removes the systemd unit,
-- and deletes the chroot and all its contents.
nspawned :: Container -> RevertableProperty (HasInfo + Linux) Linux
nspawned :: Container -> RevertableProperty (HasInfo + Linux) Linux
nspawned c :: Container
c@(Container String
name (Chroot.Chroot String
loc b
builder InfoPropagator
_ Host
_) Host
h) =
	RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
  Linux
RevertableProperty (HasInfo + Linux) Linux
p RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
  Linux
-> String
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
     Linux
forall p. IsProp p => p -> String -> p
`describe` (String
"nspawned " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name)
  where
	p :: RevertableProperty (HasInfo + Linux) Linux
	p :: RevertableProperty (HasInfo + Linux) Linux
p = Container -> RevertableProperty Linux Linux
enterScript Container
c
		RevertableProperty Linux Linux
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
     Linux
-> CombinedType
     (RevertableProperty Linux Linux)
     (RevertableProperty
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux])
        Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
  Linux
RevertableProperty (HasInfo + Linux) Linux
chrootprovisioned
		RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
  Linux
-> RevertableProperty Linux Linux
-> CombinedType
     (RevertableProperty
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux])
        Linux)
     (RevertableProperty Linux Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Container -> ChrootCfg -> RevertableProperty Linux Linux
nspawnService Container
c (ChrootInfo -> ChrootCfg
_chrootCfg (ChrootInfo -> ChrootCfg) -> ChrootInfo -> ChrootCfg
forall a b. (a -> b) -> a -> b
$ Info -> ChrootInfo
forall v. IsInfo v => Info -> v
fromInfo (Info -> ChrootInfo) -> Info -> ChrootInfo
forall a b. (a -> b) -> a -> b
$ Host -> Info
hostInfo Host
h)
		RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
  Linux
-> RevertableProperty Linux Linux
-> CombinedType
     (RevertableProperty
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux])
        Linux)
     (RevertableProperty Linux Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` RevertableProperty Linux Linux
containerprovisioned

	-- Chroot provisioning is run in systemd-only mode,
	-- which sets up the chroot and ensures systemd and dbus are
	-- installed, but does not handle the other properties.
	chrootprovisioned :: RevertableProperty (HasInfo + Linux) Linux
chrootprovisioned = Chroot
-> Bool
-> [ContainerCapability]
-> RevertableProperty (HasInfo + Linux) Linux
Chroot.provisioned' Chroot
chroot Bool
True [ContainerCapability
FilesystemContained]

	-- Use nsenter to enter container and and run propellor to
	-- finish provisioning.
	containerprovisioned :: RevertableProperty Linux Linux
	containerprovisioned :: RevertableProperty Linux Linux
containerprovisioned =
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Chroot
-> ([String] -> IO (CreateProcess, IO ()))
-> Bool
-> [ContainerCapability]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
Chroot.propellChroot Chroot
chroot (Container -> [String] -> IO (CreateProcess, IO ())
enterContainerProcess Container
c) Bool
False [ContainerCapability]
containercaps)
			Property Linux -> Property Linux -> RevertableProperty Linux Linux
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
		Property Linux
forall k (t :: k). SingI t => Property (MetaTypes t)
doNothing

	containercaps :: [ContainerCapability]
containercaps = 
		[ ContainerCapability
FilesystemContained
		, ContainerCapability
HostnameContained
		]

	chroot :: Chroot
chroot = String -> b -> InfoPropagator -> Host -> Chroot
forall b.
ChrootBootstrapper b =>
String -> b -> InfoPropagator -> Host -> Chroot
Chroot.Chroot String
loc b
builder InfoPropagator
Chroot.propagateChrootInfo Host
h

-- | Sets up the service files for the container, using the
-- systemd-nspawn@.service template, and starts it running.
nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
nspawnService (Container String
name Chroot
_ Host
_) ChrootCfg
cfg = Property Linux
setup Property Linux -> Property Linux -> RevertableProperty Linux Linux
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property Linux
teardown
  where
	service :: String
service = ShowS
nspawnServiceName String
name
	overridedir :: String
overridedir = String
"/etc/systemd/system" String -> ShowS
</> ShowS
nspawnServiceName String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".d"
	overridefile :: String
overridefile = String
overridedir String -> ShowS
</> String
"local.conf"
	overridecontent :: [String]
overridecontent = 
		[ String
"[Service]"
		, String
"# Reset ExecStart from the template"
		, String
"ExecStart="
		, String
"ExecStart=/usr/bin/systemd-nspawn " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
nspawnparams
		]
	nspawnparams :: [String]
nspawnparams = 
		[ String
"--quiet"
		, String
"--keep-unit"
		, String
"--boot"
		, String
"--directory=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
containerDir String
name
		, String
"--machine=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
		] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ChrootCfg -> [String]
nspawnServiceParams ChrootCfg
cfg

	overrideconfigured :: CombinedType
  (Property Linux)
  (Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
overrideconfigured = String
-> [String]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.hasContent String
overridefile [String]
overridecontent
		Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
-> CombinedType
     (Property
        (MetaTypes
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property Linux
daemonReloaded
		Property Linux
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property Linux)
     (Property
        (MetaTypes
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.dirExists String
overridedir

	setup :: Property Linux
	setup :: Property Linux
setup = String -> Property Linux
started String
service
		Property Linux
-> Property Linux -> CombinedType (Property Linux) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> Property Linux
enabled String
service
		Property Linux
-> Property Linux -> CombinedType (Property Linux) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` CombinedType
  (Property Linux)
  (Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
Property Linux
overrideconfigured
		Property Linux
-> Property Linux -> CombinedType (Property Linux) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property Linux
machined

	teardown :: Property Linux
	teardown :: Property Linux
teardown = String -> Property Linux
stopped String
service
		Property Linux
-> Property Linux -> CombinedType (Property Linux) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` String -> Property Linux
disabled String
service
		Property Linux
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property Linux)
     (Property
        (MetaTypes
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`before` String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent String
overridefile

nspawnServiceParams :: ChrootCfg -> [String]
nspawnServiceParams :: ChrootCfg -> [String]
nspawnServiceParams ChrootCfg
NoChrootCfg = []
nspawnServiceParams (SystemdNspawnCfg [(String, Bool)]
ps) =
	Map String Bool -> [String]
forall k a. Map k a -> [k]
M.keys (Map String Bool -> [String]) -> Map String Bool -> [String]
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> Map String Bool -> Map String Bool
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Bool -> Bool
forall a. a -> a
id (Map String Bool -> Map String Bool)
-> Map String Bool -> Map String Bool
forall a b. (a -> b) -> a -> b
$ [(String, Bool)] -> Map String Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, Bool)]
ps

-- | Installs a "enter-machinename" script that root can use to run a
-- command inside the container.
--
-- This uses nsenter to enter the container, by looking up the pid of the
-- container's init process and using its namespace.
enterScript :: Container -> RevertableProperty Linux Linux
enterScript :: Container -> RevertableProperty Linux Linux
enterScript c :: Container
c@(Container String
name Chroot
_ Host
_) =
	Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup Property Linux -> Property Linux -> RevertableProperty Linux Linux
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property Linux
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
teardown
  where
	setup :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setup = String
-> Props
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (String
"generated " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Container -> String
enterScriptFile Container
c) (Props
   (MetaTypes
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Props
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
		Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
scriptfile String
-> [String]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.hasContent`
			[ String
"#!/usr/bin/perl"
			, String
"# Generated by propellor"
			, String
"my $pid=`machinectl show " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
shellEscape String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -p Leader | cut -d= -f2`;"
			, String
"chomp $pid;"
			, String
"if (length $pid) {"
			, String
"\tforeach my $var (keys %ENV) {"
			, String
"\t\tdelete $ENV{$var} unless $var eq 'PATH' || $var eq 'TERM';"
			, String
"\t}"
			, String
"\texec('nsenter', '-p', '-u', '-n', '-i', '-m', '-t', $pid, @ARGV);"
			, String
"} else {"
			, String
"\tdie 'container not running';"
			, String
"}"
			, String
"exit(1);"
			]
		Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
scriptfile String
-> FileMode
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes [FileMode] -> [FileMode] -> [FileMode]
forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes)
	teardown :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
teardown = String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent String
scriptfile
	scriptfile :: String
scriptfile = Container -> String
enterScriptFile Container
c

enterScriptFile :: Container -> FilePath
enterScriptFile :: Container -> String
enterScriptFile (Container String
name Chroot
_ Host
_ ) = String
"/usr/local/bin/enter-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
mungename String
name

enterContainerProcess :: Container -> [String] -> IO (CreateProcess, IO ())
enterContainerProcess :: Container -> [String] -> IO (CreateProcess, IO ())
enterContainerProcess Container
c [String]
ps = (CreateProcess, IO ()) -> IO (CreateProcess, IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String] -> CreateProcess
proc (Container -> String
enterScriptFile Container
c) [String]
ps, IO ()
forall (m :: * -> *). Monad m => m ()
noop)

nspawnServiceName :: MachineName -> ServiceName
nspawnServiceName :: ShowS
nspawnServiceName String
name = String
"systemd-nspawn@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".service"

containerDir :: MachineName -> FilePath
containerDir :: ShowS
containerDir String
name = String
"/var/lib/container" String -> ShowS
</> ShowS
mungename String
name

mungename :: MachineName -> String
mungename :: ShowS
mungename = String -> String -> ShowS
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"/" String
"_"

-- | This configures how systemd-nspawn(1) starts the container,
-- by specifying a parameter, such as "--private-network", or
-- "--link-journal=guest"
--
-- When there is no leading dash, "--" is prepended to the parameter.
--
-- Reverting the property will remove a parameter, if it's present.
containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg String
p = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
RevertableProperty (Bool -> Property (HasInfo + Linux)
mk Bool
True) (Bool -> Property (HasInfo + Linux)
mk Bool
False)
  where
	mk :: Bool -> Property (HasInfo + Linux)
	mk :: Bool -> Property (HasInfo + Linux)
mk Bool
b = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux]))
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux])
forall a b. (a -> b) -> a -> b
$
		String
-> ChrootInfo
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall v.
IsInfo v =>
String
-> v
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
pureInfoProperty String
desc (ChrootInfo
 -> Property
      (HasInfo
       + MetaTypes
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> ChrootInfo
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
			ChrootInfo
forall a. Monoid a => a
mempty { _chrootCfg :: ChrootCfg
_chrootCfg = [(String, Bool)] -> ChrootCfg
SystemdNspawnCfg [(String
p', Bool
b)] }
	  where
		desc :: String
desc = String
"container configuration " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
b then String
"" else String
"without ") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p'
	p' :: String
p' = case String
p of
		(Char
'-':String
_) -> String
p
		String
_ -> String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p

-- | Bind mounts </etc/resolv.conf> from the host into the container.
--
-- This property is enabled by default. Revert it to disable it.
resolvConfed :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
resolvConfed :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
resolvConfed = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg String
"bind=/etc/resolv.conf"

-- | Link the container's journal to the host's if possible.
-- (Only works if the host has persistent journal enabled.)
--
-- This property is enabled by default. Revert it to disable it.
linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
linkJournal = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg String
"link-journal=try-guest"

-- | Disconnect networking of the container from the host.
privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
privateNetwork = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg String
"private-network"

class Publishable a where
	toPublish :: a -> String

instance Publishable Port where
	toPublish :: Port -> String
toPublish Port
port = Port -> String
forall t. ConfigurableValue t => t -> String
val Port
port

instance Publishable (Bound Port) where
	toPublish :: Bound Port -> String
toPublish Bound Port
v = Port -> String
forall a. Publishable a => a -> String
toPublish (Bound Port -> Port
forall v. Bound v -> v
hostSide Bound Port
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Port -> String
forall a. Publishable a => a -> String
toPublish (Bound Port -> Port
forall v. Bound v -> v
containerSide Bound Port
v)

data Proto = TCP | UDP

instance Publishable (Proto, Bound Port) where
	toPublish :: (Proto, Bound Port) -> String
toPublish (Proto
TCP, Bound Port
fp) = String
"tcp:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bound Port -> String
forall a. Publishable a => a -> String
toPublish Bound Port
fp
	toPublish (Proto
UDP, Bound Port
fp) = String
"udp:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bound Port -> String
forall a. Publishable a => a -> String
toPublish Bound Port
fp

-- | Publish a port from the container to the host.
--
-- This feature was first added in systemd version 220.
--
-- This property is only needed (and will only work) if the container
-- is configured to use private networking. Also, networkd should be enabled
-- both inside the container, and on the host. For example:
--
-- > foo :: Host
-- > foo = host "foo.example.com"
-- >	& Systemd.nspawned webserver
-- > 		`requires` Systemd.running Systemd.networkd
-- >
-- > webserver :: Systemd.container
-- > webserver = Systemd.container "webserver" (Chroot.debootstrapped mempty)
-- >	& os (System (Debian Testing) X86_64)
-- >	& Systemd.privateNetwork
-- >	& Systemd.running Systemd.networkd
-- >	& Systemd.publish (Port 80 ->- Port 8080)
-- >	& Apt.installedRunning "apache2"
publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
publish :: p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
publish p
p = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg (String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux))
-> String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
forall a b. (a -> b) -> a -> b
$ String
"--port=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Publishable a => a -> String
toPublish p
p

class Bindable a where
	toBind :: a -> String

instance Bindable FilePath where
	toBind :: ShowS
toBind String
f = String
f

instance Bindable (Bound FilePath) where
	toBind :: Bound String -> String
toBind Bound String
v = Bound String -> String
forall v. Bound v -> v
hostSide Bound String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bound String -> String
forall v. Bound v -> v
containerSide Bound String
v

-- | Bind mount a file or directory from the host into the container.
bind :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bind :: p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bind p
p = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg (String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux))
-> String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
forall a b. (a -> b) -> a -> b
$ String
"--bind=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Bindable a => a -> String
toBind p
p

-- | Read-only mind mount.
bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bindRo :: p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bindRo p
p = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg (String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux))
-> String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
forall a b. (a -> b) -> a -> b
$ String
"--bind-ro=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Bindable a => a -> String
toBind p
p

-- | Escapes a path for inclusion in a systemd unit name,
-- the same as systemd-escape does.
escapePath :: FilePath -> String
escapePath :: ShowS
escapePath = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escape 
	ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
	ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse
  where
	escape :: Char -> String
escape Char
'/' = String
"-"
	escape Char
c
		| ((Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c) Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') = [Char
c]
		| Bool
otherwise = Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'x' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%x" Char
c