Merge branch 'joeyconfig'

This commit is contained in:
Joey Hess 2014-12-07 18:49:43 -04:00
commit 21d87341ca
8 changed files with 98 additions and 14 deletions

7
debian/changelog vendored
View File

@ -1,3 +1,10 @@
propellor (1.1.1) UNRELEASED; urgency=medium
* Display a warning when ensureProperty is used on a property which has
Info and is so prevented from propigating it.
-- Joey Hess <id@joeyh.name> Sun, 07 Dec 2014 17:08:55 -0400
propellor (1.1.0) unstable; urgency=medium
* --spin target --via relay causes propellor to bounce through an

View File

@ -118,6 +118,7 @@ Library
Propellor.Types.Chroot
Propellor.Types.Docker
Propellor.Types.Dns
Propellor.Types.Empty
Propellor.Types.OS
Propellor.Types.PrivData
Other-Modules:

View File

@ -1,6 +1,14 @@
{-# LANGUAGE PackageImports #-}
module Propellor.Engine where
module Propellor.Engine (
mainProperties,
runPropellor,
ensureProperty,
ensureProperties,
fromHost,
onlyProcess,
processChainOutput,
) where
import System.Exit
import System.IO
@ -15,6 +23,7 @@ import System.FilePath
import System.Directory
import Propellor.Types
import Propellor.Types.Empty
import Propellor.Message
import Propellor.Exception
import Propellor.Info
@ -27,7 +36,7 @@ import Utility.Monad
mainProperties :: Host -> IO ()
mainProperties host = do
ret <- runPropellor host $
ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
ensureProperties [Property "overall" (ensurePropertiesWith ensureProperty' $ hostProperties host) mempty]
h <- mkMessageHandle
whenConsole h $
setTitle "propellor: done"
@ -52,20 +61,33 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc
(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
ensure [] rs = return rs
ensure (l:ls) rs = do
hn <- asks hostName
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
ensure ls (r <> rs)
-- | For when code running in the Propellor monad needs to ensure a
-- Property.
--
-- Note that any info of the Property is not propigated out to
-- the enclosing Property, and so will not be available for propellor to
-- use. A warning message will be printed if this is detected.
ensureProperty :: Property -> Propellor Result
ensureProperty = catchPropellor . propertySatisfy
ensureProperty p = do
unless (isEmpty (getInfo p)) $
warningMessage $ "ensureProperty called on " ++ show p ++ "; will not propigate its info: " ++ show (getInfo p)
ensureProperty' p
ensureProperty' :: Property -> Propellor Result
ensureProperty' = catchPropellor . propertySatisfy
-- | Ensures a list of Properties, with a display of each as it runs.
ensureProperties :: [Property] -> Propellor Result
ensureProperties = ensurePropertiesWith ensureProperty
ensurePropertiesWith :: (Property -> Propellor Result) -> [Property] -> Propellor Result
ensurePropertiesWith a ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (p:ls) rs = do
hn <- asks hostName
r <- actionMessageOn hn (propertyDesc p) (a p)
ensure ls (r <> rs)
-- | Lifts an action into a different host.
--

View File

@ -43,6 +43,7 @@ import Propellor.Types.Chroot
import Propellor.Types.Dns
import Propellor.Types.Docker
import Propellor.Types.PrivData
import Propellor.Types.Empty
-- | Everything Propellor knows about a system: Its hostname,
-- properties and other info.
@ -188,6 +189,18 @@ instance Monoid Info where
, _chrootinfo = _chrootinfo old <> _chrootinfo new
}
instance Empty Info where
isEmpty i = and
[ isEmpty (_os i)
, isEmpty (_privDataFields i)
, isEmpty (_sshPubKey i)
, isEmpty (_aliases i)
, isEmpty (_dns i)
, isEmpty (_namedconf i)
, isEmpty (_dockerinfo i)
, isEmpty (_chrootinfo i)
]
data Val a = Val a | NoVal
deriving (Eq, Show)
@ -197,6 +210,10 @@ instance Monoid (Val a) where
NoVal -> old
_ -> new
instance Empty (Val a) where
isEmpty NoVal = True
isEmpty _ = False
fromVal :: Val a -> Maybe a
fromVal (Val a) = Just a
fromVal NoVal = Nothing

View File

@ -2,6 +2,7 @@ module Propellor.Types.Chroot where
import Data.Monoid
import qualified Data.Map as M
import Propellor.Types.Empty
data ChrootInfo host = ChrootInfo
{ _chroots :: M.Map FilePath host
@ -16,10 +17,16 @@ instance Monoid (ChrootInfo host) where
, _chrootCfg = _chrootCfg old <> _chrootCfg new
}
instance Empty (ChrootInfo host) where
isEmpty i = and
[ isEmpty (_chroots i)
, isEmpty (_chrootCfg i)
]
data ChrootCfg
= NoChrootCfg
| SystemdNspawnCfg [(String, Bool)]
deriving (Show)
deriving (Show, Eq)
instance Monoid ChrootCfg where
mempty = NoChrootCfg
@ -27,3 +34,6 @@ instance Monoid ChrootCfg where
mappend NoChrootCfg v = v
mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) =
SystemdNspawnCfg (l1 <> l2)
instance Empty ChrootCfg where
isEmpty c= c == NoChrootCfg

View File

@ -1,6 +1,7 @@
module Propellor.Types.Dns where
import Propellor.Types.OS (HostName)
import Propellor.Types.Empty
import Data.Word
import Data.Monoid
@ -108,5 +109,8 @@ instance Monoid NamedConfMap where
(Secondary, Master) -> o
_ -> n
instance Empty NamedConfMap where
isEmpty (NamedConfMap m) = isEmpty m
fromNamedConfMap :: NamedConfMap -> M.Map Domain NamedConf
fromNamedConfMap (NamedConfMap m) = m

View File

@ -1,6 +1,7 @@
module Propellor.Types.Docker where
import Propellor.Types.OS
import Propellor.Types.Empty
import Data.Monoid
import qualified Data.Map as M
@ -18,6 +19,12 @@ instance Monoid (DockerInfo h) where
, _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new)
}
instance Empty (DockerInfo h) where
isEmpty i = and
[ isEmpty (_dockerRunParams i)
, isEmpty (_dockerContainers i)
]
newtype DockerRunParam = DockerRunParam (HostName -> String)
instance Show DockerRunParam where

View File

@ -0,0 +1,16 @@
module Propellor.Types.Empty where
import qualified Data.Map as M
import qualified Data.Set as S
class Empty t where
isEmpty :: t -> Bool
instance Empty [a] where
isEmpty = null
instance Empty (M.Map k v) where
isEmpty = M.null
instance Empty (S.Set v) where
isEmpty = S.null