propellor 5.7.0 → 5.8.0

raw patch · 22 files changed

+177/−80 lines, 22 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +21/−0
• debian/changelog +21/−0
• joeyconfig.hs +4/−3
• propellor.cabal +1/−1
• src/Propellor/CmdLine.hs +1/−1
• src/Propellor/Info.hs +7/−0
• src/Propellor/Property/Bootstrap.hs +3/−2
• src/Propellor/Property/Chroot.hs +15/−28
• src/Propellor/Property/ConfFile.hs +1/−1
• src/Propellor/Property/Docker.hs +2/−1
• src/Propellor/Property/Git.hs +1/−1
• src/Propellor/Property/Grub.hs +4/−3
• src/Propellor/Property/Hostname.hs +8/−2
• src/Propellor/Property/Localdir.hs +2/−2
• src/Propellor/Property/Sbuild.hs +1/−1
• src/Propellor/Property/SiteSpecific/JoeySites.hs +32/−23
• src/Propellor/Property/Ssh.hs +12/−5
• src/Propellor/Property/Systemd.hs +7/−2
• src/Propellor/Property/Uboot.hs +2/−2
• src/Propellor/Property/User.hs +12/−0
• src/Propellor/Types/CmdLine.hs +2/−1
• src/Propellor/Types/Container.hs +18/−1

@@ -1,3 +1,24 @@+propellor (5.8.0) unstable; 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.+  * Add User.ownsWithPrimaryGroup+    Thanks, Sean Whitton+  * Ssh.userKeys, Ssh.userKeyAt: Create .ssh directory when it does not yet+    exist.+  * Ssh.userKeyAt: When a relative filepath is provided, it's put inside+    the user's .ssh directory.+  * Fix Git.pulled always reporting a change.+    Thanks, Sean Whitton++ -- Joey Hess <id@joeyh.name>  Fri, 26 Apr 2019 08:23:29 -0400+ propellor (5.7.0) unstable; urgency=medium    * Sbuild.built no longer includes Apt.stdSourcesList by default,

@@ -1,3 +1,24 @@+propellor (5.8.0) unstable; 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.+  * Add User.ownsWithPrimaryGroup+    Thanks, Sean Whitton+  * Ssh.userKeys, Ssh.userKeyAt: Create .ssh directory when it does not yet+    exist.+  * Ssh.userKeyAt: When a relative filepath is provided, it's put inside+    the user's .ssh directory.+  * Fix Git.pulled always reporting a change.+    Thanks, Sean Whitton++ -- Joey Hess <id@joeyh.name>  Fri, 26 Apr 2019 08:23:29 -0400+ propellor (5.7.0) unstable; urgency=medium    * Sbuild.built no longer includes Apt.stdSourcesList by default,

@@ -193,17 +193,18 @@ 		[ (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIIS/hDYq1MAxfOBf49htym3BOYlx4Gk9SDpiHjv7u6IC") 		] -	& JoeySites.homePower+	& JoeySites.house 		(User "joey") 		hosts-		(Context "homepower.joeyh.name")+		(Context "house.joeyh.name") 		(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIMAmVYddg/RgCbIj+cLcEiddeFXaYFnbEJ3uGj9G/EyV joey@honeybee") 	& JoeySites.homeRouter 	& JoeySites.homeNAS 	& Apt.installed ["mtr-tiny", "iftop", "screen"] 	& Postfix.satellite -	& check (not <$> inChroot) (setupRevertableProperty autobuilder)+	& check (not <$> hasContainerCapability Systemd.FilesystemContained) +		(setupRevertableProperty autobuilder) 	-- In case compiler needs more than available ram 	& Apt.serviceInstalledRunning "swapspace"   where

@@ -1,5 +1,5 @@ Name: propellor-Version: 5.7.0+Version: 5.8.0 Cabal-Version: 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>

@@ -129,7 +129,7 @@ 	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

@@ -11,6 +11,7 @@ 	pureInfoProperty', 	askInfo, 	getOS,+	hasContainerCapability, 	ipv4, 	ipv6, 	alias,@@ -26,6 +27,7 @@ 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@@ -74,6 +76,11 @@ -- | Gets a value from the host's Info. 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.

@@ -13,6 +13,7 @@ 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 @@ -- 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 @@ 			liftIO $ B.writeFile gitconfig cfg 		return MadeChange -	needclone = (inChroot <&&> truelocaldirisempty)+	needclone = (hasContainerCapability FilesystemContained <&&> truelocaldirisempty) 		<||> (liftIO (not <$> doesDirectoryExist localdir)) 	 	truelocaldirisempty = exposeTrueLocaldir $ const $

@@ -9,7 +9,6 @@ 	ChrootBootstrapper(..), 	Debootstrapped(..), 	ChrootTarball(..),-	inChroot, 	exposeTrueLocaldir, 	-- * Internal use 	provisioned',@@ -23,6 +22,7 @@ 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 @@ -- 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 @@ 	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 @@  	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 @@ 		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 @@ 		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 @@ 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 @@ -- 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)

@@ -161,7 +161,7 @@ 		isline 		(not . isline) 		(const [line])-		(const [line])+		(++ [line]) 		f 	dedup = fileProperty "" dedup' f 	dedup' ls = let (pre, wanted, post) = foldl' find ([], [], []) ls

@@ -598,8 +598,9 @@ 	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 ]

@@ -110,7 +110,7 @@ 		[ "cd " ++ shellEscape dir 		, "git pull" 		]-		`changesFile` (dir </> ".git" </> "FETCH_HEAD")+		`changesFileContent` (dir </> ".git" </> "FETCH_HEAD")  isGitDir :: FilePath -> IO Bool isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir])

@@ -18,9 +18,9 @@ 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 @@ -- | 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.

@@ -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 @@ 			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 @@ 	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]

@@ -7,7 +7,7 @@ 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 @@ 		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

@@ -270,7 +270,7 @@  -- | Ensure that an sbuild schroot uses the host's Apt proxy. ----- This property is standardly used when the host has 'Apt.useLocalCacher'.+-- This property is typically used when the host has 'Apt.useLocalCacher'. useHostProxy :: Host -> Property DebianLike useHostProxy h = property' "use host's apt proxy" $ \w -> 	-- Note that we can't look at getProxyInfo outside the property,

@@ -754,10 +754,10 @@ 		, "# Redirect all to joeyh.name." 		, "rewriterule (.*) http://joeyh.name$1 [r]" 		]-	& alias "homepower.joeyh.name"-	& apacheSite "homepower.joeyh.name"-		[ "DocumentRoot /srv/web/homepower.joeyh.name"-		, "<Directory /srv/web/homepower.joeyh.name>"+	& alias "house.joeyh.name"+	& apacheSite "house.joeyh.name"+		[ "DocumentRoot /srv/web/house.joeyh.name"+		, "<Directory /srv/web/house.joeyh.name>" 		, "  Options Indexes ExecCGI" 		, "  AllowOverride None" 		, Apache.allowAll@@ -899,13 +899,13 @@ 	& "/etc/systemd/logind.conf" `ConfFile.containsIniSetting` 		("Login", "LidSwitchIgnoreInhibited", "no") -homePower :: IsContext c => User -> [Host] -> c -> (SshKeyType, Ssh.PubKeyText) -> Property (HasInfo + DebianLike)-homePower user hosts ctx sshkey = propertyList "home power" $ props+house :: IsContext c => User -> [Host] -> c -> (SshKeyType, Ssh.PubKeyText) -> Property (HasInfo + DebianLike)+house user hosts ctx sshkey = propertyList "home automation" $ props 	& Apache.installed 	& Apt.installed ["python", "python-pymodbus", "rrdtool", "rsync"]-	& File.ownerGroup "/var/www/html" user (userGroup user)-	& Git.cloned user "https://git.joeyh.name/git/joey/homepower.git" d Nothing+	& Git.cloned user "https://git.joeyh.name/git/joey/house.git" d Nothing 	& Git.cloned user "https://git.joeyh.name/git/reactive-banana-automation.git" (d </> "reactive-banana-automation") Nothing+	& websitesymlink 	& build 	& Systemd.enabled setupservicename 		`requires` setupserviceinstalled@@ -924,8 +924,8 @@ 	& User.hasGroup user (Group "gpio") 	& Apt.installed ["i2c-tools"] 	& User.hasGroup user (Group "i2c")-	& "/etc/modules-load.d/homepower.conf" `File.hasContent` ["i2c-dev"]-	& Cron.niceJob "homepower upload"+	& "/etc/modules-load.d/house.conf" `File.hasContent` ["i2c-dev"]+	& Cron.niceJob "house upload" 		(Cron.Times "1 * * * *") user d rsynccommand 		`requires` Ssh.userKeyAt (Just sshkeyfile) user ctx sshkey 		`requires` File.ownerGroup (takeDirectory sshkeyfile)@@ -934,7 +934,7 @@ 		`requires` Ssh.knownHost hosts "kitenet.net" user 	&  File.hasPrivContentExposed "/etc/darksky-forecast-url" anyContext   where-	d = "/var/www/html/homepower"+	d = "/home/joey/house" 	sshkeyfile = d </> ".ssh/key" 	build = check (not <$> doesFileExist (d </> "controller")) $ 		userScriptProperty (User "joey")@@ -955,11 +955,11 @@ 			, "libghc-reactive-banana-dev" 			, "libghc-hinotify-dev" 			]-	pollerservicename = "homepower"+	pollerservicename = "house-poller" 	pollerservicefile = "/etc/systemd/system/" ++ pollerservicename ++ ".service" 	pollerserviceinstalled = pollerservicefile `File.hasContent` 		[ "[Unit]"-		, "Description=home power poller"+		, "Description=house poller" 		, "" 		, "[Service]" 		, "ExecStart=" ++ d ++ "/poller"@@ -970,13 +970,13 @@ 		, "" 		, "[Install]" 		, "WantedBy=multi-user.target"-		, "WantedBy=homepower-controller.target"+		, "WantedBy=house-controller.target" 		]-	controllerservicename = "homepower-controller"+	controllerservicename = "house-controller" 	controllerservicefile = "/etc/systemd/system/" ++ controllerservicename ++ ".service" 	controllerserviceinstalled = controllerservicefile `File.hasContent` 		[ "[Unit]"-		, "Description=home power controller"+		, "Description=house controller" 		, "" 		, "[Service]" 		, "ExecStart=" ++ d ++ "/controller"@@ -988,11 +988,11 @@ 		, "[Install]" 		, "WantedBy=multi-user.target" 		]-	watchdogservicename = "homepower-watchdog"+	watchdogservicename = "house-watchdog" 	watchdogservicefile = "/etc/systemd/system/" ++ watchdogservicename ++ ".service" 	watchdogserviceinstalled = watchdogservicefile `File.hasContent` 		[ "[Unit]"-		, "Description=home power watchdog"+		, "Description=house watchdog" 		, "" 		, "[Service]" 		, "ExecStart=" ++ d ++ "/watchdog"@@ -1004,11 +1004,11 @@ 		, "[Install]" 		, "WantedBy=multi-user.target" 		]-	setupservicename = "homepower-setup"+	setupservicename = "house-setup" 	setupservicefile = "/etc/systemd/system/" ++ setupservicename ++ ".service" 	setupserviceinstalled = setupservicefile `File.hasContent` 		[ "[Unit]"-		, "Description=home power monitor setup"+		, "Description=house setup" 		, "" 		, "[Service]" 		, "ExecStart=" ++ d ++ "/setup"@@ -1019,12 +1019,21 @@ 		, "" 		, "[Install]" 		, "WantedBy=multi-user.target"-		, "WantedBy=homepower.target"+		, "WantedBy=house-poller.target"+		, "WantedBy=house-controller.target"+		, "WantedBy=house-watchdog.target" 		] 	-- Any changes to the rsync command will need my .authorized_keys 	-- rsync server command to be updated too.-	rsynccommand = "rsync -e 'ssh -i" ++ sshkeyfile ++ "' -avz rrds/ joey@kitenet.net:/srv/web/homepower.joeyh.name/rrds/"+	rsynccommand = "rsync -e 'ssh -i" ++ sshkeyfile ++ "' -avz rrds/ joey@kitenet.net:/srv/web/house.joeyh.name/rrds/" +	websitesymlink :: Property UnixLike+	websitesymlink = check (not . isSymbolicLink <$> getSymbolicLinkStatus "/var/www/html")+		(property "website symlink" $ makeChange $ do+			removeDirectoryRecursive "/var/www/html"+			createSymbolicLink d "/var/www/html"+		)+ homerouterWifiInterfaceOld :: String homerouterWifiInterfaceOld = "wlx00c0ca82eb78" -- thinkpenguin wifi adapter @@ -1063,7 +1072,7 @@ 		, "interface=" ++ homerouterWifiInterface 		, "interface=eth0" 		, "domain=kitenet.net"-		-- lease time is short because the homepower+		-- lease time is short because the house 		-- controller wants to know when clients disconnect 		, "dhcp-range=10.1.1.100,10.1.1.150,10m" 		, "no-hosts"

@@ -279,9 +279,12 @@ -- | Sets up a user with the specified pubic key, and a private -- key from the privdata. ----- A file can be specified to write the key to somewhere other than+-- A FilePath can be specified to write the key to somewhere other than -- the default locations. Allows a user to have multiple keys for -- different roles.+--+-- When the FilePath is relative, is put inside the User's +-- ~/.ssh/ directory. userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property (HasInfo + UnixLike) userKeyAt dest user@(User u) context (keytype, pubkeytext) = 	combineProperties desc $ props@@ -306,14 +309,18 @@ 	installprop writer ext key = do 		f <- liftIO $ keyfile ext 		return $ combineProperties desc $ props+			& File.dirExists (takeDirectory f) 			& writer f (keyFileContent key) 			& File.ownerGroup f user (userGroup user) 			& File.ownerGroup (takeDirectory f) user (userGroup user) 	keyfile ext = case dest of-		Nothing -> do-			home <- homeDirectory <$> getUserEntryForName u-			return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext-		Just f -> return $ f ++ ext+		Nothing -> relhomessh $ "id_" ++ fromKeyType keytype ++ ext+		Just f+			| isRelative f -> relhomessh (f ++ ext)+			| otherwise -> return (f ++ ext)+	relhomessh f = do+		home <- homeDirectory <$> getUserEntryForName u+		return $ home </> ".ssh" </> f  fromKeyType :: SshKeyType -> String fromKeyType SshRsa = "rsa"

@@ -278,15 +278,20 @@ 	-- 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 

@@ -3,7 +3,7 @@ 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 @@ -- -- 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

@@ -148,6 +148,10 @@ homedir :: User -> IO FilePath homedir (User user) = homeDirectory <$> getUserEntryForName user +primaryGroup :: User -> IO Group+primaryGroup (User u) = Group <$> groupName <$>+	(getGroupEntryForID =<< (userGroupID <$> getUserEntryForName u))+ hasGroup :: User -> Group -> Property DebianLike hasGroup (User user) (Group group') = tightenTargets $ check test go 	`describe` unwords ["user", user, "in group", group']@@ -187,6 +191,14 @@ 		, "debian-tor" 		, "lpadmin" 		]++-- | Ensures that a file is owned by a user, and also by that user's primary+-- group.+ownsWithPrimaryGroup :: User -> FilePath -> Property UnixLike+ownsWithPrimaryGroup user@(User u) f =+	property' (f ++ " has owner " ++ u) $ \w -> do+		group <- liftIO $ primaryGroup user+		ensureProperty w $ File.ownerGroup f user group  -- | Controls whether shadow passwords are enabled or not. shadowConfig :: Bool -> Property DebianLike

@@ -2,6 +2,7 @@  import Propellor.Types.OS import Propellor.Types.PrivData+import Propellor.Types.Container  import System.Posix.Types @@ -25,7 +26,7 @@ 	| Relay HostName 	| DockerInit HostName 	| DockerChain HostName String-	| ChrootChain HostName FilePath Bool Bool+	| ChrootChain HostName FilePath Bool Bool [ContainerCapability] 	| GitPush Fd Fd 	| Check 	| Build

@@ -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 @@ 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