Merge branch 'joeyconfig'

Conflicts:
	privdata.joey/privdata.gpg

config-joey.hs

@@ -67,6 +67,7 @@ testvm = host "testvm.kitenet.net"
 	& Hostname.searchDomain
 	& Apt.installed ["linux-image-amd64"]
 	& Apt.installed ["ssh"]
+	& User.hasPassword "root"
 
 darkstar :: Host
 darkstar = host "darkstar.kitenet.net"

config-simple.hs

@@ -12,7 +12,6 @@ import qualified Propellor.Property.Cron as Cron
 --import qualified Propellor.Property.Sudo as Sudo
 import qualified Propellor.Property.User as User
 --import qualified Propellor.Property.Hostname as Hostname
---import qualified Propellor.Property.Reboot as Reboot
 --import qualified Propellor.Property.Tor as Tor
 import qualified Propellor.Property.Docker as Docker
 

debian/changelog

@@ -28,6 +28,8 @@ propellor (1.1.0) UNRELEASED; urgency=medium
   * propellor.debug can be set in the git config to enable more persistent
     debugging output.
   * Run apt-cache policy with LANG=C so it works on other locales.
+  * endAction can be used to register an action to run once propellor
+    has successfully run on a host.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 22 Nov 2014 00:12:35 -0400
 

doc/todo/hooks.mdwn

@@ -1,7 +1,4 @@
 * Need a way to run an action when a property changes, but only
   run it once for the whole. For example, may want to restart apache,
   but only once despite many config changes being made to satisfy
-  properties. onChange is a poor substitute.a
-* Relatedly, a property that say, installs systemd needs to have a way
-  to reboot the system when a change is made. But this should only
-  happen at the very end, after everything else.
+  properties. onChange is a poor substitute.

doc/todo/info_propigation_out_of_nested_properties.mdwn

@@ -13,6 +13,10 @@ Here, the Info of `foo` is not propigated out. Nor is `bar`'s Info.
 Of course, only one of them will be run, and only its info should be propigated
 out..
 
+This commonly afflicts eg, privData. For example, `User.hasPassword'`
+has this problem, and this prevents --list-fields from listing privdata
+that's not set from that property.
+
 One approach might be to make the Propellor monad be able to be run in two
 modes. In one mode, it actually perform IO, etc. In the other mode, all
 liftIO is a no-op, but all Info encountered is accumulated using a Reader
@@ -24,5 +28,7 @@ properties have been examined for info!
 
 Perhaps that can be finessed. We don't really need to propigate out OS info.
 Just DNS and PrivDataField Info. So info could be collected in 2 passes,
-first as it's done now by static propertyInfo values. Then by running
-the Properties in the Reader monad.
+first as it's done now by static propertyInfo values. Then take that
+and use it as the Info when running the Properties in the Reader monad.
+Combine what the Reader accumulates with the static info to get the full
+info.

src/Propellor/Engine.hs

@@ -7,7 +7,7 @@ import System.IO
 import Data.Monoid
 import Control.Applicative
 import System.Console.ANSI
-import "mtl" Control.Monad.Reader
+import "mtl" Control.Monad.RWS.Strict
 import Control.Exception (bracket)
 import System.PosixCompat
 import System.Posix.IO
@@ -22,21 +22,37 @@ import Utility.Exception
 import Utility.PartialPrelude
 import Utility.Monad
 
-runPropellor :: Host -> Propellor a -> IO a
-runPropellor host a = runReaderT (runWithHost a) host
-
+-- | Gets the Properties of a Host, and ensures them all,
+-- with nice display of what's being done.
 mainProperties :: Host -> IO ()
 mainProperties host = do
-	r <- runPropellor host $
+	ret <- runPropellor host $
 		ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
 	h <- mkMessageHandle
         whenConsole h $
 		setTitle "propellor: done"
 	hFlush stdout
-	case r of
+	case ret of
 		FailedChange -> exitWith (ExitFailure 1)
 		_ -> exitWith ExitSuccess
 
+-- | Runs a Propellor action with the specified host.
+--
+-- If the Result is not FailedChange, any EndActions
+-- that were accumulated while running the action
+-- are then also run.
+runPropellor :: Host -> Propellor Result -> IO Result
+runPropellor host a = do
+	(res, _s, endactions) <- runRWST (runWithHost a) host ()
+	endres <- mapM (runEndAction host res) endactions
+	return $ mconcat (res:endres)
+
+runEndAction :: Host -> Result -> EndAction -> IO Result
+runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc $ do
+	(ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host ()
+	return ret
+
+-- | Ensures a list of Properties, with a display of each as it runs.
 ensureProperties :: [Property] -> Propellor Result
 ensureProperties ps = ensure ps NoChange
   where
@@ -46,6 +62,8 @@ ensureProperties ps = ensure ps NoChange
 		r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
 		ensure ls (r <> rs)
 
+-- | For when code running in the Propellor monad needs to ensure a
+-- Property.
 ensureProperty :: Property -> Propellor Result
 ensureProperty = catchPropellor . propertySatisfy
 
@@ -55,8 +73,11 @@ ensureProperty = catchPropellor . propertySatisfy
 fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
 fromHost l hn getter = case findHost l hn of
 	Nothing -> return Nothing
-	Just h -> liftIO $ Just <$>
-		runReaderT (runWithHost getter) h
+	Just h -> do
+		(ret, _s, runlog) <- liftIO $
+			runRWST (runWithHost getter) h ()
+		tell runlog
+		return (Just ret)
 
 onlyProcess :: FilePath -> IO a -> IO a
 onlyProcess lockfile a = bracket lock unlock (const a)

src/Propellor/Property.hs

@@ -7,7 +7,7 @@ import System.FilePath
 import Control.Monad
 import Data.Monoid
 import Control.Monad.IfElse
-import "mtl" Control.Monad.Reader
+import "mtl" Control.Monad.RWS.Strict
 
 import Propellor.Types
 import Propellor.Info
@@ -131,11 +131,11 @@ boolProperty desc a = property desc $ ifM (liftIO a)
 revert :: RevertableProperty -> RevertableProperty
 revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 
--- Changes the action that is performed to satisfy a property. 
+-- | Changes the action that is performed to satisfy a property. 
 adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
 adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
 
--- Combines the Info of two properties.
+-- | Combines the Info of two properties.
 combineInfo :: (IsProp p, IsProp q) => p -> q -> Info
 combineInfo p q = getInfo p <> getInfo q
 
@@ -147,3 +147,7 @@ makeChange a = liftIO a >> return MadeChange
 
 noChange :: Propellor Result
 noChange = return NoChange
+
+-- | Registers an action that should be run at the very end,
+endAction :: Desc -> (Result -> Propellor Result) -> Propellor ()
+endAction desc a = tell [EndAction desc a]

src/Propellor/Property/HostingProvider/DigitalOcean.hs

@@ -5,6 +5,7 @@ module Propellor.Property.HostingProvider.DigitalOcean (
 import Propellor
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Reboot as Reboot
 
 import Data.List
 
@@ -24,9 +25,8 @@ distroKernel = propertyList "digital ocean distro kernel hack"
 		[ "LOAD_KEXEC=true"
 		, "USE_GRUB_CONFIG=true"
 		] `describe` "kexec configured"
-	, check (not <$> runningInstalledKernel)
-		(cmdProperty "reboot" [])
-			`describe` "running installed kernel"
+	, check (not <$> runningInstalledKernel) Reboot.now
+		`describe` "running installed kernel"
 	]
 
 runningInstalledKernel :: IO Bool

src/Propellor/Property/OS.hs

@@ -1,17 +1,18 @@
 module Propellor.Property.OS (
 	cleanInstallOnce,
 	Confirmation(..),
-	preserveNetworkInterfaces,
+	preserveNetwork,
 	preserveResolvConf,
 	preserveRootSshAuthorized,
-	rebootForced,
 	oldOSRemoved,
 ) where
 
 import Propellor
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Ssh as Ssh
+import qualified Propellor.Property.User as User
 import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Reboot as Reboot
 import Propellor.Property.Mount
 import Propellor.Property.Chroot.Util (stdPATH)
 import Utility.SafeCommand
@@ -35,8 +36,9 @@ import Control.Exception (throw)
 -- 
 -- The files from the old os will be left in /old-os
 --
--- TODO: A forced reboot should be schedued to run after propellor finishes
--- ensuring all properties of the host.
+-- After the OS is installed, and if all properties of the host have
+-- been successfully satisfied, the host will be rebooted to properly load
+-- the new OS.
 --
 -- You will typically want to run some more properties after the clean
 -- install succeeds, to bootstrap from the cleanly installed system to
@@ -45,7 +47,7 @@ import Control.Exception (throw)
 -- > & os (System (Debian Unstable) "amd64")
 -- > & cleanInstallOnce (Confirmed "foo.example.com")
 -- >    `onChange` propertyList "fixing up after clean install"
--- >        [ preserveNetworkInterfaces
+-- >        [ preserveNetwork
 -- >        , preserveResolvConf
 -- >        , preserverRootSshAuthorized
 -- >        , Apt.update
@@ -67,6 +69,12 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 	go = 
 		finalized
 			`requires`
+		-- easy to forget and system may not boot without shadow pw!
+		User.shadowConfig True
+			`requires`
+		-- reboot at end if the rest of the propellor run succeeds
+		Reboot.atEnd True (/= FailedChange)
+			`requires`
 		propellorbootstrapped
 			`requires`
 		flipped
@@ -125,7 +133,6 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 		unlessM (mount "devpts" "devpts" "/dev/pts") $
 			warningMessage "failed mounting /dev/pts"
 
-		liftIO $ writeFile flagfile ""
 		return MadeChange
 
 	propellorbootstrapped = property "propellor re-debootstrapped in new os" $
@@ -136,9 +143,9 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 		--   be present in /old-os's /usr/local/propellor)
 		-- TODO
 	
-	-- Ensure that MadeChange is returned by the overall property,
-	-- so that anything hooking in onChange will run afterwards.
-	finalized = property "clean OS installed" $ return MadeChange
+	finalized = property "clean OS installed" $ do
+		liftIO $ writeFile flagfile ""
+		return MadeChange
 
 	flagfile = "/etc/propellor-cleaninstall"
 	
@@ -179,10 +186,11 @@ confirmed desc (Confirmed c) = property desc $ do
 			return FailedChange
 		else return NoChange
 
--- | /etc/network/interfaces is configured to bring up all interfaces that
--- are currently up, using the same IP addresses.
-preserveNetworkInterfaces :: Property
-preserveNetworkInterfaces = undefined -- TODO
+-- | /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
 preserveResolvConf :: Property
@@ -206,12 +214,6 @@ preserveRootSshAuthorized = check (fileExist oldloc) $
 	newloc = "/root/.ssh/authorized_keys"
 	oldloc = oldOSDir ++ newloc
 
--- | Forces an immediate reboot, without contacting the init system.
---
--- Can be used after cleanInstallOnce.
-rebootForced :: Property
-rebootForced = cmdProperty "reboot" [ "--force" ]
-
 -- Removes the old OS's backup from /old-os
 oldOSRemoved :: Confirmation -> Property
 oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $

src/Propellor/Property/Reboot.hs

@@ -1,7 +1,33 @@
 module Propellor.Property.Reboot where
 
 import Propellor
+import Utility.SafeCommand
 
 now :: Property
 now = cmdProperty "reboot" []
 	`describe` "reboot now"
+
+-- | Schedules a reboot at the end of the current propellor run.
+--
+-- The Result code of the endire propellor run can be checked;
+-- the reboot proceeds only if the function returns True.
+--
+-- The reboot can be forced to run, which bypasses the init system. Useful
+-- if the init system might not be running for some reason.
+atEnd :: Bool -> (Result -> Bool) -> Property
+atEnd force resultok = property "scheduled reboot at end of propellor run" $ do
+	endAction "rebooting" atend
+	return NoChange
+  where
+	atend r
+		| resultok r = liftIO $
+			ifM (boolSystem "reboot" rebootparams)
+				( return MadeChange
+				, return FailedChange
+				)
+		| otherwise = do
+			warningMessage "Not rebooting, due to status of propellor run."
+			return FailedChange
+	rebootparams
+		| force = [Param "--force"]
+		| otherwise = []

src/Propellor/Types.hs

@@ -23,6 +23,8 @@ module Propellor.Types
 	, SshKeyType(..)
 	, Val(..)
 	, fromVal
+	, RunLog
+	, EndAction(..)
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
 	) where
@@ -31,7 +33,7 @@ import Data.Monoid
 import Control.Applicative
 import System.Console.ANSI
 import System.Posix.Types
-import "mtl" Control.Monad.Reader
+import "mtl" Control.Monad.RWS.Strict
 import "MonadCatchIO-transformers" Control.Monad.CatchIO
 import qualified Data.Set as S
 import qualified Propellor.Types.Dns as Dns
@@ -52,13 +54,14 @@ data Host = Host
 	deriving (Show)
 
 -- | Propellor's monad provides read-only access to info about the host
--- it's running on.
-newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p }
+-- it's running on, and a writer to accumulate logs about the run.
+newtype Propellor p = Propellor { runWithHost :: RWST Host RunLog () IO p }
 	deriving
 		( Monad
 		, Functor
 		, Applicative
 		, MonadReader Host
+		, MonadWriter RunLog
 		, MonadIO
 		, MonadCatchIO
 		)
@@ -197,3 +200,9 @@ instance Monoid (Val a) where
 fromVal :: Val a -> Maybe a
 fromVal (Val a) = Just a
 fromVal NoVal = Nothing
+
+type RunLog = [EndAction]
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties. It's passed the combined Result of the entire Propellor run.
+data EndAction = EndAction Desc (Result -> Propellor Result)

src/Propellor/Types/OS.hs

@@ -15,7 +15,7 @@ import Network.BSD (HostName)
 type UserName = String
 type GroupName = String
 
--- | High level descritption of a operating system.
+-- | High level description of a operating system.
 data System = System Distribution Architecture
 	deriving (Show, Eq)