diff options
| author | Joey Hess <joeyh@joeyh.name> | 2015-10-23 17:38:48 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-10-23 17:38:48 -0400 |
| commit | 70797918ff2dd1d0588e4a3d2eb2a38381ecd9ed (patch) | |
| tree | b755fba501fcbe013d7c9294fc7ce4b21a2d057a /src/Propellor/Property/Chroot.hs | |
| parent | 42ed4b5e68ec84106850c07904ee6124a7805742 (diff) | |
| parent | 0d08ba360b576fe000a9ce67ce2082267aad9d5c (diff) | |
Merge branch 'joeyconfig'
Diffstat (limited to 'src/Propellor/Property/Chroot.hs')
| -rw-r--r-- | src/Propellor/Property/Chroot.hs | 20 |
1 files changed, 18 insertions, 2 deletions
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index ecac1115..771c4b99 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, GADTs #-} +{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-} module Propellor.Property.Chroot ( debootstrapped, @@ -8,6 +8,7 @@ module Propellor.Property.Chroot ( ChrootBootstrapper(..), Debootstrapped(..), ChrootTarball(..), + inChroot, -- * Internal use provisioned', propagateChrootInfo, @@ -207,7 +208,7 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) = changeWorkingDirectory localdir when onconsole forceConsole onlyProcess (provisioningLock loc) $ do - r <- runPropellor h $ ensureProperties $ + r <- runPropellor (setInChroot h) $ ensureProperties $ if systemdonly then [Systemd.installed] else map ignoreInfo $ @@ -243,3 +244,18 @@ mungeloc = replace "/" "_" chrootDesc :: Chroot -> String -> String chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc + +-- | Check if propellor is currently running within a chroot. +-- +-- This allows properties to check and avoid performing actions that +-- should not be done in a chroot. +inChroot :: Propellor Bool +inChroot = extract . fromMaybe (InChroot False) . fromInfoVal <$> askInfo + where + extract (InChroot b) = b + +setInChroot :: Host -> Host +setInChroot h = h { hostInfo = hostInfo h `addInfo` InfoVal (InChroot True) } + +newtype InChroot = InChroot Bool + deriving (Typeable, Show) |