diff --git a/config-joey.hs b/config-joey.hs index c1eb0a2..abbd846 100644 --- a/config-joey.hs +++ b/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" diff --git a/config-simple.hs b/config-simple.hs index c03149e..95c2fe1 100644 --- a/config-simple.hs +++ b/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 diff --git a/debian/changelog b/debian/changelog index 4bb387c..a2b357a 100644 --- a/debian/changelog +++ b/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 Sat, 22 Nov 2014 00:12:35 -0400 diff --git a/doc/todo/hooks.mdwn b/doc/todo/hooks.mdwn index a62aa5e..4617c2b 100644 --- a/doc/todo/hooks.mdwn +++ b/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. diff --git a/doc/todo/info_propigation_out_of_nested_properties.mdwn b/doc/todo/info_propigation_out_of_nested_properties.mdwn index 9e69b0b..1a586be 100644 --- a/doc/todo/info_propigation_out_of_nested_properties.mdwn +++ b/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. diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 81cc239..44b10ca 100644 --- a/src/Propellor/Engine.hs +++ b/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) diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 6ace5e4..6371cc0 100644 --- a/src/Propellor/Property.hs +++ b/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] diff --git a/src/Propellor/Property/HostingProvider/DigitalOcean.hs b/src/Propellor/Property/HostingProvider/DigitalOcean.hs index 32165d4..4d2534e 100644 --- a/src/Propellor/Property/HostingProvider/DigitalOcean.hs +++ b/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 diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index 22414bb..6d55072 100644 --- a/src/Propellor/Property/OS.hs +++ b/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) $ diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs index 25e5315..c262868 100644 --- a/src/Propellor/Property/Reboot.hs +++ b/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 = [] diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 2f51b3e..f349a29 100644 --- a/src/Propellor/Types.hs +++ b/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) diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index 72e3d76..8b3cd0f 100644 --- a/src/Propellor/Types/OS.hs +++ b/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)