propellor 1.2.0 → 1.2.1

raw patch · 18 files changed

+143/−45 lines, 18 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +9/−0
• config-joey.hs +1/−1
• debian/changelog +9/−0
• propellor.cabal +1/−1
• src/Propellor/PrivData.hs +35/−9
• src/Propellor/Property/Apt.hs +1/−1
• src/Propellor/Property/Debootstrap.hs +1/−1
• src/Propellor/Property/Docker.hs +5/−3
• src/Propellor/Property/File.hs +1/−1
• src/Propellor/Property/Gpg.hs +2/−1
• src/Propellor/Property/Grub.hs +3/−3
• src/Propellor/Property/Hostname.hs +5/−5
• src/Propellor/Property/OS.hs +6/−6
• src/Propellor/Property/Postfix.hs +1/−1
• src/Propellor/Property/Ssh.hs +4/−2
• src/Propellor/Property/Systemd.hs +1/−1
• src/Propellor/Property/User.hs +23/−9
• src/Propellor/Types/PrivData.hs +35/−0

@@ -1,3 +1,12 @@+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>  Wed, 17 Dec 2014 16:30:44 -0400+ propellor (1.2.0) unstable; urgency=medium    * Display a warning when ensureProperty is used on a property which has

@@ -76,7 +76,7 @@ 	& Apt.buildDep ["git-annex"] `period` Daily 	& Docker.configured 	! Docker.docked gitAnnexAndroidDev-	& website "foo"+	! website "foo"  website :: String -> RevertableProperty website hn = Apache.siteEnabled hn apachecfg

@@ -1,3 +1,12 @@+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>  Wed, 17 Dec 2014 16:30:44 -0400+ propellor (1.2.0) unstable; urgency=medium    * Display a warning when ensureProperty is used on a property which has

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

@@ -48,23 +48,49 @@ -- 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 c mkprop = addinfo $ mkprop $ \a ->-	maybe missing a =<< get+withPrivData s = withPrivData' snd [s]++-- Like withPrivData, but here any of a list of PrivDataFields can be used.+withSomePrivData+	:: (IsContext c, IsPrivDataSource s)+	=> [s]+	-> c+	-> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property)+	-> Property+withSomePrivData = withPrivData' id++withPrivData' +	:: (IsContext c, IsPrivDataSource s)+	=> ((PrivDataField, PrivData) -> v)+	-> [s]+	-> c+	-> (((v -> Propellor Result) -> Propellor Result) -> Property)+	-> Property+withPrivData' feed srclist 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_ 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 = S.singleton (field, hc) } }+	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

@@ -90,7 +90,7 @@ -- | Adds additional sources.list generators. -- -- Note that if a Property needs to enable an apt source, it's better--- to do so via a separate file in /etc/apt/sources.list.d/+-- to do so via a separate file in </etc/apt/sources.list.d/> stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property stdSourcesList' suite more = setSourcesList 	(concatMap (\gen -> gen suite) generators)

@@ -233,7 +233,7 @@ 		] 	modifyFileMode wrapperScript (addModes $ readModes ++ executeModes) --- Work around for http://bugs.debian.org/770217+-- Work around for <http://bugs.debian.org/770217> makeDevicesTarball :: IO () makeDevicesTarball = do 	-- TODO append to tarball; avoid writing to /dev

@@ -63,9 +63,11 @@ 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,@@ -176,7 +178,7 @@ -- | Tweaks a container to work well with docker. -- -- Currently, this consists of making pam_loginuid lines optional in--- the pam config, to work around https://github.com/docker/docker/issues/5663+-- the pam config, to work around <https://github.com/docker/docker/issues/5663> -- which affects docker 1.2.0. tweaked :: Property tweaked = trivial $@@ -529,7 +531,7 @@ dockerInfo i = mempty { _dockerinfo = i }  -- | The ContainerIdent of a container is written to--- /.propellor-ident inside it. This can be checked to see if+-- </.propellor-ident> inside it. This can be checked to see if -- the container has the same ident later. propellorIdent :: FilePath propellorIdent = "/.propellor-ident"

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

@@ -28,13 +28,14 @@ 	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

@@ -4,10 +4,10 @@ import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt --- | Eg, hd0,0 or xen/xvda1+-- | Eg, "hd0,0" or "xen/xvda1" type GrubDevice = String --- | Eg, /dev/sda+-- | Eg, "/dev/sda" type OSDevice = String  type TimeoutSecs = Int@@ -51,7 +51,7 @@ -- -- Useful when the VPS's pv-grub is too old to boot a modern kernel image. ----- http://notes.pault.ag/linode-pv-grub-chainning/+-- <http://notes.pault.ag/linode-pv-grub-chainning/> -- -- The rootdev should be in the form "hd0", while the bootdev is in the form -- "xen/xvda".

@@ -7,14 +7,14 @@  -- | Ensures that the hostname is set using best practices. ----- Configures `/etc/hostname` and the current hostname.+-- Configures </etc/hostname> and the current hostname. ----- Configures `/etc/mailname` with the domain part of the hostname.+-- Configures </etc/mailname> with the domain part of the hostname. ----- `/etc/hosts` is also configured, with an entry for 127.0.1.1, which is+-- </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+-- 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@@ -44,7 +44,7 @@ 		(ip ++ "\t" ++ (unwords names)) : filter (not . hasip ip) ls 	hasip ip l = headMaybe (words l) == Just ip --- | Makes `/etc/resolv.conf` contain search and domain lines for +-- | Makes </etc/resolv.conf> contain search and domain lines for  -- the domain that the hostname is in. searchDomain :: Property searchDomain = property desc (ensureProperty . go =<< asks hostName)

@@ -33,10 +33,10 @@ -- the property to. -- -- This property only runs once. The cleanly installed system will have--- a file /etc/propellor-cleaninstall, which indicates it was cleanly+-- a file </etc/propellor-cleaninstall>, which indicates it was cleanly -- installed. -- --- The files from the old os will be left in /old-os+-- The files from the old os will be left in </old-os> -- -- After the OS is installed, and if all properties of the host have -- been successfully satisfied, the host will be rebooted to properly load@@ -188,13 +188,13 @@ 			return FailedChange 		else return NoChange --- | /etc/network/interfaces is configured to bring up the network +-- | </etc/network/interfaces> is configured to bring up the network  -- interface that currently has a default route configured, using -- the same (static) IP address. preserveNetwork :: Property preserveNetwork = undefined -- TODO --- | /etc/resolv.conf is copied the from the old OS+-- | </etc/resolv.conf> is copied from the old OS preserveResolvConf :: Property preserveResolvConf = check (fileExist oldloc) $ 	property (newloc ++ " copied from old OS") $ do@@ -204,7 +204,7 @@ 	newloc = "/etc/resolv.conf" 	oldloc = oldOSDir ++ newloc --- | Root's .ssh/authorized_keys has added to it any ssh keys that+-- | </root/.ssh/authorized_keys> has added to it any ssh keys that -- were authorized in the old OS. Any other contents of the file are -- retained. preserveRootSshAuthorized :: Property@@ -216,7 +216,7 @@ 	newloc = "/root/.ssh/authorized_keys" 	oldloc = oldOSDir ++ newloc --- Removes the old OS's backup from /old-os+-- Removes the old OS's backup from </old-os> oldOSRemoved :: Confirmation -> Property oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $ 	go `requires` confirmed "old OS backup removal confirmed" confirmation

@@ -50,7 +50,7 @@ 	`onChange` cmdProperty "postmap" [f]  -- | Run newaliases command, which should be done after changing--- /etc/aliases.+-- </etc/aliases>. newaliases :: Property newaliases = trivial $ cmdProperty "newaliases" [] 

@@ -90,8 +90,8 @@ -- | 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 @@ 		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.

@@ -227,7 +227,7 @@ 		('-':_) -> p 		_ -> "--" ++ p --- | Bind mounts /etc/resolv.conf from the host into the container.+-- | Bind mounts </etc/resolv.conf> from the host into the container. -- -- This property is enabled by default. Revert it to disable it. resolvConfed :: RevertableProperty

@@ -23,7 +23,7 @@ 	`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,36 @@ 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 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 :: 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

@@ -11,10 +11,37 @@ 	| SshPrivKey SshKeyType UserName 	| SshAuthorizedKeys UserName 	| Password UserName+	| CryptPassword UserName 	| PrivFile FilePath 	| GpgKey 	deriving (Read, Show, Ord, Eq) +-- | 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. -- -- Often this will be a domain name. For example, @@ -63,3 +90,11 @@  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"+