{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-}
module Propellor.Property.Chroot (
debootstrapped,
bootstrapped,
provisioned,
hostChroot,
Chroot(..),
ChrootBootstrapper(..),
Debootstrapped(..),
ChrootTarball(..),
exposeTrueLocaldir,
useHostProxy,
provisioned',
propagateChrootInfo,
propellChroot,
chain,
chrootSystem,
) where
import Propellor.Base
import Propellor.Container
import Propellor.Types.CmdLine
import Propellor.Types.Chroot
import Propellor.Types.Container
import Propellor.Types.Info
import Propellor.Types.Core
import Propellor.Property.Chroot.Util
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.Systemd.Core as Systemd
import qualified Propellor.Property.File as File
import qualified Propellor.Shim as Shim
import Propellor.Property.Mount
import Utility.Split
import qualified Data.Map as M
import System.Posix.Directory
data Chroot where
Chroot :: ChrootBootstrapper b => FilePath -> b -> InfoPropagator -> Host -> Chroot
instance IsContainer Chroot where
containerProperties :: Chroot -> [ChildProperty]
containerProperties (Chroot FilePath
_ b
_ InfoPropagator
_ Host
h) = forall c. IsContainer c => c -> [ChildProperty]
containerProperties Host
h
containerInfo :: Chroot -> Info
containerInfo (Chroot FilePath
_ b
_ InfoPropagator
_ Host
h) = forall c. IsContainer c => c -> Info
containerInfo Host
h
setContainerProperties :: Chroot -> [ChildProperty] -> Chroot
setContainerProperties (Chroot FilePath
loc b
b InfoPropagator
p Host
h) [ChildProperty]
ps =
let h' :: Host
h' = forall c. IsContainer c => c -> [ChildProperty] -> c
setContainerProperties Host
h [ChildProperty]
ps
in forall b.
ChrootBootstrapper b =>
FilePath -> b -> InfoPropagator -> Host -> Chroot
Chroot FilePath
loc b
b InfoPropagator
p Host
h'
chrootSystem :: Chroot -> Maybe System
chrootSystem :: Chroot -> Maybe System
chrootSystem = forall v. InfoVal v -> Maybe v
fromInfoVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. IsInfo v => Info -> v
fromInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. IsContainer c => c -> Info
containerInfo
instance Show Chroot where
show :: Chroot -> FilePath
show c :: Chroot
c@(Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) = FilePath
"Chroot " forall a. [a] -> [a] -> [a]
++ FilePath
loc forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (Chroot -> Maybe System
chrootSystem Chroot
c)
class ChrootBootstrapper b where
buildchroot
:: b
-> Info
-> FilePath
-> Either String (Property Linux)
data ChrootTarball = ChrootTarball FilePath
instance ChrootBootstrapper ChrootTarball where
buildchroot :: ChrootTarball
-> Info -> FilePath -> Either FilePath (Property Linux)
buildchroot (ChrootTarball FilePath
tb) Info
_ FilePath
loc = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> 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
$ FilePath -> FilePath -> Property UnixLike
extractTarball FilePath
loc FilePath
tb
extractTarball :: FilePath -> FilePath -> Property UnixLike
FilePath
target FilePath
src = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (FilePath -> IO Bool
isUnpopulated FilePath
target) forall a b. (a -> b) -> a -> b
$
FilePath -> [FilePath] -> UncheckedProperty UnixLike
cmdProperty FilePath
"tar" [FilePath]
params
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` FilePath -> Property UnixLike
File.dirExists FilePath
target
where
params :: [FilePath]
params =
[ FilePath
"-C"
, FilePath
target
, FilePath
"-xf"
, FilePath
src
]
data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig
instance ChrootBootstrapper Debootstrapped where
buildchroot :: Debootstrapped
-> Info -> FilePath -> Either FilePath (Property Linux)
buildchroot (Debootstrapped DebootstrapConfig
cf) Info
info FilePath
loc = case Maybe System
system of
(Just s :: System
s@(System (Debian DebianKernel
_ DebianSuite
_) Architecture
_)) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ System -> Property Linux
debootstrap System
s
(Just s :: System
s@(System (Buntish FilePath
_) Architecture
_)) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ System -> Property Linux
debootstrap System
s
(Just (System Distribution
ArchLinux Architecture
_)) -> forall a b. a -> Either a b
Left FilePath
"Arch Linux not supported by debootstrap."
(Just (System (FreeBSD FreeBSDRelease
_) Architecture
_)) -> forall a b. a -> Either a b
Left FilePath
"FreeBSD not supported by debootstrap."
Maybe System
Nothing -> forall a b. a -> Either a b
Left FilePath
"Cannot debootstrap; OS not specified"
where
debootstrap :: System -> Property Linux
debootstrap System
s = FilePath -> System -> DebootstrapConfig -> Property Linux
Debootstrap.built FilePath
loc System
s
(DebootstrapConfig
cf forall a. Semigroup a => a -> a -> a
<> DebootstrapConfig
proxyConf forall a. Semigroup a => a -> a -> a
<> DebootstrapConfig
mirrorConf)
system :: Maybe System
system = forall v. InfoVal v -> Maybe v
fromInfoVal (forall v. IsInfo v => Info -> v
fromInfo Info
info)
proxyConf :: DebootstrapConfig
proxyConf = case (forall v. InfoVal v -> Maybe v
fromInfoVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. IsInfo v => Info -> v
fromInfo) Info
info of
Just (Apt.HostAptProxy FilePath
u) ->
FilePath -> DebootstrapConfig
Debootstrap.DebootstrapProxy FilePath
u
Maybe HostAptProxy
Nothing -> forall a. Monoid a => a
mempty
mirrorConf :: DebootstrapConfig
mirrorConf = case (forall v. InfoVal v -> Maybe v
fromInfoVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. IsInfo v => Info -> v
fromInfo) Info
info of
Just (Apt.HostMirror FilePath
u) ->
FilePath -> DebootstrapConfig
Debootstrap.DebootstrapMirror FilePath
u
Maybe HostMirror
Nothing -> forall a. Monoid a => a
mempty
debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
debootstrapped :: forall metatypes.
DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
debootstrapped DebootstrapConfig
conf = forall b metatypes.
ChrootBootstrapper b =>
b -> FilePath -> Props metatypes -> Chroot
bootstrapped (DebootstrapConfig -> Debootstrapped
Debootstrapped DebootstrapConfig
conf)
bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot
bootstrapped :: forall b metatypes.
ChrootBootstrapper b =>
b -> FilePath -> Props metatypes -> Chroot
bootstrapped b
bootstrapper FilePath
location Props metatypes
ps = Chroot
c
where
c :: Chroot
c = forall b.
ChrootBootstrapper b =>
FilePath -> b -> InfoPropagator -> Host -> Chroot
Chroot FilePath
location b
bootstrapper InfoPropagator
propagateChrootInfo (forall metatypes. FilePath -> Props metatypes -> Host
host FilePath
location Props metatypes
ps)
provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
provisioned Chroot
c = Chroot
-> Bool
-> [ContainerCapability]
-> RevertableProperty (HasInfo + Linux) Linux
provisioned' Chroot
c Bool
False [ContainerCapability
FilesystemContained]
provisioned'
:: Chroot
-> Bool
-> [ContainerCapability]
-> RevertableProperty (HasInfo + Linux) Linux
provisioned' :: Chroot
-> Bool
-> [ContainerCapability]
-> RevertableProperty (HasInfo + Linux) Linux
provisioned' c :: Chroot
c@(Chroot FilePath
loc b
bootstrapper InfoPropagator
infopropigator Host
_) Bool
systemdonly [ContainerCapability]
caps =
(InfoPropagator
infopropigator Chroot
c PropagateInfo -> Bool
normalContainerInfo forall a b. (a -> b) -> a -> b
$ Property Linux
setup forall p. IsProp p => p -> FilePath -> p
`describe` Chroot -> ShowS
chrootDesc Chroot
c FilePath
"exists")
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!>
(Property Linux
teardown forall p. IsProp p => p -> FilePath -> p
`describe` Chroot -> ShowS
chrootDesc Chroot
c FilePath
"removed")
where
setup :: Property Linux
setup :: Property Linux
setup = Chroot
-> ([FilePath] -> IO (CreateProcess, IO ()))
-> Bool
-> [ContainerCapability]
-> Property UnixLike
propellChroot Chroot
c (Bool -> Chroot -> [FilePath] -> IO (CreateProcess, IO ())
inChrootProcess (Bool -> Bool
not Bool
systemdonly) Chroot
c) Bool
systemdonly [ContainerCapability]
caps
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property Linux
built
built :: Property Linux
built = case forall b.
ChrootBootstrapper b =>
b -> Info -> FilePath -> Either FilePath (Property Linux)
buildchroot b
bootstrapper (forall c. IsContainer c => c -> Info
containerInfo Chroot
c) FilePath
loc of
Right Property Linux
p -> Property Linux
p
Left FilePath
e -> FilePath -> Property Linux
cantbuild FilePath
e
cantbuild :: FilePath -> Property Linux
cantbuild FilePath
e = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (Chroot -> ShowS
chrootDesc Chroot
c FilePath
"built") (forall a. HasCallStack => FilePath -> a
error FilePath
e)
teardown :: Property Linux
teardown :: Property Linux
teardown = 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
<$> FilePath -> IO Bool
isUnpopulated FilePath
loc) forall a b. (a -> b) -> a -> b
$
forall {k} (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (FilePath
"removed " forall a. [a] -> [a] -> [a]
++ FilePath
loc) forall a b. (a -> b) -> a -> b
$
IO () -> Propellor Result
makeChange (FilePath -> IO ()
removeChroot FilePath
loc)
type InfoPropagator = Chroot -> (PropagateInfo -> Bool) -> Property Linux -> Property (HasInfo + Linux)
propagateChrootInfo :: InfoPropagator
propagateChrootInfo :: InfoPropagator
propagateChrootInfo c :: Chroot
c@(Chroot FilePath
location b
_ InfoPropagator
_ Host
_) PropagateInfo -> Bool
pinfo Property Linux
p =
forall metatypes c.
(IncludesInfo metatypes ~ 'True, IsContainer c) =>
FilePath
-> c
-> (PropagateInfo -> Bool)
-> Property metatypes
-> Property metatypes
propagateContainer FilePath
location Chroot
c PropagateInfo -> Bool
pinfo forall a b. (a -> b) -> a -> b
$
Property Linux
p forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` Chroot -> Info
chrootInfo Chroot
c
chrootInfo :: Chroot -> Info
chrootInfo :: Chroot -> Info
chrootInfo (Chroot FilePath
loc b
_ InfoPropagator
_ Host
h) = forall a. Monoid a => a
mempty forall v. IsInfo v => Info -> v -> Info
`addInfo`
forall a. Monoid a => a
mempty { _chroots :: Map FilePath Host
_chroots = forall k a. k -> a -> Map k a
M.singleton FilePath
loc Host
h }
propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> [ContainerCapability] -> Property UnixLike
propellChroot :: Chroot
-> ([FilePath] -> IO (CreateProcess, IO ()))
-> Bool
-> [ContainerCapability]
-> Property UnixLike
propellChroot c :: Chroot
c@(Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) [FilePath] -> IO (CreateProcess, IO ())
mkproc Bool
systemdonly [ContainerCapability]
caps = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (Chroot -> ShowS
chrootDesc Chroot
c FilePath
"provisioned") forall a b. (a -> b) -> a -> b
$ do
let d :: FilePath
d = FilePath
localdir FilePath -> ShowS
</> Chroot -> FilePath
shimdir Chroot
c
let me :: FilePath
me = FilePath
localdir FilePath -> ShowS
</> FilePath
"propellor"
FilePath
shim <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath -> IO FilePath
Shim.setup FilePath
me forall a. Maybe a
Nothing FilePath
d
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
bindmount FilePath
shim)
( FilePath -> Propellor Result
chainprovision FilePath
shim
, forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
)
where
bindmount :: FilePath -> IO Bool
bindmount FilePath
shim = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (FilePath -> IO Bool
doesFileExist (FilePath
loc forall a. [a] -> [a] -> [a]
++ FilePath
shim))
( forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
, do
let mntpnt :: FilePath
mntpnt = FilePath
loc forall a. [a] -> [a] -> [a]
++ FilePath
localdir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
mntpnt
FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
"mount"
[ FilePath -> CommandParam
Param FilePath
"--bind"
, FilePath -> CommandParam
File FilePath
localdir, FilePath -> CommandParam
File FilePath
mntpnt
]
)
chainprovision :: FilePath -> Propellor Result
chainprovision FilePath
shim = do
FilePath
parenthost <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> FilePath
hostName
CmdLine
cmd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Chroot -> Bool -> [ContainerCapability] -> IO CmdLine
toChain FilePath
parenthost Chroot
c Bool
systemdonly [ContainerCapability]
caps
[(FilePath, FilePath)]
pe <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(FilePath, FilePath)]
standardPathEnv
(CreateProcess
p, IO ()
cleanup) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO (CreateProcess, IO ())
mkproc
[ FilePath
shim
, FilePath
"--continue"
, forall a. Show a => a -> FilePath
show CmdLine
cmd
]
Result
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> IO Result
chainPropellor (CreateProcess
p { env :: Maybe [(FilePath, FilePath)]
env = forall a. a -> Maybe a
Just [(FilePath, FilePath)]
pe })
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
cleanup
forall (m :: * -> *) a. Monad m => a -> m a
return Result
r
toChain :: HostName -> Chroot -> Bool -> [ContainerCapability] -> IO CmdLine
toChain :: FilePath -> Chroot -> Bool -> [ContainerCapability] -> IO CmdLine
toChain FilePath
parenthost (Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) Bool
systemdonly [ContainerCapability]
caps = do
Bool
onconsole <- MessageHandle -> Bool
isConsole forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO MessageHandle
getMessageHandle
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> Bool -> Bool -> [ContainerCapability] -> CmdLine
ChrootChain FilePath
parenthost FilePath
loc Bool
systemdonly Bool
onconsole [ContainerCapability]
caps
chain :: [Host] -> CmdLine -> IO ()
chain :: [Host] -> CmdLine -> IO ()
chain [Host]
hostlist (ChrootChain FilePath
hn FilePath
loc Bool
systemdonly Bool
onconsole [ContainerCapability]
caps) =
case [Host] -> FilePath -> Maybe Host
findHostNoAlias [Host]
hostlist FilePath
hn of
Maybe Host
Nothing -> forall (m :: * -> *) a. MonadIO m => FilePath -> m a
errorMessage (FilePath
"cannot find host " forall a. [a] -> [a] -> [a]
++ FilePath
hn)
Just Host
parenthost -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
loc (ChrootInfo -> Map FilePath Host
_chroots 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
parenthost) of
Maybe Host
Nothing -> forall (m :: * -> *) a. MonadIO m => FilePath -> m a
errorMessage (FilePath
"cannot find chroot " forall a. [a] -> [a] -> [a]
++ FilePath
loc forall a. [a] -> [a] -> [a]
++ FilePath
" on host " forall a. [a] -> [a] -> [a]
++ FilePath
hn)
Just Host
h -> Host -> IO ()
go Host
h
where
go :: Host -> IO ()
go Host
h = do
FilePath -> IO ()
changeWorkingDirectory FilePath
localdir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
onconsole IO ()
forceConsole
forall a. FilePath -> IO a -> IO a
onlyProcess (ShowS
provisioningLock FilePath
loc) forall a b. (a -> b) -> a -> b
$
Host -> Propellor Result -> IO ()
runChainPropellor (Host -> Host
setcaps Host
h) forall a b. (a -> b) -> a -> b
$
[ChildProperty] -> Propellor Result
ensureChildProperties forall a b. (a -> b) -> a -> b
$
if Bool
systemdonly
then [forall p. IsProp p => p -> ChildProperty
toChildProperty Property DebianLike
Systemd.installed]
else Host -> [ChildProperty]
hostProperties Host
h
setcaps :: Host -> Host
setcaps Host
h = Host
h { hostInfo :: Info
hostInfo = Host -> Info
hostInfo Host
h forall v. IsInfo v => Info -> v -> Info
`addInfo` [ContainerCapability]
caps }
chain [Host]
_ CmdLine
_ = forall (m :: * -> *) a. MonadIO m => FilePath -> m a
errorMessage FilePath
"bad chain command"
inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
inChrootProcess :: Bool -> Chroot -> [FilePath] -> IO (CreateProcess, IO ())
inChrootProcess Bool
keepprocmounted (Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) [FilePath]
cmd = do
IO ()
mountproc
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath] -> CreateProcess
proc FilePath
"chroot" (FilePath
locforall a. a -> [a] -> [a]
:[FilePath]
cmd), IO ()
cleanup)
where
mountproc :: IO ()
mountproc = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
procloc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
mountPointsBelow FilePath
loc) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> MountOpts -> IO Bool
mount FilePath
"proc" FilePath
"proc" FilePath
procloc forall a. Monoid a => a
mempty
procloc :: FilePath
procloc = FilePath
loc FilePath -> ShowS
</> FilePath
"proc"
cleanup :: IO ()
cleanup
| Bool
keepprocmounted = forall (m :: * -> *). Monad m => m ()
noop
| Bool
otherwise = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
whenM (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
procloc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
mountPointsBelow FilePath
loc) forall a b. (a -> b) -> a -> b
$
FilePath -> IO ()
umountLazy FilePath
procloc
provisioningLock :: FilePath -> FilePath
provisioningLock :: ShowS
provisioningLock FilePath
containerloc = FilePath
"chroot" FilePath -> ShowS
</> ShowS
mungeloc FilePath
containerloc forall a. [a] -> [a] -> [a]
++ FilePath
".lock"
shimdir :: Chroot -> FilePath
shimdir :: Chroot -> FilePath
shimdir (Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) = FilePath
"chroot" FilePath -> ShowS
</> ShowS
mungeloc FilePath
loc forall a. [a] -> [a] -> [a]
++ FilePath
".shim"
mungeloc :: FilePath -> String
mungeloc :: ShowS
mungeloc = forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace FilePath
"/" FilePath
"_"
chrootDesc :: Chroot -> String -> String
chrootDesc :: Chroot -> ShowS
chrootDesc (Chroot FilePath
loc b
_ InfoPropagator
_ Host
_) FilePath
desc = FilePath
"chroot " forall a. [a] -> [a] -> [a]
++ FilePath
loc forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ FilePath
desc
exposeTrueLocaldir :: (FilePath -> Propellor a) -> Propellor a
exposeTrueLocaldir :: forall a. (FilePath -> Propellor a) -> Propellor a
exposeTrueLocaldir FilePath -> Propellor a
a = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (ContainerCapability -> Propellor Bool
hasContainerCapability ContainerCapability
FilesystemContained)
( forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTmpDirIn (ShowS
takeDirectory FilePath
localdir) FilePath
"propellor.tmp" forall a b. (a -> b) -> a -> b
$ \FilePath
tmpdir ->
forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_
(forall {m :: * -> *}. MonadIO m => FilePath -> FilePath -> m ()
movebindmount FilePath
localdir FilePath
tmpdir)
(forall {m :: * -> *}. MonadIO m => FilePath -> FilePath -> m ()
movebindmount FilePath
tmpdir FilePath
localdir)
(FilePath -> Propellor a
a FilePath
tmpdir)
, FilePath -> Propellor a
a FilePath
localdir
)
where
movebindmount :: FilePath -> FilePath -> m ()
movebindmount FilePath
from FilePath
to = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
FilePath -> [CommandParam] -> IO ()
run FilePath
"mount" [FilePath -> CommandParam
Param FilePath
"--bind", FilePath -> CommandParam
File FilePath
from, FilePath -> CommandParam
File FilePath
to]
FilePath -> [CommandParam] -> IO ()
run FilePath
"umount" [FilePath -> CommandParam
Param FilePath
"-l", FilePath -> CommandParam
File FilePath
from]
FilePath -> IO ()
changeWorkingDirectory FilePath
"/"
FilePath -> IO ()
changeWorkingDirectory FilePath
localdir
run :: FilePath -> [CommandParam] -> IO ()
run FilePath
cmd [CommandParam]
ps = forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
cmd [CommandParam]
ps) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"exposeTrueLocaldir failed to run " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (FilePath
cmd, [CommandParam]
ps)
hostChroot :: ChrootBootstrapper bootstrapper => Host -> bootstrapper -> FilePath -> Chroot
hostChroot :: forall bootstrapper.
ChrootBootstrapper bootstrapper =>
Host -> bootstrapper -> FilePath -> Chroot
hostChroot Host
h bootstrapper
bootstrapper FilePath
d = Chroot
chroot
where
chroot :: Chroot
chroot = forall b.
ChrootBootstrapper b =>
FilePath -> b -> InfoPropagator -> Host -> Chroot
Chroot FilePath
d bootstrapper
bootstrapper InfoPropagator
pinfo Host
h
pinfo :: InfoPropagator
pinfo = Host -> InfoPropagator
propagateHostChrootInfo Host
h
propagateHostChrootInfo :: Host -> InfoPropagator
propagateHostChrootInfo :: Host -> InfoPropagator
propagateHostChrootInfo Host
h Chroot
c PropagateInfo -> Bool
pinfo Property Linux
p =
forall metatypes c.
(IncludesInfo metatypes ~ 'True, IsContainer c) =>
FilePath
-> c
-> (PropagateInfo -> Bool)
-> Property metatypes
-> Property metatypes
propagateContainer (Host -> FilePath
hostName Host
h) Chroot
c PropagateInfo -> Bool
pinfo forall a b. (a -> b) -> a -> b
$
Property Linux
p forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` Chroot -> Info
chrootInfo Chroot
c
useHostProxy :: Host -> Property DebianLike
useHostProxy :: Host -> Property DebianLike
useHostProxy Host
h = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' FilePath
"use host's apt proxy" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w ->
case Host -> Maybe HostAptProxy
getProxyInfo Host
h of
Just (Apt.HostAptProxy FilePath
u) -> forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (FilePath -> Property DebianLike
Apt.proxy' FilePath
u)
Maybe HostAptProxy
Nothing -> Propellor Result
noChange
where
getProxyInfo :: Host -> Maybe HostAptProxy
getProxyInfo = forall v. InfoVal v -> Maybe v
fromInfoVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. IsInfo v => Info -> v
fromInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo