Merge branch 'joeyconfig'

config-joey.hs

@@ -78,6 +78,9 @@ darkstar = host "darkstar.kitenet.net"
 	! Docker.docked gitAnnexAndroidDev
 	& website "foo"
 
+	& User.accountFor "tester"
+	& User.hasSomePassword "tester"
+
 website :: String -> RevertableProperty
 website hn = Apache.siteEnabled hn apachecfg
         where

debian/changelog

@@ -1,3 +1,12 @@
+propellor (1.2.1) UNRELEASED; 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
+
 propellor (1.2.0) unstable; urgency=medium
 
   * Display a warning when ensureProperty is used on a property which has

src/Propellor/PrivData.hs

@@ -53,18 +53,43 @@ withPrivData
 	-> c
 	-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
 	-> Property
-withPrivData field c mkprop = addinfo $ mkprop $ \a ->
-	maybe missing a =<< get
+withPrivData field = withPrivData' snd [field]
+
+-- Like withPrivData, but here any of a list of PrivDataFields can be used.
+withSomePrivData
+	:: IsContext c
+	=> [PrivDataField]
+	-> c
+	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property)
+	-> Property
+withSomePrivData = withPrivData' id
+
+withPrivData' 
+	:: IsContext c
+	=> ((PrivDataField, PrivData) -> v)
+	-> [PrivDataField]
+	-> c
+	-> (((v -> Propellor Result) -> Propellor Result) -> Property)
+	-> Property
+withPrivData' feed fieldlist c mkprop = addinfo $ mkprop $ \a ->
+	maybe missing (a . feed) =<< getM get fieldlist
   where
-  	get = do
+  	get field = do
 		context <- mkHostContext hc <$> asks hostName
-		liftIO $ getLocalPrivData field context
+		maybe Nothing (\privdata -> Just (field, privdata))
+			<$> liftIO (getLocalPrivData field context)
 	missing = do
 		Context cname <- mkHostContext hc <$> asks hostName
-		warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")"
-		liftIO $ putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"
+		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 ++ " )"
+			putStrLn ""
 		return FailedChange
-	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, hc) } }
+	addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = fieldset } }
+	fieldnames = map show fieldlist
+	fieldset = S.fromList $ zip fieldlist (repeat hc)
 	hc = asHostContext c
 
 addPrivDataField :: (PrivDataField, HostContext) -> Property

src/Propellor/Property/User.hs

@@ -23,7 +23,7 @@ nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "use
 	`describe` ("nuked user " ++ user)
 
 -- | Only ensures that the user has some password set. It may or may
--- not be the password from the PrivData.
+-- not be a password from the PrivData.
 hasSomePassword :: UserName -> Property
 hasSomePassword user = hasSomePassword' user hostContext
 
@@ -34,22 +34,31 @@ hasSomePassword' :: IsContext c => UserName -> c -> Property
 hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $
 	hasPassword' user context
 
--- | Ensures that a user's password is set to the password from the PrivData.
+-- | Ensures that a user's password is set to a password from the PrivData.
 -- (Will change any existing password.)
+--
+-- A user's password can be stored in the PrivData in either of two forms;
+-- the full cleartext <Password> or a <CryptPassword> hash. The latter
+-- is obviously more secure.
 hasPassword :: UserName -> Property
 hasPassword user = hasPassword' user hostContext
 
 hasPassword' :: IsContext c => UserName -> c -> Property
 hasPassword' user context = go `requires` shadowConfig True
   where
-	go = withPrivData (Password user) context $
-		property (user ++ " has password") . setPassword user
+	go = withSomePrivData [CryptPassword user, Password user] context $
+		property (user ++ " has password") . setPassword
 
-setPassword :: UserName -> ((PrivData -> Propellor Result) -> Propellor Result) -> Propellor Result
-setPassword user getpassword = getpassword $ \password -> makeChange $
-	withHandle StdinHandle createProcessSuccess
-		(proc "chpasswd" []) $ \h -> do
-			hPutStrLn h $ user ++ ":" ++ password
+setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
+setPassword getpassword = getpassword $ go
+  where
+	go (Password user, password) = set user password []
+	go (CryptPassword user, hash) = set user hash ["--encrypted"]
+	go (f, _) = error $ "Unexpected type of privdata: " ++ show f
+
+	set user v ps = makeChange $ withHandle StdinHandle createProcessSuccess
+		(proc "chpasswd" ps) $ \h -> do
+			hPutStrLn h $ user ++ ":" ++ v
 			hClose h
 
 lockedPassword :: UserName -> Property

src/Propellor/Types/PrivData.hs

@@ -11,10 +11,29 @@ data PrivDataField
 	| SshPrivKey SshKeyType UserName
 	| SshAuthorizedKeys UserName
 	| Password UserName
+	| CryptPassword UserName
 	| PrivFile FilePath
 	| 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
+
 -- | A context in which a PrivDataField is used.
 --
 -- Often this will be a domain name. For example, 
@@ -63,3 +82,11 @@ type PrivData = String
 
 data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
 	deriving (Read, Show, Ord, Eq)
+
+-- | Parameter that would be passed to ssh-keygen to generate key of this type
+sshKeyTypeParam :: SshKeyType -> String
+sshKeyTypeParam SshRsa = "RSA"
+sshKeyTypeParam SshDsa = "DSA"
+sshKeyTypeParam SshEcdsa = "ECDSA"
+sshKeyTypeParam SshEd25519 = "ED25519"
+