Merge branch 'joeyconfig'
This commit is contained in:
commit
21d87341ca
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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.
|
||||
--
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
Loading…
Reference in New Issue