summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-12-07 12:04:58 -0400
committerJoey Hess2014-12-07 12:04:58 -0400
commit322ae878bbaef94736fdc4cae60b6c3b8c17a54d (patch)
tree4113593f21d964ad8f821ebbd408a528011f1398 /src
parentb7da90a91516c0d496c44459ed03009e58f39233 (diff)
parentdd40a05ced3b7c50a3a7751c66ad5a253056459e (diff)
Merge branch 'joeyconfig'
Conflicts: privdata.joey/privdata.gpg
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Engine.hs37
-rw-r--r--src/Propellor/Property.hs10
-rw-r--r--src/Propellor/Property/HostingProvider/DigitalOcean.hs6
-rw-r--r--src/Propellor/Property/OS.hs40
-rw-r--r--src/Propellor/Property/Reboot.hs26
-rw-r--r--src/Propellor/Types.hs15
-rw-r--r--src/Propellor/Types/OS.hs2
7 files changed, 99 insertions, 37 deletions
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 81cc2397..44b10cab 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 6ace5e4e..6371cc09 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 32165d48..4d2534ec 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 22414bb6..6d55072f 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 25e53159..c2628689 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 2f51b3e4..f349a29a 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 72e3d764..8b3cd0fd 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)