Merge branch 'joeyconfig'

Conflicts:
	privdata.joey/privdata.gpg

debian/changelog

@@ -1,11 +1,11 @@
-propellor (1.2.1) UNRELEASED; urgency=medium
+propellor (1.2.1) unstable; urgency=medium
 
   * Added CryptPassword to PrivDataField, for password hashes as produced 
     by crypt(3).
   * User.hasPassword and User.hasSomePassword will now use either
     a CryptPassword or a Password from privdata, depending on which is set.
 
- -- Joey Hess <id@joeyh.name>  Sun, 14 Dec 2014 13:51:01 -0400
+ -- Joey Hess <id@joeyh.name>  Wed, 17 Dec 2014 16:30:44 -0400
 
 propellor (1.2.0) unstable; urgency=medium
 

propellor.cabal

@@ -1,5 +1,5 @@
 Name: propellor
-Version: 1.2.0
+Version: 1.2.1
 Cabal-Version: >= 1.6
 License: BSD3
 Maintainer: Joey Hess <id@joeyh.name>

src/Propellor/PrivData.hs

@@ -48,30 +48,30 @@ import Utility.Table
 -- being used, which is necessary to ensure that the privdata is sent to
 -- the remote host by propellor.
 withPrivData
-	:: IsContext c
-	=> PrivDataField
+	:: (IsContext c, IsPrivDataSource s)
+	=> s
 	-> c
 	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
 	-> Property
-withPrivData field = withPrivData' snd [field]
+withPrivData s = withPrivData' snd [s]
 
 -- Like withPrivData, but here any of a list of PrivDataFields can be used.
 withSomePrivData
-	:: IsContext c
-	=> [PrivDataField]
+	:: (IsContext c, IsPrivDataSource s)
+	=> [s]
 	-> c
 	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property)
 	-> Property
 withSomePrivData = withPrivData' id
 
 withPrivData' 
-	:: IsContext c
+	:: (IsContext c, IsPrivDataSource s)
 	=> ((PrivDataField, PrivData) -> v)
-	-> [PrivDataField]
+	-> [s]
 	-> c
 	-> (((v -> Propellor Result) -> Propellor Result) -> Property)
 	-> Property
-withPrivData' feed fieldlist c mkprop = addinfo $ mkprop $ \a ->
+withPrivData' feed srclist c mkprop = addinfo $ mkprop $ \a ->
 	maybe missing (a . feed) =<< getM get fieldlist
   where
   	get field = do
@@ -82,14 +82,15 @@ withPrivData' feed fieldlist c mkprop = addinfo $ mkprop $ \a ->
 		Context cname <- mkHostContext hc <$> asks hostName
 		warningMessage $ "Missing privdata " ++ intercalate " or " fieldnames ++ " (for " ++ cname ++ ")"
 		liftIO $ putStrLn $ "Fix this by running:"
-		liftIO $ forM_ fieldlist $ \f -> do
-			putStrLn $ "  propellor --set '" ++ show f ++ "' '" ++ cname ++ "'"
-			putStrLn $ "    < ( " ++ howtoMkPrivDataField f ++ " )"
+		liftIO $ forM_ srclist $ \src -> do
+			putStrLn $ "  propellor --set '" ++ show (privDataField src) ++ "' '" ++ cname ++ "'"
+			maybe noop (\d -> putStrLn $ "    " ++ d) (describePrivDataSource src)
 			putStrLn ""
 		return FailedChange
 	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = fieldset } }
 	fieldnames = map show fieldlist
 	fieldset = S.fromList $ zip fieldlist (repeat hc)
+	fieldlist = map privDataField srclist
 	hc = asHostContext c
 
 addPrivDataField :: (PrivDataField, HostContext) -> Property

src/Propellor/Property/Docker.hs

@@ -63,9 +63,11 @@ installed = Apt.installed ["docker.io"]
 configured :: Property
 configured = prop `requires` installed
   where
-	prop = withPrivData DockerAuthentication anyContext $ \getcfg ->
+	prop = withPrivData src anyContext $ \getcfg ->
 		property "docker configured" $ getcfg $ \cfg -> ensureProperty $ 
 			"/root/.dockercfg" `File.hasContent` (lines cfg)
+	src = PrivDataSourceFileFromCommand DockerAuthentication
+		"/root/.dockercfg" "docker login"
 
 -- | A short descriptive name for a container.
 -- Should not contain whitespace or other unusual characters,

src/Propellor/Property/File.hs

@@ -29,7 +29,7 @@ hasPrivContentExposed = hasPrivContent' writeFile
 
 hasPrivContent' :: IsContext c => (String -> FilePath -> IO ()) -> FilePath -> c -> Property
 hasPrivContent' writer f context = 
-	withPrivData (PrivFile f) context $ \getcontent -> 
+	withPrivData (PrivDataSourceFile (PrivFile f) f) context $ \getcontent -> 
 		property desc $ getcontent $ \privcontent -> 
 			ensureProperty $ fileProperty' writer desc
 				(\_oldcontent -> lines privcontent) f

src/Propellor/Property/Gpg.hs

@@ -28,13 +28,14 @@ keyImported (GpgKeyId keyid) user = flagFile' prop genflag
 	genflag = do
 		d <- dotDir user
 		return $ d </> ".propellor-imported-keyid-" ++ keyid
-	prop = withPrivData GpgKey (Context keyid) $ \getkey ->
+	prop = withPrivData src (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
+	src = PrivDataSource GpgKey "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a"
 
 dotDir :: UserName -> IO FilePath
 dotDir user = do

src/Propellor/Property/Ssh.hs

@@ -90,8 +90,8 @@ hostKeys ctx = propertyList "known ssh host keys"
 -- | Sets a single ssh host key from the privdata.
 hostKey :: IsContext c => SshKeyType -> c -> Property
 hostKey keytype context = combineProperties desc
-	[ installkey (SshPubKey keytype "")  (install writeFile ".pub")
-	, installkey (SshPrivKey keytype "") (install writeFileProtected "")
+	[ installkey (keysrc ".pub" (SshPubKey keytype ""))  (install writeFile ".pub")
+	, installkey (keysrc "" (SshPrivKey keytype "")) (install writeFileProtected "")
 	]
 	`onChange` restarted
   where
@@ -104,6 +104,8 @@ hostKey keytype context = combineProperties desc
 		if s == key
 			then noChange
 			else makeChange $ writer f key
+	keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext)
+		("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey")
 
 -- | Sets up a user with a ssh private key and public key pair from the
 -- PrivData.

src/Propellor/Property/User.hs

@@ -46,8 +46,13 @@ hasPassword user = hasPassword' user hostContext
 hasPassword' :: IsContext c => UserName -> c -> Property
 hasPassword' user context = go `requires` shadowConfig True
   where
-	go = withSomePrivData [CryptPassword user, Password user] context $
+	go = withSomePrivData srcs context $
 		property (user ++ " has password") . setPassword
+	srcs =
+		[ PrivDataSource (CryptPassword user)
+			"a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'"
+		, PrivDataSource (Password user) ("a password for " ++ user)
+		]
 
 setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
 setPassword getpassword = getpassword $ go

src/Propellor/Types/PrivData.hs

@@ -16,23 +16,31 @@ data PrivDataField
 	| GpgKey
 	deriving (Read, Show, Ord, Eq)
 
--- | Explains how the user can generate a particular PrivDataField.
-howtoMkPrivDataField :: PrivDataField -> String
-howtoMkPrivDataField fld = case fld of
-	DockerAuthentication -> "/root/.dockercfg" `genbycmd` "docker login"
-	SshPubKey keytype _ -> forexample $
-		"sshkey.pub" `genbycmd` keygen keytype
-	SshPrivKey keytype _ -> forexample $
-		"sshkey" `genbycmd` keygen keytype
-	SshAuthorizedKeys _ -> forexample "~/.ssh/id_rsa.pub"
-	Password username -> "a password for " ++ username
-	CryptPassword _ -> "a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'"
-	PrivFile f -> "file contents for " ++ f
-	GpgKey -> "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a"
-  where
-	genbycmd f cmd = f ++ " generated by running `" ++ cmd ++ "`"
-	keygen keytype = "ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey"
-	forexample s = "for example, " ++ s
+-- | Combines a PrivDataField with a description of how to generate
+-- its value.
+data PrivDataSource
+	= PrivDataSourceFile PrivDataField FilePath
+	| PrivDataSourceFileFromCommand PrivDataField FilePath String
+	| PrivDataSource PrivDataField String
+
+class IsPrivDataSource s where
+	privDataField :: s -> PrivDataField
+	describePrivDataSource :: s -> Maybe String
+
+instance IsPrivDataSource PrivDataField where
+	privDataField = id
+	describePrivDataSource _ = Nothing
+
+instance IsPrivDataSource PrivDataSource where
+	privDataField s = case s of
+		PrivDataSourceFile f _ -> f
+		PrivDataSourceFileFromCommand f _ _ -> f
+		PrivDataSource f _ -> f
+	describePrivDataSource s = Just $ case s of
+		PrivDataSourceFile _ f -> "< " ++ f
+		PrivDataSourceFileFromCommand _ f c ->
+			"< " ++ f ++ " (created by running, for example, `" ++ c ++ "` )"
+		PrivDataSource _ d -> "< (" ++ d ++ ")"
 
 -- | A context in which a PrivDataField is used.
 --