propellor spin

config-joey.hs

@@ -72,14 +72,15 @@ hosts =                 --                  (o)  `
 		& Apt.buildDep ["git-annex"] `period` Daily
 	
 	-- Important stuff that needs not too much memory or CPU.
-  	, standardSystem "diatom.kitenet.net" Stable "amd64"
+  	, let ctx = Context "diatom.kitenet.net "
+	  in standardSystem "diatom.kitenet.net" Stable "amd64"
 		& ipv4 "107.170.31.195"
 
 		& DigitalOcean.distroKernel
 		& Hostname.sane
-		& Ssh.hostKey SshDsa
+		& Ssh.hostKey SshDsa ctx
-		& Ssh.hostKey SshRsa
+		& Ssh.hostKey SshRsa ctx
-		& Ssh.hostKey SshEcdsa
+		& Ssh.hostKey SshEcdsa ctx
 		& Apt.unattendedUpgrades
 		& Apt.serviceInstalledRunning "ntp"
 		& Postfix.satellite
@@ -89,9 +90,9 @@ hosts =                 --                  (o)  `
 		& Apt.serviceInstalledRunning "swapspace"
 	
 		& Apt.serviceInstalledRunning "apache2"
-		& File.hasPrivContent "/etc/ssl/certs/web.pem"
+		& File.hasPrivContent "/etc/ssl/certs/web.pem" (Context "kitenet.net")
-		& File.hasPrivContent "/etc/ssl/private/web.pem"
+		& File.hasPrivContent "/etc/ssl/private/web.pem" (Context "kitenet.net")
-		& File.hasPrivContent "/etc/ssl/certs/startssl.pem"
+		& File.hasPrivContent "/etc/ssl/certs/startssl.pem" (Context "kitenet.net")
 		& Apache.modEnabled "ssl"
 		& Apache.multiSSL
 		& File.ownerGroup "/srv/web" "joey" "joey"
@@ -133,16 +134,17 @@ hosts =                 --                  (o)  `
 		& Dns.secondaryFor ["animx"] hosts "animx.eu.org"
 
 	-- storage and backup server
-	, standardSystem "elephant.kitenet.net" Unstable "amd64"
+	, let ctx = Context "elephant.kitenet.net"
+	  in standardSystem "elephant.kitenet.net" Unstable "amd64"
 		& ipv4 "193.234.225.114"
 
 		& Hostname.sane
 		& Postfix.satellite
 		& Apt.unattendedUpgrades
-		& Ssh.hostKey SshDsa
+		& Ssh.hostKey SshDsa ctx
-		& Ssh.hostKey SshRsa
+		& Ssh.hostKey SshRsa ctx
-		& Ssh.hostKey SshEcdsa
+		& Ssh.hostKey SshEcdsa ctx
-		& Ssh.keyImported SshRsa "joey"
+		& Ssh.keyImported SshRsa "joey" ctx
 
 		-- PV-grub chaining
 		-- http://notes.pault.ag/linode-pv-grub-chainning/
@@ -263,13 +265,13 @@ standardSystem hn suite arch = host hn
 	& Apt.installed ["etckeeper"]
 	& Apt.installed ["ssh"]
 	& GitHome.installedFor "root"
-	& User.hasSomePassword "root"
+	& User.hasSomePassword "root" (Context hn)
 	-- Harden the system, but only once root's authorized_keys
 	-- is safely in place.
 	& check (Ssh.hasAuthorizedKeys "root")
 		(Ssh.passwordAuthentication False)
 	& User.accountFor "joey"
-	& User.hasSomePassword "joey"
+	& User.hasSomePassword "joey" (Context hn)
 	& Sudo.enabledFor "joey"
 	& GitHome.installedFor "joey"
 	& Apt.installed ["vim", "screen", "less"]

debian/changelog

@@ -1,7 +1,14 @@
-propellor (0.7.1) UNRELEASED; urgency=medium
+propellor (0.8.0) UNRELEASED; urgency=medium
+
+  * Completely reworked privdata storage. There is now a single file,
+    and each host is sent only the privdata that its Properties actually use.
+
+    To transition existing privdata, run propellor against a host and
+    watch out for the red failure messages, and run the suggested commands
+    to store the privdata using the new storage scheme.
 
   * Add --edit to edit a privdata value in $EDITOR.
-  * Add --list-fields to list a host's currently set privdata fields.
+  * Add --list-fields to list all currently set privdata fields.
   * Fix randomHostKeys property to run openssh-server's postinst in a
     non-failing way.
   * Hostname.sane now cleans up the 127.0.0.1 localhost line in /etc/hosts,

doc/security.mdwn

@@ -27,10 +27,11 @@ Since the propoellor git repository is public, you can't store
 in cleartext private data such as passwords, ssh private keys, etc.
 
 Instead, `propellor --spin $host` looks for a
-`~/.propellor/privdata/$host.gpg` file and if found decrypts it and sends
+`~/.propellor/privdata/privdata.gpg` file and if found decrypts it,
-it to the remote host using ssh. This lets a remote host know its own
+extracts the private that that the $host needs, and sends it to to the
-private data, without seeing all the rest.
+$host using ssh. This lets a host know its own private data, without
+seeing all the rest.
 
-To securely store private data, use: `propellor --set $host $field`
+To securely store private data, use: `propellor --set $field $context`
-The field name will be something like 'Password "root"'; see PrivData.hs
+Propellor will tell you the details when you use a Property that needs
-for available fields.
+PrivData.

propellor.cabal

@@ -105,6 +105,7 @@ Library
     Propellor.Types
     Propellor.Types.OS
     Propellor.Types.Dns
+    Propellor.Types.PrivData
   Other-Modules:
     Propellor.Types.Info
     Propellor.CmdLine

src/Propellor/CmdLine.hs

@@ -27,10 +27,10 @@ usage = do
 		, "  propellor hostname"
 		, "  propellor --spin hostname"
 		, "  propellor --add-key keyid"
-		, "  propellor --set hostname field"
+		, "  propellor --set field context"
-		, "  propellor --dump hostname field"
+		, "  propellor --dump field context"
-		, "  propellor --edit hostname field"
+		, "  propellor --edit field context"
-		, "  propellor --list-fields hostname"
+		, "  propellor --list-fields"
 		]
 	exitFailure
 
@@ -41,10 +41,10 @@ processCmdLine = go =<< getArgs
   	go ("--spin":h:[]) = return $ Spin h
   	go ("--boot":h:[]) = return $ Boot h
 	go ("--add-key":k:[]) = return $ AddKey k
-	go ("--set":h:f:[]) = withprivfield f (return . Set h)
+	go ("--set":f:c:[]) = withprivfield f c Set
-	go ("--dump":h:f:[]) = withprivfield f (return . Dump h)
+	go ("--dump":f:c:[]) = withprivfield f c Dump
-	go ("--edit":h:f:[]) = withprivfield f (return . Edit h)
+	go ("--edit":f:c:[]) = withprivfield f c Edit
-	go ("--list-fields":h:[]) = return $ ListFields h
+	go ("--list-fields":[]) = return ListFields
 	go ("--continue":s:[]) = case readish s of
 		Just cmdline -> return $ Continue cmdline
 		Nothing -> errorMessage "--continue serialization failure"
@@ -60,8 +60,8 @@ processCmdLine = go =<< getArgs
 			else return $ Run s
 	go _ = usage
 
-	withprivfield s f = case readish s of
+	withprivfield s c f = case readish s of
-		Just pf -> f pf
+		Just pf -> return $ f pf (Context c)
 		Nothing -> errorMessage $ "Unknown privdata field " ++ s
 
 defaultMain :: [Host] -> IO ()
@@ -73,10 +73,10 @@ defaultMain hostlist = do
 	go True cmdline
   where
 	go _ (Continue cmdline) = go False cmdline
-	go _ (Set hn field) = setPrivData hn field
+	go _ (Set field context) = setPrivData field context
-	go _ (Dump hn field) = dumpPrivData hn field
+	go _ (Dump field context) = dumpPrivData field context
-	go _ (Edit hn field) = editPrivData hn field
+	go _ (Edit field context) = editPrivData field context
-	go _ (ListFields hn) = listPrivDataFields hn
+	go _ ListFields = listPrivDataFields
 	go _ (AddKey keyid) = addKey keyid
 	go _ (Chain hn) = withhost hn $ \h -> do
 		r <- runPropellor h $ ensureProperties $ hostProperties h
@@ -182,11 +182,11 @@ spin hn = do
 	void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
 	void $ boolSystem "git" [Param "push"]
 	cacheparams <- toCommand <$> sshCachingParams hn
-	go cacheparams url =<< gpgDecrypt (privDataFile hn)
+	go cacheparams url =<< gpgDecrypt privDataFile
   where
 	go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
 		let finish = do
-			senddata toh (privDataFile hn) privDataMarker privdata
+			senddata toh privDataLocal privDataMarker privdata
 			hClose toh
 			
 			-- Display remaining output.

src/Propellor/PrivData.hs

@@ -2,18 +2,20 @@
 
 module Propellor.PrivData where
 
-import qualified Data.Map as M
 import Control.Applicative
 import System.FilePath
 import System.IO
 import System.Directory
 import Data.Maybe
-import Data.List
+import Data.Monoid
 import Control.Monad
 import Control.Monad.IfElse
 import "mtl" Control.Monad.Reader
+import qualified Data.Map as M
+import qualified Data.Set as S
 
 import Propellor.Types
+import Propellor.Types.Info
 import Propellor.Message
 import Utility.Monad
 import Utility.PartialPrelude
@@ -25,40 +27,57 @@ import Utility.Misc
 import Utility.FileMode
 import Utility.Env
 
--- | When the specified PrivDataField is available on the host Propellor
+-- | Allows a Property to access the value of a specific PrivDataField,
--- is provisioning, it provies the data to the action. Otherwise, it prints
+-- for use in a specific Context.
--- a message to help the user make the necessary private data available.
+--
-withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Result
+-- Example use:
-withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
+--
+-- > withPrivData (PrivFile pemfile) (Context "joeyh.name") $ \getdata ->
+-- >     property "joeyh.name ssl cert" $ getdata $ \privdata ->
+-- >       liftIO $ writeFile pemfile privdata
+-- >   where pemfile = "/etc/ssl/certs/web.pem"
+-- 
+-- Note that if the value is not available, the action is not run
+-- and instead it prints a message to help the user make the necessary
+-- private data available.
+withPrivData
+	:: PrivDataField
+	-> Context
+	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
+	-> Property
+withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a ->
+	maybe missing a =<< liftIO (getLocalPrivData field context)
   where
-	missing = do
+	missing = liftIO $ do
-		host <- asks hostName
+		warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")"
-		let host' = if ".docker" `isSuffixOf` host
+		putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"
-			then "$parent_host"
-			else host
-		liftIO $ do
-			warningMessage $ "Missing privdata " ++ show field
-			putStrLn $ "Fix this by running: propellor --set "++host'++" '" ++ show field ++ "'"
 		return FailedChange
+	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, context) } }
 
-getPrivData :: PrivDataField -> IO (Maybe String)
+{- Gets the requested field's value, in the specified context if it's
-getPrivData field = do
+ - available, from the host's local privdata cache. -}
-	m <- catchDefaultIO Nothing $ readish <$> readFile privDataLocal
+getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData)
-	return $ maybe Nothing (M.lookup field) m
+getLocalPrivData field context =
+	getPrivData field context . fromMaybe M.empty <$> localcache
+  where
+	localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal
 
-setPrivData :: HostName -> PrivDataField -> IO ()
+getPrivData :: PrivDataField -> Context -> (M.Map (PrivDataField, Context) PrivData) -> Maybe PrivData
-setPrivData host field = do
+getPrivData field context = M.lookup (field, context)
+
+setPrivData :: PrivDataField -> Context -> IO ()
+setPrivData field context = do
 	putStrLn "Enter private data on stdin; ctrl-D when done:"
-	setPrivDataTo host field =<< hGetContentsStrict stdin
+	setPrivDataTo field context =<< hGetContentsStrict stdin
 
-dumpPrivData :: HostName -> PrivDataField -> IO ()
+dumpPrivData :: PrivDataField -> Context -> IO ()
-dumpPrivData host field =
+dumpPrivData field context =
 	maybe (error "Requested privdata is not set.") putStrLn
-		=<< getPrivDataFor host field
+		=<< (getPrivData field context <$> decryptPrivData)
 
-editPrivData :: HostName -> PrivDataField -> IO ()
+editPrivData :: PrivDataField -> Context -> IO ()
-editPrivData host field = do
+editPrivData field context = do
-	v <- getPrivDataFor host field
+	v <- getPrivData field context <$> decryptPrivData
 	v' <- withTmpFile "propellorXXXX" $ \f h -> do
 		hClose h
 		maybe noop (writeFileProtected f) v
@@ -66,35 +85,30 @@ editPrivData host field = do
 		unlessM (boolSystem editor [File f]) $
 			error "Editor failed; aborting."
 		readFile f
-	setPrivDataTo host field v'
+	setPrivDataTo field context v'
 
-listPrivDataFields :: HostName -> IO ()
+listPrivDataFields :: IO ()
-listPrivDataFields host = do
+listPrivDataFields = do
-	putStrLn (host ++ "'s currently set privdata fields:")
+	putStrLn ("All currently set privdata fields:")
-	mapM_ list . M.keys =<< decryptPrivData host
+	mapM_ list . M.keys =<< decryptPrivData
   where
 	list = putStrLn . ("\t" ++) . shellEscape . show
 
-setPrivDataTo :: HostName -> PrivDataField -> String -> IO ()
+setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
-setPrivDataTo host field value = do
+setPrivDataTo field context value = do
 	makePrivDataDir
-	let f = privDataFile host
+	m <- decryptPrivData
-	m <- decryptPrivData host
+	let m' = M.insert (field, context) (chomp value) m
-	let m' = M.insert field (chomp value) m
+	gpgEncrypt privDataFile (show m')
-	gpgEncrypt f (show m')
 	putStrLn "Private data set."
-	void $ boolSystem "git" [Param "add", File f]
+	void $ boolSystem "git" [Param "add", File privDataFile]
   where
 	chomp s
 		| end s == "\n" = chomp (beginning s)
 		| otherwise = s
 
-getPrivDataFor :: HostName -> PrivDataField -> IO (Maybe String)
+decryptPrivData :: IO (M.Map (PrivDataField, Context) PrivData)
-getPrivDataFor host field = M.lookup field <$> decryptPrivData host
+decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile
-
-decryptPrivData :: HostName -> IO (M.Map PrivDataField String)
-decryptPrivData host = fromMaybe M.empty . readish
-	<$> gpgDecrypt (privDataFile host)
 
 makePrivDataDir :: IO ()
 makePrivDataDir = createDirectoryIfMissing False privDataDir
@@ -102,8 +116,8 @@ makePrivDataDir = createDirectoryIfMissing False privDataDir
 privDataDir :: FilePath
 privDataDir = "privdata"
 
-privDataFile :: HostName -> FilePath
+privDataFile :: FilePath
-privDataFile host = privDataDir </> host ++ ".gpg"
+privDataFile = privDataDir </> "privdata.gpg"
 
 privDataLocal :: FilePath
 privDataLocal = privDataDir </> "local"

src/Propellor/Property/Docker.hs

@@ -55,9 +55,10 @@ 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 $ 
+	prop = withPrivData DockerAuthentication anyContext $ \getcfg ->
+		property "docker configured" $ getcfg $ \cfg -> ensureProperty $ 
 			"/root/.dockercfg" `File.hasContent` (lines cfg)
 
 -- | A short descriptive name for a container.

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 :: FilePath -> Context -> Property
-hasPrivContent f = property desc $ withPrivData (PrivFile f) $ \privcontent -> 
+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 :: FilePath -> Context -> Property
-hasPrivContentExposed f = hasPrivContent f `onChange`
+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.

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,14 +23,15 @@ 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 $
+	prop = withPrivData GpgKey (Context keyid) $ \getkey ->
+		property desc $ getkey $ \key -> makeChange $
 			withHandle StdinHandle createProcessSuccess
 				(proc "su" ["-c", "gpg --import", user]) $ \h -> do
 					fileEncoding h

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 $
+	identfile u = File.hasPrivContentExposed
-		concat $ [ "/var/lib/simpleid/identities/", u, ".identity" ]
+		(concat [ "/var/lib/simpleid/identities/", u, ".identity" ])
+		(Context baseurl)

src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs

@@ -23,29 +23,25 @@ builddir = gitbuilderdir </> "build"
 
 type TimeOut = String -- eg, 5h
 
-autobuilder :: CronTimes -> TimeOut -> Bool -> Property
+autobuilder :: Architecture -> CronTimes -> TimeOut -> Property
-autobuilder crontimes timeout rsyncupload = combineProperties "gitannexbuilder"
+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
+	, withPrivData (Password builduser) context $ \getpw ->
-		let f = homedir </> "rsyncpassword"
+		property "rsync password" $ getpw $ \pw -> do
-		if rsyncupload 
+			oldpw <- liftIO $ catchDefaultIO "" $
-			then withPrivData (Password builduser) $ \p -> do
+				readFileStrict pwfile
-				oldp <- liftIO $ catchDefaultIO "" $
+			if pw /= oldpw
-					readFileStrict f
+				then makeChange $ writeFile pwfile pw
-				if p /= oldp
-					then makeChange $ writeFile f p
 				else noChange
-			else do
-				ifM (liftIO $ doesFileExist f)
-					( noChange
-					, makeChange $ writeFile f "no password configured"
-					)
 	]
+  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

src/Propellor/Property/SiteSpecific/JoeySites.hs

@@ -29,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
@@ -97,7 +97,7 @@ 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"
+			, File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
 				`onChange` Service.restarted "kgb-bot"
 			, "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
 				`describe` "kgb bot enabled"
@@ -108,17 +108,19 @@ kgbServer = withOS desc $ \o -> case o of
 	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"
@@ -141,16 +143,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';"
@@ -202,7 +204,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
@@ -270,9 +272,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"
@@ -315,7 +317,7 @@ ircBouncer = propertyList "IRC bouncer"
 	[ Apt.installed ["znc"]
 	, User.accountFor "znc"
 	, File.dirExists (parentDir conf)
-	, File.hasPrivContent conf
+	, File.hasPrivContent conf anyContext
 	, File.ownerGroup conf "znc" "znc"
 	, Cron.job "znconboot" "@reboot" "znc" "~" "znc"
 	-- ensure running if it was not already
@@ -341,7 +343,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"
 	]
 

src/Propellor/Property/Ssh.hs

@@ -75,40 +75,41 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 		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.
+-- | Sets ssh host keys.
--- 
+hostKey :: SshKeyType -> Context -> Property
--- (Uses a null username for host keys.)
+hostKey keytype context = combineProperties desc
-hostKey :: SshKeyType -> Property
+	[ installkey (SshPubKey keytype "")  (install writeFile ".pub")
-hostKey keytype = combineProperties desc
+	, installkey (SshPrivKey keytype "") (install writeFileProtected "")
-	[ property desc (install writeFile (SshPubKey keytype "") ".pub")
-	, property desc (install writeFileProtected (SshPrivKey keytype "") "")
 	]
 	`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
+-- | Sets up a user with a ssh private key and public key pair from the
--- from the site's PrivData.
+-- PrivData.
-keyImported :: SshKeyType -> UserName -> Property
+keyImported :: SshKeyType -> UserName -> Context -> Property
-keyImported keytype user = combineProperties desc
+keyImported keytype user context = combineProperties desc
-	[ property desc (install writeFile (SshPubKey keytype user) ".pub")
+	[ installkey (SshPubKey keytype user) (install writeFile ".pub")
-	, property desc (install writeFileProtected (SshPrivKey keytype user) "")
+	, 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 $ 
+				[ property desc $ makeChange $ do
-					withPrivData p $ \key -> makeChange $ do
 					createDirectoryIfMissing True (takeDirectory f)
 					writer f key
 				, File.ownerGroup f user user
@@ -143,9 +144,9 @@ knownHost hosts hn user = property desc $
 		return FailedChange
 
 -- | Makes a user have authorized_keys from the PrivData
-authorizedKeys :: UserName -> Property
+authorizedKeys :: UserName -> Context -> Property
-authorizedKeys user = property (user ++ " has authorized_keys") $
+authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get ->
-	withPrivData (SshAuthorizedKeys user) $ \v -> do
+	property (user ++ " has authorized_keys") $ get $ \v -> do
 		f <- liftIO $ dotFile "authorized_keys" user
 		liftIO $ do
 			createDirectoryIfMissing True (takeDirectory f)

src/Propellor/Property/User.hs

@@ -24,13 +24,14 @@ 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 :: UserName -> Context -> Property
-hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
+hasSomePassword user context = check ((/= HasPassword) <$> getPasswordStatus user) $
-	hasPassword user
+	hasPassword user context
 
-hasPassword :: UserName -> Property
+hasPassword :: UserName -> Context -> Property
-hasPassword user = property (user ++ " has password") $
+hasPassword user context = withPrivData (Password user) context $ \getpassword ->
-	withPrivData (Password user) $ \password -> makeChange $
+	property (user ++ " has password") $ 
+		getpassword $ \password -> makeChange $
 			withHandle StdinHandle createProcessSuccess
 				(proc "chpasswd" []) $ \h -> do
 					hPutStrLn h $ user ++ ":" ++ password

src/Propellor/Types.hs

@@ -17,7 +17,9 @@ module Propellor.Types
 	, ActionResult(..)
 	, CmdLine(..)
 	, PrivDataField(..)
-	, GpgKeyId
+	, PrivData
+	, Context(..)
+	, anyContext
 	, SshKeyType(..)
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
@@ -32,6 +34,7 @@ import "MonadCatchIO-transformers" Control.Monad.CatchIO
 import Propellor.Types.Info
 import Propellor.Types.OS
 import Propellor.Types.Dns
+import Propellor.Types.PrivData
 
 -- | Everything Propellor knows about a system: Its hostname,
 -- properties and other info.
@@ -135,30 +138,12 @@ data CmdLine
 	= Run HostName
 	| Spin HostName
 	| Boot HostName
-	| Set HostName PrivDataField
+	| Set PrivDataField Context
-	| Dump HostName PrivDataField
+	| Dump PrivDataField Context
-	| Edit HostName PrivDataField
+	| Edit PrivDataField Context
-	| ListFields HostName
+	| ListFields
 	| AddKey String
 	| Continue CmdLine
 	| Chain HostName
 	| Docker HostName
   deriving (Read, Show, Eq)
-
--- | Note that removing or changing field names will break the
--- serialized privdata files, so don't do that!
--- It's fine to add new fields.
-data PrivDataField
-	= DockerAuthentication
-	| SshPubKey SshKeyType UserName
-	| SshPrivKey SshKeyType UserName
-	| SshAuthorizedKeys UserName
-	| Password UserName
-	| PrivFile FilePath
-	| GpgKey GpgKeyId
-	deriving (Read, Show, Ord, Eq)
-
-type GpgKeyId = String
-
-data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
-	deriving (Read, Show, Ord, Eq)

src/Propellor/Types/Info.hs

@@ -1,6 +1,7 @@
 module Propellor.Types.Info where
 
 import Propellor.Types.OS
+import Propellor.Types.PrivData
 import qualified Propellor.Types.Dns as Dns
 
 import qualified Data.Set as S
@@ -9,6 +10,7 @@ import Data.Monoid
 -- | Information about a host.
 data Info = Info
 	{ _os :: Val System
+	, _privDataFields :: S.Set (PrivDataField, Context)
 	, _sshPubKey :: Val String
 	, _dns :: S.Set Dns.Record
 	, _namedconf :: Dns.NamedConfMap
@@ -17,9 +19,10 @@ data Info = Info
 	deriving (Eq, Show)
 
 instance Monoid Info where
-	mempty = Info mempty mempty mempty mempty mempty
+	mempty = Info mempty mempty mempty mempty mempty mempty
 	mappend old new = Info
 		{ _os = _os old <> _os new
+		, _privDataFields = _privDataFields old <> _privDataFields new
 		, _sshPubKey = _sshPubKey old <> _sshPubKey new
 		, _dns = _dns old <> _dns new
 		, _namedconf = _namedconf old <> _namedconf new

src/Propellor/Types/PrivData.hs

@@ -0,0 +1,34 @@
+module Propellor.Types.PrivData where
+
+import Propellor.Types.OS
+
+-- | Note that removing or changing field names will break the
+-- serialized privdata files, so don't do that!
+-- It's fine to add new fields.
+data PrivDataField
+	= DockerAuthentication
+	| SshPubKey SshKeyType UserName
+	| SshPrivKey SshKeyType UserName
+	| SshAuthorizedKeys UserName
+	| Password UserName
+	| PrivFile FilePath
+	| GpgKey
+	deriving (Read, Show, Ord, Eq)
+
+-- | Context in which a PrivDataField is used.
+--
+-- Often this will be a domain name. For example, 
+-- Context "www.example.com" could be used for the SSL cert
+-- for the web server serving that domain. Multiple hosts might
+-- use that privdata.
+newtype Context = Context String
+	deriving (Read, Show, Ord, Eq)
+
+-- | Use when a PrivDataField is not dependent on any paricular context.
+anyContext :: Context
+anyContext = Context "any"
+
+type PrivData = String
+
+data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
+	deriving (Read, Show, Ord, Eq)