propellor 0.7.0 → 0.8.0

raw patch · 22 files changed

+457/−245 lines, 22 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +26/−0
• Makefile +3/−1
• config-joey.hs +53/−51
• config-simple.hs +1/−1
• debian/changelog +26/−0
• propellor.cabal +3/−1
• src/Propellor/CmdLine.hs +23/−15
• src/Propellor/PrivData.hs +109/−38
• src/Propellor/Property/Docker.hs +14/−10
• src/Propellor/Property/File.hs +7/−6
• src/Propellor/Property/Gpg.hs +10/−7
• src/Propellor/Property/Hostname.hs +16/−10
• src/Propellor/Property/OpenId.hs +3/−2
• src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +17/−21
• src/Propellor/Property/SiteSpecific/JoeySites.hs +35/−24
• src/Propellor/Property/Ssh.hs +25/−25
• src/Propellor/Property/User.hs +11/−10
• src/Propellor/Types.hs +8/−21
• src/Propellor/Types/Info.hs +4/−1
• src/Propellor/Types/PrivData.hs +34/−0
• src/Utility/Table.hs +28/−0
• src/config.hs +1/−1

@@ -1,3 +1,29 @@+propellor (0.8.0) unstable; 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. You may find+    it useful to run the old version of propellor to extract data from the old+    privdata files during this migration.++    Several properties that use privdata now require a context to be+    specified. If in doubt, you can use anyContext, or+    Context "hostname.example.com"++  * Add --edit to edit a privdata value in $EDITOR.+  * Add --list-fields to list all currently set privdata fields, along with+    the hosts that use them.+  * 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,+    to avoid eg, apache complaining "Could not reliably determine the+    server's fully qualified domain name".++ -- Joey Hess <joeyh@debian.org>  Sun, 06 Jul 2014 18:28:08 -0400+ propellor (0.7.0) unstable; urgency=medium    * combineProperties no longer stops when a property fails; now it continues

@@ -1,5 +1,7 @@ CABAL?=cabal +DEBDEPS=gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev libghc-quickcheck2-dev libghc-mtl-dev libghc-monadcatchio-transformers-dev+ run: deps build 	./propellor @@ -10,7 +12,7 @@ 	ln -sf dist/build/propellor-config/propellor-config propellor  deps:-	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev libghc-quickcheck2-dev libghc-mtl-dev libghc-monadcatchio-transformers-dev; fi || true+	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install $(DEBDEPS) || (apt-get update && apt-get --no-upgrade --no-install-recommends -y install $(DEBDEPS)); fi || true 	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev || (cabal update; cabal install async); fi || true  dist/setup-config: propellor.cabal

@@ -42,49 +42,18 @@ 		& Docker.configured 		& Docker.docked hosts "android-git-annex" -	-- Nothing super-important lives here and mostly it's docker containers.+	-- Unreliable server. 	, standardSystem "clam.kitenet.net" Unstable "amd64"-		& ipv4 "162.248.143.249"-		& ipv6 "2002:5044:5531::1"+		& ipv4 "162.248.9.29"  		& CloudAtCost.decruft 		& Apt.unattendedUpgrades 		& Network.ipv6to4 		& Tor.isBridge 		& Postfix.satellite-		& Docker.configured -		& Docker.docked hosts "oldusenet-shellbox"-		& Docker.docked hosts "openid-provider"-		 	`requires` Apt.serviceInstalledRunning "ntp"-		& Docker.docked hosts "ancient-kitenet"--		-- I'd rather this were on diatom, but it needs unstable.-		& alias "kgb.kitenet.net"-		& JoeySites.kgbServer--		& alias "mumble.kitenet.net"-		& JoeySites.mumbleServer hosts-		-		& alias "ns9.kitenet.net"-		& myDnsSecondary-		-		& alias "znc.kitenet.net"-		& JoeySites.ircBouncer--		-- For https port 443, shellinabox with ssh login to-		-- kitenet.net-		& alias "shell.kitenet.net"-		& JoeySites.kiteShellBox--		-- Nothing is using http port 80 on clam, so listen on-		-- that port for ssh, for traveling on bad networks that-		-- block 22.-		& "/etc/ssh/sshd_config" `File.containsLine` "Port 80"-			`onChange` Service.restarted "ssh"-+		& Docker.configured 		& Docker.garbageCollected `period` Daily-		& Apt.installed ["git-annex", "mtr", "screen"] 	 	-- Orca is the main git-annex build box. 	, standardSystem "orca.kitenet.net" Unstable "amd64"@@ -103,14 +72,15 @@ 		& 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 SshRsa-		& Ssh.hostKey SshEcdsa+		& Ssh.hostKey SshDsa ctx+		& Ssh.hostKey SshRsa ctx+		& Ssh.hostKey SshEcdsa ctx 		& Apt.unattendedUpgrades 		& Apt.serviceInstalledRunning "ntp" 		& Postfix.satellite@@ -120,9 +90,9 @@ 		& Apt.serviceInstalledRunning "swapspace" 	 		& Apt.serviceInstalledRunning "apache2"-		& File.hasPrivContent "/etc/ssl/certs/web.pem"-		& File.hasPrivContent "/etc/ssl/private/web.pem"-		& File.hasPrivContent "/etc/ssl/certs/startssl.pem"+		& File.hasPrivContent "/etc/ssl/certs/web.pem" (Context "kitenet.net")+		& File.hasPrivContent "/etc/ssl/private/web.pem" (Context "kitenet.net")+		& File.hasPrivContent "/etc/ssl/certs/startssl.pem" (Context "kitenet.net") 		& Apache.modEnabled "ssl" 		& Apache.multiSSL 		& File.ownerGroup "/srv/web" "joey" "joey"@@ -164,16 +134,17 @@ 		& 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 SshRsa-		& Ssh.hostKey SshEcdsa-		& Ssh.keyImported SshRsa "joey"+		& Ssh.hostKey SshDsa ctx+		& Ssh.hostKey SshRsa ctx+		& Ssh.hostKey SshEcdsa ctx+		& Ssh.keyImported SshRsa "joey" ctx  		-- PV-grub chaining 		-- http://notes.pault.ag/linode-pv-grub-chainning/@@ -191,6 +162,7 @@ 			[ "configfile (xen/xvda1)/boot/grub/grub.cfg" ] 		& Apt.installed ["grub-xen"] 		& flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(xen/xvda1)/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"  		& alias "eubackup.kitenet.net" 		& Apt.installed ["obnam", "sshfs", "rsync"]@@ -201,9 +173,39 @@ 		& alias "podcatcher.kitenet.net" 		& Apt.installed ["git-annex"] 		+		& alias "znc.kitenet.net"+		& JoeySites.ircBouncer++		-- I'd rather this were on diatom, but it needs unstable.+		& alias "kgb.kitenet.net"+		& JoeySites.kgbServer++		& alias "mumble.kitenet.net"+		& JoeySites.mumbleServer hosts+		+		& alias "ns3.kitenet.net"+		& myDnsSecondary+		 		& Docker.configured++		& Docker.docked hosts "oldusenet-shellbox"+		& Docker.docked hosts "openid-provider"+		 	`requires` Apt.serviceInstalledRunning "ntp"+		& Docker.docked hosts "ancient-kitenet"+ 		& Docker.garbageCollected `period` (Weekly (Just 1))+		+		-- For https port 443, shellinabox with ssh login to+		-- kitenet.net+		& alias "shell.kitenet.net"+		& JoeySites.kiteShellBox+		-- Nothing is using http port 80, so listen on+		-- that port for ssh, for traveling on bad networks that+		-- block 22.+		& "/etc/ssh/sshd_config" `File.containsLine` "Port 80"+			`onChange` Service.restarted "ssh" + 	    --'                        __|II|      ,. 	  ----                      __|II|II|__   (  \_,/\ 	 ------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/   __/ -'-.-'-.-'-.-'-.-'-@@ -264,13 +266,13 @@ 	& 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"]@@ -309,14 +311,14 @@ branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"  -- Currently using diatom (ns2) as primary with secondaries--- clam (ns9) and gandi.+-- elephant (ns3) and gandi. -- kite handles all mail. myDnsPrimary :: Domain -> [(BindDomain, Record)] -> RevertableProperty myDnsPrimary domain extras = Dns.primary hosts domain 	(Dns.mkSOA "ns2.kitenet.net" 100) $ 	[ (RootDomain, NS $ AbsDomain "ns2.kitenet.net")+	, (RootDomain, NS $ AbsDomain "ns3.kitenet.net") 	, (RootDomain, NS $ AbsDomain "ns6.gandi.net")-	, (RootDomain, NS $ AbsDomain "ns9.kitenet.net") 	, (RootDomain, MX 0 $ AbsDomain "kitenet.net") 	, (RootDomain, TXT "v=spf1 a ?all") 	] ++ extras@@ -377,7 +379,7 @@ 		 -   some static websites 		 - bitlbee 		 - prosody-		 -   (used by anna and daddy's git-annex)+		 -   (used by daddy's git-annex) 		 - named 		 -   (branchable is still pushing to here 		 -    (thinking it's ns2.branchable.com), but it's no

@@ -29,7 +29,7 @@ 		& Apt.unattendedUpgrades 		& Apt.installed ["etckeeper"] 		& Apt.installed ["ssh"]-		& User.hasSomePassword "root"+		& User.hasSomePassword "root" (Context "mybox.example.com") 		& Network.ipv6to4 		& File.dirExists "/var/www" 		& Docker.docked hosts "webserver"

@@ -1,3 +1,29 @@+propellor (0.8.0) unstable; 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. You may find+    it useful to run the old version of propellor to extract data from the old+    privdata files during this migration.++    Several properties that use privdata now require a context to be+    specified. If in doubt, you can use anyContext, or+    Context "hostname.example.com"++  * Add --edit to edit a privdata value in $EDITOR.+  * Add --list-fields to list all currently set privdata fields, along with+    the hosts that use them.+  * 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,+    to avoid eg, apache complaining "Could not reliably determine the+    server's fully qualified domain name".++ -- Joey Hess <joeyh@debian.org>  Sun, 06 Jul 2014 18:28:08 -0400+ propellor (0.7.0) unstable; urgency=medium    * combineProperties no longer stops when a property fails; now it continues

@@ -1,5 +1,5 @@ Name: propellor-Version: 0.7.0+Version: 0.8.0 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess <joey@kitenet.net>@@ -105,6 +105,7 @@     Propellor.Types     Propellor.Types.OS     Propellor.Types.Dns+    Propellor.Types.PrivData   Other-Modules:     Propellor.Types.Info     Propellor.CmdLine@@ -126,6 +127,7 @@     Utility.Process     Utility.SafeCommand     Utility.Scheduled+    Utility.Table     Utility.ThreadScheduler     Utility.Tmp     Utility.UserInfo

@@ -26,9 +26,11 @@ 		, "  propellor" 		, "  propellor hostname" 		, "  propellor --spin hostname"-		, "  propellor --set hostname field"-		, "  propellor --dump hostname field" 		, "  propellor --add-key keyid"+		, "  propellor --set field context"+		, "  propellor --dump field context"+		, "  propellor --edit field context"+		, "  propellor --list-fields" 		] 	exitFailure @@ -39,8 +41,10 @@   	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 ("--dump":h:f:[]) = withprivfield f (return . Dump h)+	go ("--set":f:c:[]) = withprivfield f c Set+	go ("--dump":f:c:[]) = withprivfield f c Dump+	go ("--edit":f:c:[]) = withprivfield f c Edit+	go ("--list-fields":[]) = return ListFields 	go ("--continue":s:[]) = case readish s of 		Just cmdline -> return $ Continue cmdline 		Nothing -> errorMessage "--continue serialization failure"@@ -56,8 +60,8 @@ 			else return $ Run s 	go _ = usage -	withprivfield s f = case readish s of-		Just pf -> f pf+	withprivfield s c f = case readish s of+		Just pf -> return $ f pf (Context c) 		Nothing -> errorMessage $ "Unknown privdata field " ++ s  defaultMain :: [Host] -> IO ()@@ -69,8 +73,10 @@ 	go True cmdline   where 	go _ (Continue cmdline) = go False cmdline-	go _ (Set hn field) = setPrivData hn field-	go _ (Dump hn field) = dumpPrivData hn field+	go _ (Set field context) = setPrivData field context+	go _ (Dump field context) = dumpPrivData field context+	go _ (Edit field context) = editPrivData field context+	go _ ListFields = listPrivDataFields hostlist 	go _ (AddKey keyid) = addKey keyid 	go _ (Chain hn) = withhost hn $ \h -> do 		r <- runPropellor h $ ensureProperties $ hostProperties h@@ -78,7 +84,7 @@ 	go _ (Docker hn) = Docker.chain hn 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline 	go True cmdline = updateFirst cmdline $ go False cmdline-	go False (Spin hn) = withhost hn $ const $ spin hn+	go False (Spin hn) = withhost hn $ spin hn 	go False (Run hn) = ifM ((==) 0 <$> getRealUserID) 		( onlyProcess $ withhost hn mainProperties 		, go True (Spin hn)@@ -170,17 +176,19 @@ getCurrentGitSha1 :: String -> IO String getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref] -spin :: HostName -> IO ()-spin hn = do+spin :: HostName -> Host -> IO ()+spin hn hst = do 	url <- getUrl 	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 =<< hostprivdata   where+	hostprivdata = show . filterPrivData hst <$> decryptPrivData+ 	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 "privdata" privDataMarker privdata 			hClose toh 			 			-- Display remaining output.@@ -222,8 +230,8 @@ 			Just status -> return status 	 	showremote s = putStrLn s-	senddata toh f marker s = void $-		actionMessage ("Sending " ++ f ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do+	senddata toh desc marker s = void $+		actionMessage ("Sending " ++ desc ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do 			sendMarked toh marker s 			return True 

@@ -2,18 +2,23 @@  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.Monoid import Data.List 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 Propellor.Info import Utility.Monad import Utility.PartialPrelude import Utility.Exception@@ -21,53 +26,119 @@ import Utility.Tmp import Utility.SafeCommand import Utility.Misc+import Utility.FileMode+import Utility.Env+import Utility.Table --- | When the specified PrivDataField is available on the host Propellor--- is provisioning, it provies the data to the action. Otherwise, it prints--- a message to help the user make the necessary private data available.-withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Result-withPrivData field a = maybe missing a =<< liftIO (getPrivData field)+type PrivMap = M.Map (PrivDataField, Context) PrivData++-- | Allows a Property to access the value of a specific PrivDataField,+-- for use in a specific Context.+--+-- Example use:+--+-- > 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.+--+-- The resulting Property includes Info about the PrivDataField+-- being used, which is necessary to ensure that the privdata is sent to+-- the remote host by propellor.+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-		host <- asks hostName-		let host' = if ".docker" `isSuffixOf` host-			then "$parent_host"-			else host-		liftIO $ do-			warningMessage $ "Missing privdata " ++ show field-			putStrLn $ "Fix this by running: propellor --set "++host'++" '" ++ show field ++ "'"-			return FailedChange+	missing = liftIO $ do+		warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")"+		putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"+		return FailedChange+	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, context) } } -getPrivData :: PrivDataField -> IO (Maybe String)-getPrivData field = do-	m <- catchDefaultIO Nothing $ readish <$> readFile privDataLocal-	return $ maybe Nothing (M.lookup field) m+addPrivDataField :: (PrivDataField, Context) -> Property+addPrivDataField v = pureInfoProperty (show v) $+	mempty { _privDataFields = S.singleton v } -setPrivData :: HostName -> PrivDataField -> IO ()-setPrivData host field = do+{- Gets the requested field's value, in the specified context if it's+ - available, from the host's local privdata cache. -}+getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData)+getLocalPrivData field context =+	getPrivData field context . fromMaybe M.empty <$> localcache+  where+	localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal++{- Get only the set of PrivData that the Host's Info says it uses. -}+filterPrivData :: Host -> PrivMap -> PrivMap+filterPrivData host = M.filterWithKey (\k _v -> S.member k used)+  where+	used = _privDataFields $ hostInfo host++getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData+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:"-	value <- chomp <$> hGetContentsStrict stdin+	setPrivDataTo field context =<< hGetContentsStrict stdin++dumpPrivData :: PrivDataField -> Context -> IO ()+dumpPrivData field context =+	maybe (error "Requested privdata is not set.") putStrLn+		=<< (getPrivData field context <$> decryptPrivData)++editPrivData :: PrivDataField -> Context -> IO ()+editPrivData field context = do+	v <- getPrivData field context <$> decryptPrivData+	v' <- withTmpFile "propellorXXXX" $ \f h -> do+		hClose h+		maybe noop (writeFileProtected f) v+		editor <- getEnvDefault "EDITOR" "vi"+		unlessM (boolSystem editor [File f]) $+			error "Editor failed; aborting."+		readFile f+	setPrivDataTo field context v'++listPrivDataFields :: [Host] -> IO ()+listPrivDataFields hosts = do+	m <- decryptPrivData+	putStrLn "\n"+	let usedby = M.unionsWith (++) $ map mkhostmap hosts+	let rows = map (mkrow usedby) (M.keys m)+	let table = tableWithHeader header rows+	putStr $ unlines $ formatTable table+  where+  	header = ["Field", "Context", "Used by"]+	mkrow usedby k@(field, (Context context)) =+		[ shellEscape $ show field+		, shellEscape context+		, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby+		]+	mkhostmap host = M.fromList $ map (\k -> (k, [hostName host])) $+		S.toList $ _privDataFields $ hostInfo host++setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()+setPrivDataTo field context value = do 	makePrivDataDir-	let f = privDataFile host-	m <- decryptPrivData host-	let m' = M.insert field value m-	gpgEncrypt f (show m')+	m <- decryptPrivData+	let m' = M.insert (field, context) (chomp value) m+	gpgEncrypt privDataFile (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 -dumpPrivData :: HostName -> PrivDataField -> IO ()-dumpPrivData host field = go . M.lookup field =<< decryptPrivData host-  where-	go Nothing = error "Requested privdata is not set."-	go (Just s) = putStrLn s--decryptPrivData :: HostName -> IO (M.Map PrivDataField String)-decryptPrivData host = fromMaybe M.empty . readish-	<$> gpgDecrypt (privDataFile host)+decryptPrivData :: IO PrivMap+decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile  makePrivDataDir :: IO () makePrivDataDir = createDirectoryIfMissing False privDataDir@@ -75,8 +146,8 @@ privDataDir :: FilePath privDataDir = "privdata" -privDataFile :: HostName -> FilePath-privDataFile host = privDataDir </> host ++ ".gpg"+privDataFile :: FilePath+privDataFile = privDataDir </> "privdata.gpg"  privDataLocal :: FilePath privDataLocal = privDataDir </> "local"

@@ -55,10 +55,11 @@ -- | 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 @@ -- 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 @@ 	-> 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 @@ 					] 			] -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 @@ -- 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) $

@@ -17,16 +17,17 @@ -- -- 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.

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

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

@@ -25,5 +25,6 @@ 	 	-- 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)

@@ -23,29 +23,25 @@  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 @@ 	& 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 @@ 	-- 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 @@ 	-- 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

@@ -16,6 +16,7 @@ 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 @@ 		[ "--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 @@ 			, "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 @@ 		, "--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 @@ 	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 @@ 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 = 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 = 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" 	] 

@@ -72,46 +72,46 @@ 			[ 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 ssh host keys.+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 +144,9 @@ 		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)

@@ -24,17 +24,18 @@  -- | 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"

@@ -17,7 +17,9 @@ 	, ActionResult(..) 	, CmdLine(..) 	, PrivDataField(..)-	, GpgKeyId+	, PrivData+	, Context(..)+	, anyContext 	, SshKeyType(..) 	, module Propellor.Types.OS 	, module Propellor.Types.Dns@@ -32,6 +34,7 @@ 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,28 +138,12 @@ 	= Run HostName 	| Spin HostName 	| Boot HostName-	| Set HostName PrivDataField-	| Dump HostName PrivDataField+	| Set PrivDataField Context+	| Dump PrivDataField Context+	| Edit PrivDataField Context+	| 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)

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

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

@@ -0,0 +1,28 @@+{- text based table generation+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - License: BSD-2-clause+ -}++module Utility.Table where++type Table = [[String]]++-- | A table with a header that is set off with lines under each+-- header item.+tableWithHeader :: [String] -> [[String]] -> Table+tableWithHeader header rows = header : map linesep header : rows+  where+	linesep = map (const '-')++-- | Formats a table to lines, automatically padding rows to the same size.+formatTable :: Table -> [String]+formatTable table = map (\r -> unwords (map pad (zip r rowsizes))) table+  where+	pad (cell, size) = cell ++ take (size - length cell) padding+	padding = repeat ' '+	rowsizes = sumrows (map (map length) table)+	sumrows [] = repeat 0+	sumrows [r] = r+	sumrows (r1:r2:rs) = sumrows $ map (uncurry max) (zip r1 r2) : rs

@@ -29,7 +29,7 @@ 		& Apt.unattendedUpgrades 		& Apt.installed ["etckeeper"] 		& Apt.installed ["ssh"]-		& User.hasSomePassword "root"+		& User.hasSomePassword "root" (Context "mybox.example.com") 		& Network.ipv6to4 		& File.dirExists "/var/www" 		& Docker.docked hosts "webserver"