{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
module Propellor.Property.Systemd (
ServiceName,
started,
stopped,
enabled,
disabled,
masked,
running,
restarted,
networkd,
journald,
logind,
escapePath,
installed,
Option,
configured,
daemonReloaded,
persistentJournal,
journaldConfigured,
logindConfigured,
killUserProcesses,
machined,
MachineName,
Container,
container,
debContainer,
nspawned,
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
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) = forall c. IsContainer c => c -> [ChildProperty]
containerProperties Host
h
containerInfo :: Container -> Info
containerInfo (Container String
_ Chroot
_ Host
h) = 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 (forall c. IsContainer c => c -> [ChildProperty] -> c
setContainerProperties Host
h [ChildProperty]
ps)
started :: ServiceName -> Property Linux
started :: String -> Property Linux
started String
n = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"systemctl" [String
"start", String
n]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
forall p. IsProp p => p -> String -> p
`describe` (String
"service " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" started")
stopped :: ServiceName -> Property Linux
stopped :: String -> Property Linux
stopped String
n = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"systemctl" [String
"stop", String
n]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
forall p. IsProp p => p -> String -> p
`describe` (String
"service " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" stopped")
enabled :: ServiceName -> Property Linux
enabled :: String -> Property Linux
enabled String
n = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"systemctl" [String
"enable", String
n]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
forall p. IsProp p => p -> String -> p
`describe` (String
"service " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" enabled")
disabled :: ServiceName -> Property Linux
disabled :: String -> Property Linux
disabled String
n = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"systemctl" [String
"disable", String
n]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
forall p. IsProp p => p -> String -> p
`describe` (String
"service " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" disabled")
masked :: ServiceName -> RevertableProperty Linux Linux
masked :: String -> RevertableProperty Linux Linux
masked String
n = Property Linux
systemdMask forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property Linux
systemdUnmask
where
systemdMask :: Property Linux
systemdMask = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"systemctl" [String
"mask", String
n]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
forall p. IsProp p => p -> String -> p
`describe` (String
"service " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" masked")
systemdUnmask :: Property Linux
systemdUnmask = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"systemctl" [String
"unmask", String
n]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
forall p. IsProp p => p -> String -> p
`describe` (String
"service " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" unmasked")
running :: ServiceName -> Property Linux
running :: String -> Property Linux
running String
n = String -> Property Linux
started String
n forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> Property Linux
enabled String
n
restarted :: ServiceName -> Property Linux
restarted :: String -> Property Linux
restarted String
n = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"systemctl" [String
"restart", String
n]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
forall p. IsProp p => p -> String -> p
`describe` (String
"service " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" restarted")
networkd :: ServiceName
networkd :: String
networkd = String
"systemd-networkd"
journald :: ServiceName
journald :: String
journald = String
"systemd-journald"
logind :: ServiceName
logind :: String
logind = String
"systemd-logind"
persistentJournal :: Property DebianLike
persistentJournal :: Property DebianLike
persistentJournal = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesDirectoryExist String
dir) forall a b. (a -> b) -> a -> b
$
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
"persistent systemd journal" forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
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 UnixLike
cmdProperty String
"install" [String
"-d", String
"-g", String
"systemd-journal", String
dir]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
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"]
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 UnixLike
cmdProperty String
"setfacl" [String
"-R", String
"-nm", String
"g:adm:rx,d:g:adm:rx", String
dir]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
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
configured :: FilePath -> Option -> String -> Property Linux
configured :: String -> String -> String -> Property Linux
configured String
cfgfile String
option String
value = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
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))
& forall c.
(FileContent c, Eq c) =>
String -> (c -> c) -> String -> Property UnixLike
File.fileProperty String
desc (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
removeother) String
cfgfile
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 UnixLike
File.containsLine String
cfgfile String
line
where
setting :: String
setting = String
option forall a. [a] -> [a] -> [a]
++ String
"="
line :: String
line = String
setting forall a. [a] -> [a] -> [a]
++ String
value
desc :: String
desc = String
cfgfile forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
line
removeother :: String -> Maybe String
removeother String
l
| String
setting forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l Bool -> Bool -> Bool
&& String
l forall a. Eq a => a -> a -> Bool
/= String
line = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just String
l
daemonReloaded :: Property Linux
daemonReloaded :: Property Linux
daemonReloaded = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"systemctl" [String
"daemon-reload"]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
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
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` String -> Property Linux
restarted String
journald
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
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` String -> Property Linux
restarted String
logind
killUserProcesses :: RevertableProperty Linux Linux
killUserProcesses :: RevertableProperty Linux Linux
killUserProcesses = String -> Property Linux
set String
"yes" 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"
machined :: Property Linux
machined :: Property Linux
machined = Property DebianLike
installeddebian 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 = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS String
"machined installed" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Maybe System
o ->
case Maybe System
o of
(Just (System (Debian DebianKernel
_ DebianSuite
suite) Architecture
_))
| Bool -> Bool
not (DebianSuite -> Bool
isStable DebianSuite
suite) Bool -> Bool -> Bool
|| DebianSuite
suite forall a. Eq a => a -> a -> Bool
/= (String -> DebianSuite
Stable String
"jessie") ->
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w 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 = forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing
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 forall c metatypes. IsContainer c => c -> Props metatypes -> c
setContainerProps Container
c forall a b. (a -> b) -> a -> b
$ forall c. IsContainer c => c -> Props UnixLike
containerProps Container
c
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 (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 (forall c. IsContainer c => c -> [ChildProperty]
containerProperties Chroot
chroot) (forall c. IsContainer c => c -> Info
containerInfo Chroot
chroot)
debContainer :: MachineName -> Props metatypes -> Container
debContainer :: forall metatypes. String -> Props metatypes -> Container
debContainer String
name Props metatypes
ps = String -> (String -> Chroot) -> Container
container String
name forall a b. (a -> b) -> a -> b
$ \String
d -> forall metatypes.
DebootstrapConfig -> String -> Props metatypes -> Chroot
Chroot.debootstrapped forall a. Monoid a => a
mempty String
d Props metatypes
ps
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 (HasInfo + Linux) Linux
p forall p. IsProp p => p -> String -> p
`describe` (String
"nspawned " 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
forall x y. Combines x y => x -> y -> CombinedType x y
`before` RevertableProperty (HasInfo + Linux) Linux
chrootprovisioned
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Container -> ChrootCfg -> RevertableProperty Linux Linux
nspawnService Container
c (ChrootInfo -> ChrootCfg
_chrootCfg forall a b. (a -> b) -> a -> b
$ forall v. IsInfo v => Info -> v
fromInfo forall a b. (a -> b) -> a -> b
$ Host -> Info
hostInfo Host
h)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` RevertableProperty Linux Linux
containerprovisioned
chrootprovisioned :: RevertableProperty (HasInfo + Linux) Linux
chrootprovisioned = Chroot
-> Bool
-> [ContainerCapability]
-> RevertableProperty (HasInfo + Linux) Linux
Chroot.provisioned' Chroot
chroot Bool
True [ContainerCapability
FilesystemContained]
containerprovisioned :: RevertableProperty Linux Linux
containerprovisioned :: RevertableProperty Linux Linux
containerprovisioned =
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 UnixLike
Chroot.propellChroot Chroot
chroot (Container -> [String] -> IO (CreateProcess, IO ())
enterContainerProcess Container
c) Bool
False [ContainerCapability]
containercaps)
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing
containercaps :: [ContainerCapability]
containercaps =
[ ContainerCapability
FilesystemContained
, ContainerCapability
HostnameContained
]
chroot :: Chroot
chroot = forall b.
ChrootBootstrapper b =>
String -> b -> InfoPropagator -> Host -> Chroot
Chroot.Chroot String
loc b
builder InfoPropagator
Chroot.propagateChrootInfo Host
h
nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
nspawnService (Container String
name Chroot
_ Host
_) ChrootCfg
cfg = Property Linux
setup 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 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 " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
nspawnparams
]
nspawnparams :: [String]
nspawnparams =
[ String
"--quiet"
, String
"--keep-unit"
, String
"--boot"
, String
"--directory=" forall a. [a] -> [a] -> [a]
++ ShowS
containerDir String
name
, String
"--machine=" forall a. [a] -> [a] -> [a]
++ String
name
] forall a. [a] -> [a] -> [a]
++ ChrootCfg -> [String]
nspawnServiceParams ChrootCfg
cfg
overrideconfigured :: CombinedType (Property Linux) (Property UnixLike)
overrideconfigured = String -> [String] -> Property UnixLike
File.hasContent String
overridefile [String]
overridecontent
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property Linux
daemonReloaded
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> Property UnixLike
File.dirExists String
overridedir
setup :: Property Linux
setup :: Property Linux
setup = String -> Property Linux
started String
service
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> Property Linux
enabled String
service
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` CombinedType (Property Linux) (Property UnixLike)
overrideconfigured
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
forall x y. Combines x y => x -> y -> CombinedType x y
`before` String -> Property Linux
disabled String
service
forall x y. Combines x y => x -> y -> CombinedType x y
`before` String -> Property UnixLike
File.notPresent String
overridefile
nspawnServiceParams :: ChrootCfg -> [String]
nspawnServiceParams :: ChrootCfg -> [String]
nspawnServiceParams ChrootCfg
NoChrootCfg = []
nspawnServiceParams (SystemdNspawnCfg [(String, Bool)]
ps) =
forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, Bool)]
ps
enterScript :: Container -> RevertableProperty Linux Linux
enterScript :: Container -> RevertableProperty Linux Linux
enterScript c :: Container
c@(Container String
name Chroot
_ Host
_) =
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets Property
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets Property UnixLike
teardown
where
setup :: Property
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
setup = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (String
"generated " forall a. [a] -> [a] -> [a]
++ Container -> String
enterScriptFile Container
c) forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
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 UnixLike
`File.hasContent`
[ String
"#!/usr/bin/perl"
, String
"# Generated by propellor"
, String
"my $pid=`machinectl show " forall a. [a] -> [a] -> [a]
++ ShowS
shellEscape String
name 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);"
]
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 UnixLike
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes)
teardown :: Property UnixLike
teardown = String -> Property UnixLike
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-" 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String] -> CreateProcess
proc (Container -> String
enterScriptFile Container
c) [String]
ps, forall (m :: * -> *). Monad m => m ()
noop)
nspawnServiceName :: MachineName -> ServiceName
nspawnServiceName :: ShowS
nspawnServiceName String
name = String
"systemd-nspawn@" forall a. [a] -> [a] -> [a]
++ String
name 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 = forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"/" String
"_"
containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg String
p = 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 = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
forall v. IsInfo v => String -> v -> Property (HasInfo + UnixLike)
pureInfoProperty String
desc forall a b. (a -> b) -> a -> b
$
forall a. Monoid a => a
mempty { _chrootCfg :: ChrootCfg
_chrootCfg = [(String, Bool)] -> ChrootCfg
SystemdNspawnCfg [(String
p', Bool
b)] }
where
desc :: String
desc = String
"container configuration " forall a. [a] -> [a] -> [a]
++ (if Bool
b then String
"" else String
"without ") forall a. [a] -> [a] -> [a]
++ String
p'
p' :: String
p' = case String
p of
(Char
'-':String
_) -> String
p
String
_ -> String
"--" forall a. [a] -> [a] -> [a]
++ String
p
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"
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"
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 = forall t. ConfigurableValue t => t -> String
val Port
port
instance Publishable (Bound Port) where
toPublish :: Bound Port -> String
toPublish Bound Port
v = forall a. Publishable a => a -> String
toPublish (forall v. Bound v -> v
hostSide Bound Port
v) forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Publishable a => a -> String
toPublish (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:" forall a. [a] -> [a] -> [a]
++ forall a. Publishable a => a -> String
toPublish Bound Port
fp
toPublish (Proto
UDP, Bound Port
fp) = String
"udp:" forall a. [a] -> [a] -> [a]
++ forall a. Publishable a => a -> String
toPublish Bound Port
fp
publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
publish :: forall p.
Publishable p =>
p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
publish p
p = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg forall a b. (a -> b) -> a -> b
$ String
"--port=" forall a. [a] -> [a] -> [a]
++ 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 = forall v. Bound v -> v
hostSide Bound String
v forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall v. Bound v -> v
containerSide Bound String
v
bind :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bind :: forall p.
Bindable p =>
p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bind p
p = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg forall a b. (a -> b) -> a -> b
$ String
"--bind=" forall a. [a] -> [a] -> [a]
++ forall a. Bindable a => a -> String
toBind p
p
bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bindRo :: forall p.
Bindable p =>
p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bindRo p
p = String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg forall a b. (a -> b) -> a -> b
$ String
"--bind-ro=" forall a. [a] -> [a] -> [a]
++ forall a. Bindable a => a -> String
toBind p
p
escapePath :: FilePath -> String
escapePath :: ShowS
escapePath = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'/')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
== Char
'_') = [Char
c]
| Bool
otherwise = Char
'\\' forall a. a -> [a] -> [a]
: Char
'x' forall a. a -> [a] -> [a]
: forall r. PrintfType r => String -> r
printf String
"%x" Char
c