summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog7
-rw-r--r--doc/todo/Hostname_is_not_set_in_a_systemd_container.mdwn2
-rw-r--r--doc/todo/Hostname_is_not_set_in_a_systemd_container/comment_1_239bf5057bb5a5f632523bf9ba2a71de._comment10
-rw-r--r--src/Propellor/CmdLine.hs2
-rw-r--r--src/Propellor/Info.hs7
-rw-r--r--src/Propellor/Property/Bootstrap.hs5
-rw-r--r--src/Propellor/Property/Chroot.hs43
-rw-r--r--src/Propellor/Property/Docker.hs3
-rw-r--r--src/Propellor/Property/Grub.hs7
-rw-r--r--src/Propellor/Property/Hostname.hs10
-rw-r--r--src/Propellor/Property/Localdir.hs4
-rw-r--r--src/Propellor/Property/Systemd.hs9
-rw-r--r--src/Propellor/Property/Uboot.hs4
-rw-r--r--src/Propellor/Types/CmdLine.hs3
-rw-r--r--src/Propellor/Types/Container.hs19
15 files changed, 89 insertions, 46 deletions
diff --git a/debian/changelog b/debian/changelog
index 988c3641..1d46fb53 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,13 @@
-propellor (5.7.1) UNRELEASED; urgency=medium
+propellor (5.8.0) UNRELEASED; urgency=medium
* Fix bug in File.containsShellSetting that replaced whole shell conffile
content with the setting if the file did not previously contain a line
setting the key to some value.
+ * Removed inChroot, instead use hasContainerCapability FilesystemContained.
+ (API change)
+ * Hostname: Properties that used to not do anything in a systemd or
+ docker container will now change the container's hostname,
+ since it's namespaced.
-- Joey Hess <id@joeyh.name> Mon, 08 Apr 2019 11:09:04 -0400
diff --git a/doc/todo/Hostname_is_not_set_in_a_systemd_container.mdwn b/doc/todo/Hostname_is_not_set_in_a_systemd_container.mdwn
index e88dcac6..6b6db329 100644
--- a/doc/todo/Hostname_is_not_set_in_a_systemd_container.mdwn
+++ b/doc/todo/Hostname_is_not_set_in_a_systemd_container.mdwn
@@ -8,3 +8,5 @@ Note: I use `Systemd.containerCfg "network-bridge=br0"`, so the container has
a different network stack.
I suppose that the `check (not <$> inChroot)` might be the problem here.
+
+> [[fixed|done]]
diff --git a/doc/todo/Hostname_is_not_set_in_a_systemd_container/comment_1_239bf5057bb5a5f632523bf9ba2a71de._comment b/doc/todo/Hostname_is_not_set_in_a_systemd_container/comment_1_239bf5057bb5a5f632523bf9ba2a71de._comment
new file mode 100644
index 00000000..7da0cf12
--- /dev/null
+++ b/doc/todo/Hostname_is_not_set_in_a_systemd_container/comment_1_239bf5057bb5a5f632523bf9ba2a71de._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2019-04-08T15:37:45Z"
+ content="""
+I've fixed this by switching to a more granular data structure for
+describing the capabilities of a container.
+
+Didn't test it, but I think it will work..
+"""]]
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index bd01b34c..31e45da1 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -129,7 +129,7 @@ defaultMain hostlist = withConcurrentOutput $ do
go _ ListFields = listPrivDataFields hostlist
go _ (AddKey keyid) = addKey keyid
go _ (RmKey keyid) = rmKey keyid
- go _ c@(ChrootChain _ _ _ _) = Chroot.chain hostlist c
+ go _ c@(ChrootChain _ _ _ _ _) = Chroot.chain hostlist c
go _ (DockerChain hn cid) = Docker.chain hostlist hn cid
go _ (DockerInit hn) = Docker.init hn
go _ (GitPush fin fout) = gitPushHelper fin fout
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index ba73b449..01a53ad5 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -11,6 +11,7 @@ module Propellor.Info (
pureInfoProperty',
askInfo,
getOS,
+ hasContainerCapability,
ipv4,
ipv6,
alias,
@@ -26,6 +27,7 @@ module Propellor.Info (
import Propellor.Types
import Propellor.Types.Info
import Propellor.Types.MetaTypes
+import Propellor.Types.Container
import "mtl" Control.Monad.Reader
import qualified Data.Set as S
@@ -75,6 +77,11 @@ pureInfoProperty' desc i = setInfoProperty p i
askInfo :: (IsInfo v) => Propellor v
askInfo = asks (fromInfo . hostInfo)
+-- | Checks if a ContainerCapability is set in the current Info.
+hasContainerCapability :: ContainerCapability -> Propellor Bool
+hasContainerCapability c = elem c
+ <$> (askInfo :: Propellor [ContainerCapability])
+
-- | Specifies that a host's operating system is Debian,
-- and further indicates the suite and architecture.
--
diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs
index 6bbb4512..35df08e0 100644
--- a/src/Propellor/Property/Bootstrap.hs
+++ b/src/Propellor/Property/Bootstrap.hs
@@ -13,6 +13,7 @@ module Propellor.Property.Bootstrap (
import Propellor.Base
import Propellor.Bootstrap
import Propellor.Types.Info
+import Propellor.Types.Container
import Propellor.Property.Chroot
import Propellor.PrivData.Paths
@@ -58,7 +59,7 @@ data RepoSource
-- All build dependencies are installed, using distribution packages
-- or falling back to using cabal or stack.
bootstrappedFrom :: RepoSource -> Property Linux
-bootstrappedFrom reposource = check inChroot $
+bootstrappedFrom reposource = check (hasContainerCapability FilesystemContained) $
go `requires` clonedFrom reposource
where
go :: Property Linux
@@ -133,7 +134,7 @@ clonedFrom reposource = case reposource of
liftIO $ B.writeFile gitconfig cfg
return MadeChange
- needclone = (inChroot <&&> truelocaldirisempty)
+ needclone = (hasContainerCapability FilesystemContained <&&> truelocaldirisempty)
<||> (liftIO (not <$> doesDirectoryExist localdir))
truelocaldirisempty = exposeTrueLocaldir $ const $
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 5d29538c..48d96dcf 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -9,7 +9,6 @@ module Propellor.Property.Chroot (
ChrootBootstrapper(..),
Debootstrapped(..),
ChrootTarball(..),
- inChroot,
exposeTrueLocaldir,
-- * Internal use
provisioned',
@@ -23,6 +22,7 @@ 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
@@ -127,19 +127,20 @@ bootstrapped bootstrapper location ps = c
-- is first unmounted. Note that it does not ensure that any processes
-- that might be running inside the chroot are stopped.
provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
-provisioned c = provisioned' c False
+provisioned c = provisioned' c False [FilesystemContained]
provisioned'
:: Chroot
-> Bool
+ -> [ContainerCapability]
-> RevertableProperty (HasInfo + Linux) Linux
-provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly =
+provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly caps =
(infopropigator c normalContainerInfo $ setup `describe` chrootDesc c "exists")
<!>
(teardown `describe` chrootDesc c "removed")
where
setup :: Property Linux
- setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
+ setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly caps
`requires` built
built = case buildchroot bootstrapper (chrootSystem c) loc of
@@ -165,8 +166,8 @@ chrootInfo (Chroot loc _ _ h) = mempty `addInfo`
mempty { _chroots = M.singleton loc h }
-- | Propellor is run inside the chroot to provision it.
-propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
-propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
+propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> [ContainerCapability] -> Property UnixLike
+propellChroot c@(Chroot loc _ _ _) mkproc systemdonly caps = property (chrootDesc c "provisioned") $ do
let d = localdir </> shimdir c
let me = localdir </> "propellor"
shim <- liftIO $ Shim.setup me Nothing d
@@ -188,7 +189,7 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
chainprovision shim = do
parenthost <- asks hostName
- cmd <- liftIO $ toChain parenthost c systemdonly
+ cmd <- liftIO $ toChain parenthost c systemdonly caps
pe <- liftIO standardPathEnv
(p, cleanup) <- liftIO $ mkproc
[ shim
@@ -199,13 +200,13 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
liftIO cleanup
return r
-toChain :: HostName -> Chroot -> Bool -> IO CmdLine
-toChain parenthost (Chroot loc _ _ _) systemdonly = do
+toChain :: HostName -> Chroot -> Bool -> [ContainerCapability] -> IO CmdLine
+toChain parenthost (Chroot loc _ _ _) systemdonly caps = do
onconsole <- isConsole <$> getMessageHandle
- return $ ChrootChain parenthost loc systemdonly onconsole
+ return $ ChrootChain parenthost loc systemdonly onconsole caps
chain :: [Host] -> CmdLine -> IO ()
-chain hostlist (ChrootChain hn loc systemdonly onconsole) =
+chain hostlist (ChrootChain hn loc systemdonly onconsole caps) =
case findHostNoAlias hostlist hn of
Nothing -> errorMessage ("cannot find host " ++ hn)
Just parenthost -> case M.lookup loc (_chroots $ fromInfo $ hostInfo parenthost) of
@@ -216,11 +217,12 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) =
changeWorkingDirectory localdir
when onconsole forceConsole
onlyProcess (provisioningLock loc) $
- runChainPropellor (setInChroot h) $
+ runChainPropellor (setcaps h) $
ensureChildProperties $
if systemdonly
then [toChildProperty Systemd.installed]
else hostProperties h
+ setcaps h = h { hostInfo = hostInfo h `addInfo` caps }
chain _ _ = errorMessage "bad chain command"
inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
@@ -252,21 +254,6 @@ 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)
-
-- | Runs an action with the true localdir exposed,
-- not the one bind-mounted into a chroot. The action is passed the
-- path containing the contents of the localdir outside the chroot.
@@ -276,7 +263,7 @@ newtype InChroot = InChroot Bool
-- we unmount the localdir to expose the true localdir. Finally, to cleanup,
-- the temp directory is bind mounted back to the localdir.
exposeTrueLocaldir :: (FilePath -> Propellor a) -> Propellor a
-exposeTrueLocaldir a = ifM inChroot
+exposeTrueLocaldir a = ifM (hasContainerCapability FilesystemContained)
( withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir ->
bracket_
(movebindmount localdir tmpdir)
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 6aeec5fa..d06a2380 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -598,8 +598,9 @@ chain hostlist hn s = case toContainerId s of
go cid h = do
changeWorkingDirectory localdir
onlyProcess (provisioningLock cid) $
- runChainPropellor h $
+ runChainPropellor (setcaps h) $
ensureChildProperties $ hostProperties h
+ setcaps h = h { hostInfo = hostInfo h `addInfo` [HostnameContained, FilesystemContained] }
stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index 852b8dcd..9b001476 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -18,9 +18,9 @@ import qualified Propellor.Property.File as File
import qualified Propellor.Property.ConfFile as ConfFile
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.Mount
-import Propellor.Property.Chroot (inChroot)
import Propellor.Types.Info
import Propellor.Types.Bootloader
+import Propellor.Types.Container
import Utility.SafeCommand
import Data.List
@@ -34,10 +34,11 @@ type OSDevice = String
-- | Installs the grub package. This does not make grub be used as the
-- bootloader.
--
--- This includes running update-grub, unless it's run in a chroot.
+-- This includes running update-grub, unless it's run in a chroot
+-- or container.
installed :: GrubTarget -> Property (HasInfo + DebianLike)
installed grubtarget = installed' grubtarget
- `onChange` (check (not <$> inChroot) mkConfig)
+ `onChange` (check (not <$> hasContainerCapability FilesystemContained) mkConfig)
-- | Run update-grub, to generate the grub boot menu. It will be
-- automatically updated when kernel packages are installed.
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index 0ece92a8..8383fdaa 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -1,8 +1,10 @@
+{-# LANGUAGE LambdaCase #-}
+
module Propellor.Property.Hostname where
import Propellor.Base
import qualified Propellor.Property.File as File
-import Propellor.Property.Chroot (inChroot)
+import Propellor.Types.Container
import Utility.Split
import Data.List
@@ -41,7 +43,7 @@ setTo' extractdomain hn = combineProperties desc $ toProps
else Just ("127.0.1.1", [hn, basehost])
, Just ("127.0.0.1", ["localhost"])
]
- , check (not <$> inChroot) $
+ , check safetochange $
cmdProperty "hostname" [basehost]
`assume` NoChange
]
@@ -50,6 +52,10 @@ setTo' extractdomain hn = combineProperties desc $ toProps
basehost = takeWhile (/= '.') hn
domain = extractdomain hn
+ safetochange = askInfo >>= return . \case
+ [] -> True
+ caps -> HostnameContained `elem` caps
+
hostslines ipsnames =
File.fileProperty desc (addhostslines ipsnames) "/etc/hosts"
addhostslines :: [(String, [String])] -> [String] -> [String]
diff --git a/src/Propellor/Property/Localdir.hs b/src/Propellor/Property/Localdir.hs
index 018a054b..2323f569 100644
--- a/src/Propellor/Property/Localdir.hs
+++ b/src/Propellor/Property/Localdir.hs
@@ -7,7 +7,7 @@ module Propellor.Property.Localdir where
import Propellor.Base
import Propellor.Git.Config
import Propellor.Types.Info
-import Propellor.Property.Chroot (inChroot)
+import Propellor.Types.Container
import Propellor.Property.Mount (partialBindMountsOf, umountLazy)
-- | Sets the url to use as the origin of propellor's git repository.
@@ -46,7 +46,7 @@ removed = check (doesDirectoryExist localdir) $
return NoChange
where
atend _ = do
- ifM inChroot
+ ifM (hasContainerCapability FilesystemContained)
-- In a chroot, all we have to do is unmount localdir,
-- and then delete it
( liftIO $ umountLazy localdir
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 9e9a1de1..bfc0f9a5 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -278,16 +278,21 @@ nspawned c@(Container name (Chroot.Chroot loc builder _ _) h) =
-- 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 = Chroot.provisioned' chroot True
+ chrootprovisioned = Chroot.provisioned' chroot True [FilesystemContained]
-- Use nsenter to enter container and and run propellor to
-- finish provisioning.
containerprovisioned :: RevertableProperty Linux Linux
containerprovisioned =
- tightenTargets (Chroot.propellChroot chroot (enterContainerProcess c) False)
+ tightenTargets (Chroot.propellChroot chroot (enterContainerProcess c) False containercaps)
<!>
doNothing
+ containercaps =
+ [ FilesystemContained
+ , HostnameContained
+ ]
+
chroot = Chroot.Chroot loc builder Chroot.propagateChrootInfo h
-- | Sets up the service files for the container, using the
diff --git a/src/Propellor/Property/Uboot.hs b/src/Propellor/Property/Uboot.hs
index 562d2441..098362e1 100644
--- a/src/Propellor/Property/Uboot.hs
+++ b/src/Propellor/Property/Uboot.hs
@@ -3,7 +3,7 @@ module Propellor.Property.Uboot where
import Propellor.Base
import Propellor.Types.Info
import Propellor.Types.Bootloader
-import Propellor.Property.Chroot
+import Propellor.Types.Container
import Propellor.Property.Mount
import qualified Propellor.Property.Apt as Apt
@@ -14,7 +14,7 @@ type BoardName = String
--
-- This includes writing it to the boot sector.
sunxi :: BoardName -> Property (HasInfo + DebianLike)
-sunxi boardname = setInfoProperty (check (not <$> inChroot) go) info
+sunxi boardname = setInfoProperty (check (not <$> hasContainerCapability FilesystemContained) go) info
`requires` Apt.installed ["u-boot", "u-boot-sunxi"]
where
go :: Property Linux
diff --git a/src/Propellor/Types/CmdLine.hs b/src/Propellor/Types/CmdLine.hs
index d712a456..77eaa452 100644
--- a/src/Propellor/Types/CmdLine.hs
+++ b/src/Propellor/Types/CmdLine.hs
@@ -2,6 +2,7 @@ module Propellor.Types.CmdLine where
import Propellor.Types.OS
import Propellor.Types.PrivData
+import Propellor.Types.Container
import System.Posix.Types
@@ -25,7 +26,7 @@ data CmdLine
| Relay HostName
| DockerInit HostName
| DockerChain HostName String
- | ChrootChain HostName FilePath Bool Bool
+ | ChrootChain HostName FilePath Bool Bool [ContainerCapability]
| GitPush Fd Fd
| Check
| Build
diff --git a/src/Propellor/Types/Container.hs b/src/Propellor/Types/Container.hs
index 217d7df7..de74f79e 100644
--- a/src/Propellor/Types/Container.hs
+++ b/src/Propellor/Types/Container.hs
@@ -1,7 +1,9 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}
module Propellor.Types.Container where
+import Propellor.Types.Info
+
-- | A value that can be bound between the host and a container.
--
-- For example, a Bound Port is a Port on the container that is bound to
@@ -28,3 +30,18 @@ data Bound v = Bound
same :: v -> Bound v
same v = Bound v v
+-- | Capabilities of a container.
+data ContainerCapability
+ = HostnameContained
+ -- ^ The container has its own hostname (and domain name)
+ -- separate from the system that contains it.
+ | FilesystemContained
+ -- ^ The container has its own root filesystem, rather than sharing
+ -- the root filesystem of the system that contains it.
+ deriving (Typeable, Eq, Read, Show)
+
+-- | A [ContainerCapability] can be used as Info.
+-- It does not propagate out to the Host.
+-- When not in a container, the Info value will be [].
+instance IsInfo [ContainerCapability] where
+ propagateInfo _ = PropagateInfo False