Record propellor (0.8.1) in archive suite sid

11 files changed, 196 insertions, 115 deletions

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 1521eb65..4307b850 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -55,10 +55,11 @@ installed = Apt.installed ["docker.io"]
 -- | Configures docker with an authentication file, so that images can be
 -- pushed to index.docker.io. Optional.
 configured :: Property
-configured = property "docker configured" go `requires` installed
+configured = prop `requires` installed
   where
-	go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $ 
-		"/root/.dockercfg" `File.hasContent` (lines cfg)
+	prop = withPrivData DockerAuthentication anyContext $ \getcfg ->
+		property "docker configured" $ getcfg $ \cfg -> ensureProperty $ 
+			"/root/.dockercfg" `File.hasContent` (lines cfg)
 
 -- | A short descriptive name for a container.
 -- Should not contain whitespace or other unusual characters,
@@ -86,8 +87,8 @@ cn2hn cn = cn ++ ".docker"
 -- The container has its own Properties which are handled by running
 -- propellor inside the container.
 --
--- Additionally, the container can have DNS info, such as a CNAME.
--- These become info of the host(s) it's docked in.
+-- When the container's Properties include DNS info, such as a CNAME,
+-- that is propigated to the Info of the host(s) it's docked in.
 --
 -- Reverting this property ensures that the container is stopped and
 -- removed.
@@ -96,7 +97,7 @@ docked
 	-> ContainerName
 	-> RevertableProperty
 docked hosts cn = RevertableProperty
-	((maybe id exposeDnsInfos mhost) (go "docked" setup))
+	((maybe id propigateInfo mhost) (go "docked" setup))
 	(go "undocked" teardown)
   where
 	go desc a = property (desc ++ " " ++ cn) $ do
@@ -123,9 +124,12 @@ docked hosts cn = RevertableProperty
 					]
 			]
 
-exposeDnsInfos :: Host -> Property -> Property
-exposeDnsInfos (Host _ _ containerinfo) p = combineProperties (propertyDesc p) $
-	p : map addDNS (S.toList $ _dns containerinfo)
+propigateInfo :: Host -> Property -> Property
+propigateInfo (Host _ _ containerinfo) p =
+	combineProperties (propertyDesc p) $ p : dnsprops ++ privprops
+  where
+	dnsprops = map addDNS (S.toList $ _dns containerinfo)
+	privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo)
 
 findContainer
 	:: Maybe Host
@@ -390,7 +394,7 @@ chain s = case toContainerId s of
 -- being run. So, retry connections to the client for up to
 -- 1 minute.
 provisionContainer :: ContainerId -> Property
-provisionContainer cid = containerDesc cid $ property "provision" $ liftIO $ do
+provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
 	r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
 	when (r /= FailedChange) $
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 0b060177..0e738f25 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -17,16 +17,17 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
 --
 -- The file's permissions are preserved if the file already existed.
 -- Otherwise, they're set to 600.
-hasPrivContent :: FilePath -> Property
-hasPrivContent f = property desc $ withPrivData (PrivFile f) $ \privcontent -> 
-	ensureProperty $ fileProperty' writeFileProtected desc
-		(\_oldcontent -> lines privcontent) f
+hasPrivContent :: FilePath -> Context -> Property
+hasPrivContent f context = withPrivData (PrivFile f) context $ \getcontent -> 
+	property desc $ getcontent $ \privcontent -> 
+		ensureProperty $ fileProperty' writeFileProtected desc
+			(\_oldcontent -> lines privcontent) f
   where
 	desc = "privcontent " ++ f
 
 -- | Leaves the file world-readable.
-hasPrivContentExposed :: FilePath -> Property
-hasPrivContentExposed f = hasPrivContent f `onChange`
+hasPrivContentExposed :: FilePath -> Context -> Property
+hasPrivContentExposed f context = hasPrivContent f context `onChange`
 	mode f (combineModes (ownerWriteMode:readModes))
 
 -- | Ensures that a line is present in a file, adding it to the end if not.
diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs
index 64ea9fea..b4698663 100644
--- a/src/Propellor/Property/Gpg.hs
+++ b/src/Propellor/Property/Gpg.hs
@@ -9,6 +9,8 @@ import System.PosixCompat
 installed :: Property
 installed = Apt.installed ["gnupg"]
 
+type GpgKeyId = String
+
 -- | Sets up a user with a gpg key from the privdata.
 --
 -- Note that if a secret key is exported using gpg -a --export-secret-key,
@@ -21,19 +23,20 @@ installed = Apt.installed ["gnupg"]
 -- The GpgKeyId does not have to be a numeric id; it can just as easily
 -- be a description of the key.
 keyImported :: GpgKeyId -> UserName -> Property
-keyImported keyid user = flagFile' (property desc go) genflag
+keyImported keyid user = flagFile' prop genflag
 	`requires` installed
   where
 	desc = user ++ " has gpg key " ++ show keyid
 	genflag = do
 		d <- dotDir user
 		return $ d </> ".propellor-imported-keyid-" ++ keyid
-	go = withPrivData (GpgKey keyid) $ \key -> makeChange $
-		withHandle StdinHandle createProcessSuccess
-			(proc "su" ["-c", "gpg --import", user]) $ \h -> do
-				fileEncoding h
-				hPutStr h key
-				hClose h
+	prop = withPrivData GpgKey (Context keyid) $ \getkey ->
+		property desc $ getkey $ \key -> makeChange $
+			withHandle StdinHandle createProcessSuccess
+				(proc "su" ["-c", "gpg --import", user]) $ \h -> do
+					fileEncoding h
+					hPutStr h key
+					hClose h
 
 dotDir :: UserName -> IO FilePath
 dotDir user = do
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
new file mode 100644
index 00000000..841861f4
--- /dev/null
+++ b/src/Propellor/Property/Grub.hs
@@ -0,0 +1,39 @@
+module Propellor.Property.Grub where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+-- | Eg, hd0,0 or xen/xvda1
+type GrubDevice = String
+
+type TimeoutSecs = Int
+
+-- | Use PV-grub chaining to boot
+--
+-- Useful when the VPS's pv-grub is too old to boot a modern kernel image.
+--
+-- http://notes.pault.ag/linode-pv-grub-chainning/
+--
+-- The rootdev should be in the form "hd0", while the bootdev is in the form
+-- "xen/xvda".
+chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property
+chainPVGrub rootdev bootdev timeout = combineProperties desc
+	[ File.dirExists "/boot/grub"
+	, "/boot/grub/menu.lst" `File.hasContent`
+		[ "default 1" 
+		, "timeout " ++ show timeout
+		, ""
+		, "title grub-xen shim"
+		, "root (" ++ rootdev ++ ")"
+		, "kernel /boot/xen-shim"
+		, "boot"
+		]
+	, "/boot/load.cf" `File.hasContent`
+		[ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ]
+	, Apt.installed ["grub-xen"]
+	, flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"
+			`describe` "/boot-xen-shim"
+	]
+  where
+	desc = "chain PV-grub"
diff --git a/src/Propellor/Property/HostingProvider/Linode.hs b/src/Propellor/Property/HostingProvider/Linode.hs
new file mode 100644
index 00000000..34d72184
--- /dev/null
+++ b/src/Propellor/Property/HostingProvider/Linode.hs
@@ -0,0 +1,10 @@
+module Propellor.Property.HostingProvider.Linode where
+
+import Propellor
+import qualified Propellor.Property.Grub as Grub
+
+-- | Linode's pv-grub-x86_64 does not currently support booting recent
+-- Debian kernels compressed with xz. This sets up pv-grub chaing to enable
+-- it.
+chainPVGrub :: Grub.TimeoutSecs -> Property
+chainPVGrub = Grub.chainPVGrub "hd0" "xen/xvda"
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index 10fda040..1cce4e60 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -3,11 +3,16 @@ module Propellor.Property.Hostname where
 import Propellor
 import qualified Propellor.Property.File as File
 
--- | Ensures that the hostname is set to the HostInfo value.
+-- | Ensures that the hostname is set using best practices.
+--
 -- Configures /etc/hostname and the current hostname.
 --
--- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is
--- standard at least on Debian to set the FDQN (127.0.0.1 is localhost).
+-- /etc/hosts is also configured, with an entry for 127.0.1.1, which is
+-- standard at least on Debian to set the FDQN.
+--
+-- Also, the /etc/hosts 127.0.0.1 line is set to localhost. Putting any
+-- other hostnames there is not best practices and can lead to annoying
+-- messages from eg, apache.
 sane :: Property
 sane = property ("sane hostname") (ensureProperty . setTo =<< asks hostName)
 
@@ -21,13 +26,14 @@ setTo hn = combineProperties desc go
 		[ Just $ "/etc/hostname" `File.hasContent` [basehost]
 		, if null domain
 			then Nothing 
-			else Just $ File.fileProperty desc
-				addhostline "/etc/hosts"
+			else Just $ trivial $ hostsline "127.0.1.1" [hn, basehost]
+		, Just $ trivial $ hostsline "127.0.0.1" ["localhost"]
 		, Just $ trivial $ cmdProperty "hostname" [basehost]
 		]
 	
-	hostip = "127.0.1.1"
-	hostline = hostip ++ "\t" ++ hn ++ " " ++ basehost
-
-	addhostline ls = hostline : filter (not . hashostip) ls
-	hashostip l = headMaybe (words l) == Just hostip
+	hostsline ip names = File.fileProperty desc
+		(addhostsline ip names)
+		"/etc/hosts"
+	addhostsline ip names ls =
+		(ip ++ "\t" ++ (unwords names)) : filter (not . hasip ip) ls
+	hasip ip l = headMaybe (words l) == Just ip
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index 051d6425..39cb6ff0 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -25,5 +25,6 @@ providerFor users baseurl = propertyList desc $
 	
 	-- the identitites directory controls access, so open up
 	-- file mode
-	identfile u = File.hasPrivContentExposed $
-		concat $ [ "/var/lib/simpleid/identities/", u, ".identity" ]
+	identfile u = File.hasPrivContentExposed
+		(concat [ "/var/lib/simpleid/identities/", u, ".identity" ])
+		(Context baseurl)
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 85584e43..4cb26a50 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -23,29 +23,25 @@ builddir = gitbuilderdir </> "build"
 
 type TimeOut = String -- eg, 5h
 
-autobuilder :: CronTimes -> TimeOut -> Bool -> Property
-autobuilder crontimes timeout rsyncupload = combineProperties "gitannexbuilder"
+autobuilder :: Architecture -> CronTimes -> TimeOut -> Property
+autobuilder arch crontimes timeout = combineProperties "gitannexbuilder"
 	[ Apt.serviceInstalledRunning "cron"
 	, Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir $
 		"git pull ; timeout " ++ timeout ++ " ./autobuild"
 	-- The builduser account does not have a password set,
 	-- instead use the password privdata to hold the rsync server
 	-- password used to upload the built image.
-	, property "rsync password" $ do
-		let f = homedir </> "rsyncpassword"
-		if rsyncupload 
-			then withPrivData (Password builduser) $ \p -> do
-				oldp <- liftIO $ catchDefaultIO "" $
-					readFileStrict f
-				if p /= oldp
-					then makeChange $ writeFile f p
-					else noChange
-			else do
-				ifM (liftIO $ doesFileExist f)
-					( noChange
-					, makeChange $ writeFile f "no password configured"
-					)
+	, withPrivData (Password builduser) context $ \getpw ->
+		property "rsync password" $ getpw $ \pw -> do
+			oldpw <- liftIO $ catchDefaultIO "" $
+				readFileStrict pwfile
+			if pw /= oldpw
+				then makeChange $ writeFile pwfile pw
+				else noChange
 	]
+  where
+	context = Context ("gitannexbuilder " ++ arch)
+	pwfile = homedir </> "rsyncpassword"
 
 tree :: Architecture -> Property
 tree buildarch = combineProperties "gitannexbuilder tree"
@@ -101,13 +97,13 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta
 	& User.accountFor builduser
 	& tree arch
 	& buildDepsApt
-	& autobuilder (show buildminute ++ " * * * *") timeout True
+	& autobuilder arch (show buildminute ++ " * * * *") timeout
 
 androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
 androidAutoBuilderContainer dockerImage crontimes timeout =
 	androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir
 		& Apt.unattendedUpgrades
-		& autobuilder crontimes timeout True
+		& autobuilder "android" crontimes timeout
 
 -- Android is cross-built in a Debian i386 container, using the Android NDK.
 androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host
@@ -154,7 +150,7 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-
 	-- The armel builder can ssh to this companion.
 	& Docker.expose "22"
 	& Apt.serviceInstalledRunning "ssh"
-	& Ssh.authorizedKeys builduser
+	& Ssh.authorizedKeys builduser (Context "armel-git-annex-builder")
 
 armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
 armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder"
@@ -172,9 +168,9 @@ armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "arme
 	-- git-annex/standalone/linux/install-haskell-packages
 	-- which is not fully automated.)
 	& buildDepsNoHaskellLibs
-	& autobuilder crontimes timeout True
+	& autobuilder "armel" crontimes timeout
 		`requires` tree "armel"
-	& Ssh.keyImported SshRsa builduser
+	& Ssh.keyImported SshRsa builduser (Context "armel-git-annex-builder")
 	& trivial writecompanionaddress
   where
 	writecompanionaddress = scriptProperty
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 120ea611..c770907b 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -16,6 +16,7 @@ import qualified Propellor.Property.Obnam as Obnam
 import qualified Propellor.Property.Apache as Apache
 import Utility.SafeCommand
 import Utility.FileMode
+import Utility.Path
 
 import Data.List
 import System.Posix.Files
@@ -28,7 +29,7 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
 		[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
 		, "--client-name=spool"
 		] Obnam.OnlyClient
-		`requires` Ssh.keyImported SshRsa "root"
+		`requires` Ssh.keyImported SshRsa "root" (Context "olduse.net")
 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
 	, check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) $
 		property "olduse.net spool in place" $ makeChange $ do
@@ -84,37 +85,44 @@ oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
 			, "dpkg -i ../" ++ pkg ++ "_*.deb || true"
 			, "apt-get -fy install" -- dependencies
 			, "rm -rf /root/tmp/oldusenet"
+			-- screen fails unless the directory has this mode.
+			-- not sure what's going on.
+			, "chmod 777 /var/run/screen"
 			] `describe` "olduse.net built"
 		]
 
 
 kgbServer :: Property
-kgbServer = withOS desc $ \o -> case o of
-	(Just (System (Debian Unstable) _)) ->
-		ensureProperty $ propertyList desc
-			[ Apt.serviceInstalledRunning "kgb-bot"
-			, File.hasPrivContent "/etc/kgb-bot/kgb.conf"
-				`onChange` Service.restarted "kgb-bot"
-			, "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
-				`describe` "kgb bot enabled"
-				`onChange` Service.running "kgb-bot"
-			]
-	_ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)"
+kgbServer = propertyList desc
+	[ withOS desc $ \o -> case o of
+		(Just (System (Debian Unstable) _)) ->
+			ensureProperty $ propertyList desc
+				[ Apt.serviceInstalledRunning "kgb-bot"
+				, "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
+					`describe` "kgb bot enabled"
+					`onChange` Service.running "kgb-bot"
+				]
+		_ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)"
+	, File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
+		`onChange` Service.restarted "kgb-bot"
+	]
   where
 	desc = "kgb.kitenet.net setup"
 
 mumbleServer :: [Host] -> Property
-mumbleServer hosts = combineProperties "mumble.debian.net" 
+mumbleServer hosts = combineProperties hn
 	[ Apt.serviceInstalledRunning "mumble-server"
 	, Obnam.latestVersion
 	, Obnam.backup "/var/lib/mumble-server" "55 5 * * *"
-		[ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/mumble.debian.net.obnam"
+		[ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/" ++ hn ++ ".obnam"
 		, "--client-name=mumble"
 		] Obnam.OnlyClient
-		`requires` Ssh.keyImported SshRsa "root"
+		`requires` Ssh.keyImported SshRsa "root" (Context hn)
 		`requires` Ssh.knownHost hosts "turtle.kitenet.net" "root"
 	, trivial $ cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]
 	]
+  where
+	hn = "mumble.debian.net"
 
 obnamLowMem :: Property
 obnamLowMem = combineProperties "obnam tuned for low memory use"
@@ -137,16 +145,16 @@ gitServer hosts = propertyList "git.kitenet.net setup"
 		, "--client-name=wren"
 		] Obnam.OnlyClient
 		`requires` Gpg.keyImported "1B169BE1" "root"
-		`requires` Ssh.keyImported SshRsa "root"
+		`requires` Ssh.keyImported SshRsa "root" (Context "git.kitenet.net")
 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
-		`requires` Ssh.authorizedKeys "family"
+		`requires` Ssh.authorizedKeys "family" (Context "git.kitenet.net")
 		`requires` User.accountFor "family"
 	, Apt.installed ["git", "rsync", "gitweb"]
 	-- backport avoids channel flooding on branch merge
 	, Apt.installedBackport ["kgb-client"]
 	-- backport supports ssh event notification
 	, Apt.installedBackport ["git-annex"]
-	, File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf"
+	, File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf" anyContext
 	, toProp $ Git.daemonRunning "/srv/git"
 	, "/etc/gitweb.conf" `File.containsLines`
 		[ "$projectroot = '/srv/git';"
@@ -198,7 +206,7 @@ annexWebSite hosts origin hn uuid remotes = propertyList (hn ++" website using g
 	dir = "/srv/web/" ++ hn
 	postupdatehook = dir </> ".git/hooks/post-update"
 	setup = userScriptProperty "joey" setupscript
-		`requires` Ssh.keyImported SshRsa "joey"
+		`requires` Ssh.keyImported SshRsa "joey" (Context hn)
 		`requires` Ssh.knownHost hosts "turtle.kitenet.net" "joey"
 	setupscript = 
 		[ "cd " ++ shellEscape dir
@@ -266,9 +274,9 @@ mainhttpscert True =
 gitAnnexDistributor :: Property
 gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer"
 	[ Apt.installed ["rsync"]
-	, File.hasPrivContent "/etc/rsyncd.conf"
+	, File.hasPrivContent "/etc/rsyncd.conf" (Context "git-annex distributor")
 		`onChange` Service.restarted "rsync"
-	, File.hasPrivContent "/etc/rsyncd.secrets"
+	, File.hasPrivContent "/etc/rsyncd.secrets" (Context "git-annex distributor")
 		`onChange` Service.restarted "rsync"
 	, "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true"
 		`onChange` Service.running "rsync"
@@ -310,10 +318,13 @@ ircBouncer :: Property
 ircBouncer = propertyList "IRC bouncer"
 	[ Apt.installed ["znc"]
 	, User.accountFor "znc"
-	, File.hasPrivContent conf
+	, File.dirExists (parentDir conf)
+	, File.hasPrivContent conf anyContext
 	, File.ownerGroup conf "znc" "znc"
 	, Cron.job "znconboot" "@reboot" "znc" "~" "znc"
-	, Cron.job "zncrunning" "@hourly" "znc" "~" "znc || true"
+	-- ensure running if it was not already
+	, trivial $ userScriptProperty "znc" ["znc || true"]
+		`describe` "znc running"
 	]
   where
 	conf = "/home/znc/.znc/configs/znc.conf"
@@ -335,7 +346,7 @@ githubBackup :: Property
 githubBackup = propertyList "github-backup box"
 	[ Apt.installed ["github-backup", "moreutils"]
 	, let f = "/home/joey/.github-keys"
-	  in File.hasPrivContent f
+	  in File.hasPrivContent f anyContext
 		`onChange` File.ownerGroup f "joey" "joey"
 	]
 
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 061f440c..5a260476 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -5,6 +5,7 @@ module Propellor.Property.Ssh (
 	hasAuthorizedKeys,
 	restartSshd,
 	randomHostKeys,
+	hostKeys,
 	hostKey,
 	keyImported,
 	knownHost,
@@ -72,46 +73,54 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 			[ Param "-c"
 			, Param "rm -f /etc/ssh/ssh_host_*"
 			]
-		ensureProperty $
-			cmdProperty "/var/lib/dpkg/info/openssh-server.postinst"
-				["configure"]
+		ensureProperty $ scriptProperty 
+			[ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
 
--- | Sets ssh host keys from the site's PrivData.
--- 
--- (Uses a null username for host keys.)
-hostKey :: SshKeyType -> Property
-hostKey keytype = combineProperties desc
-	[ property desc (install writeFile (SshPubKey keytype "") ".pub")
-	, property desc (install writeFileProtected (SshPrivKey keytype "") "")
+-- | Sets all types of ssh host keys from the privdata.
+hostKeys :: Context -> Property
+hostKeys ctx = propertyList "known ssh host keys"
+	[ hostKey SshDsa ctx
+	, hostKey SshRsa ctx
+	, hostKey SshEcdsa ctx
+	]
+
+-- | Sets a single ssh host key from the privdata.
+hostKey :: SshKeyType -> Context -> Property
+hostKey keytype context = combineProperties desc
+	[ installkey (SshPubKey keytype "")  (install writeFile ".pub")
+	, installkey (SshPrivKey keytype "") (install writeFileProtected "")
 	]
 	`onChange` restartSshd
   where
  	desc = "known ssh host key (" ++ fromKeyType keytype ++ ")"
-	install writer p ext = withPrivData p $ \key -> do
+	installkey p a = withPrivData p context $ \getkey ->
+		property desc $ getkey a
+	install writer ext key = do
 		let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
 		s <- liftIO $ readFileStrict f
 		if s == key
 			then noChange
 			else makeChange $ writer f key
 
--- | Sets up a user with a ssh private key and public key pair
--- from the site's PrivData.
-keyImported :: SshKeyType -> UserName -> Property
-keyImported keytype user = combineProperties desc
-	[ property desc (install writeFile (SshPubKey keytype user) ".pub")
-	, property desc (install writeFileProtected (SshPrivKey keytype user) "")
+-- | Sets up a user with a ssh private key and public key pair from the
+-- PrivData.
+keyImported :: SshKeyType -> UserName -> Context -> Property
+keyImported keytype user context = combineProperties desc
+	[ installkey (SshPubKey keytype user) (install writeFile ".pub")
+	, installkey (SshPrivKey keytype user) (install writeFileProtected "")
 	]
   where
 	desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"
-	install writer p ext = do
+	installkey p a = withPrivData p context $ \getkey ->
+		property desc $ getkey a
+	install writer ext key = do
 		f <- liftIO $ keyfile ext
 		ifM (liftIO $ doesFileExist f)
 			( noChange
 			, ensureProperties
-				[ property desc $ 
-					withPrivData p $ \key -> makeChange $ do
-						createDirectoryIfMissing True (takeDirectory f)
-						writer f key
+				[ property desc $ makeChange $ do
+					createDirectoryIfMissing True (takeDirectory f)
+					writer f key
 				, File.ownerGroup f user user
 				, File.ownerGroup (takeDirectory f) user user
 				]
@@ -144,9 +153,9 @@ knownHost hosts hn user = property desc $
 		return FailedChange
 
 -- | Makes a user have authorized_keys from the PrivData
-authorizedKeys :: UserName -> Property
-authorizedKeys user = property (user ++ " has authorized_keys") $
-	withPrivData (SshAuthorizedKeys user) $ \v -> do
+authorizedKeys :: UserName -> Context -> Property
+authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get ->
+	property (user ++ " has authorized_keys") $ get $ \v -> do
 		f <- liftIO $ dotFile "authorized_keys" user
 		liftIO $ do
 			createDirectoryIfMissing True (takeDirectory f)
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index eef2a57e..f9c400a8 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -24,17 +24,18 @@ nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "use
 
 -- | Only ensures that the user has some password set. It may or may
 -- not be the password from the PrivData.
-hasSomePassword :: UserName -> Property
-hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
-	hasPassword user
+hasSomePassword :: UserName -> Context -> Property
+hasSomePassword user context = check ((/= HasPassword) <$> getPasswordStatus user) $
+	hasPassword user context
 
-hasPassword :: UserName -> Property
-hasPassword user = property (user ++ " has password") $
-	withPrivData (Password user) $ \password -> makeChange $
-		withHandle StdinHandle createProcessSuccess
-			(proc "chpasswd" []) $ \h -> do
-				hPutStrLn h $ user ++ ":" ++ password
-				hClose h
+hasPassword :: UserName -> Context -> Property
+hasPassword user context = withPrivData (Password user) context $ \getpassword ->
+	property (user ++ " has password") $ 
+		getpassword $ \password -> makeChange $
+			withHandle StdinHandle createProcessSuccess
+				(proc "chpasswd" []) $ \h -> do
+					hPutStrLn h $ user ++ ":" ++ password
+					hClose h
 
 lockedPassword :: UserName -> Property
 lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"