LGTM, thanks On Tue, 24 Mar 2015 at 17:35 'Klaus Aehlig' via ganeti-devel < [email protected]> wrote:
> > > commit edcf959b45229b8c39597cc51800b187b4d8f82f > Merge: eee0109 7f03821 > Author: Klaus Aehlig <[email protected]> > Date: Tue Mar 24 17:06:59 2015 +0100 > > Merge branch 'stable-2.12' into stable-2.13 > > * stable-2.12 > Upgrade codebase to support monad-control >=0.3.1.3 && <1.1 > Add macros for the version of monad-control > Rename hs-lens-versions Makefile target to hs-pkg-versions > Verify master status before retrying a socket > Make LUClusterDestroy tell WConfD > Add an RPC to prepare cluster destruction > Support no-master state in ssconf > WConfD: do not clean up own livelock > Make WConfD have a livelock file as well > Add a prefix for a WConfD livelock > Detect if the own job file disappears > Keep track of the number LUs executing > Make job processes keep track of their job id > Make LuxiD clean up its lock file > > * stable-2.11 > Improve error handling when looking up instances > Capture last exception > > Conflicts: > src/Ganeti/BasicTypes.hs > src/Ganeti/Logging/WriterLog.hs > src/Ganeti/THH/HsRPC.hs > src/Ganeti/WConfd/Core.hs > src/Ganeti/WConfd/Monad.hs > Resolution: > Use all the language pragmas > > Signed-off-by: Klaus Aehlig <[email protected]> > > diff --cc lib/cmdlib/cluster.py > index 291cf47,7d75239..c504d60 > --- a/lib/cmdlib/cluster.py > +++ b/lib/cmdlib/cluster.py > @@@ -180,9 -157,10 +182,10 @@@ class LUClusterRenewCrypto(NoHooksLU) > nodes = self.cfg.GetAllNodesInfo() > for (node_uuid, node_info) in nodes.items(): > if node_info.offline: > - feedback_fn("* Skipping offline node %s" % node_info.name) > + logging.info("* Skipping offline node %s", node_info.name) > continue > if node_uuid != master_uuid: > + last_exception = None > for _ in range(self._MAX_NUM_RETRIES): > try: > new_digest = CreateNewClientCert(self, node_uuid) > diff --cc src/Ganeti/BasicTypes.hs > index 460e635,3ebd788..9d9bd61 > --- a/src/Ganeti/BasicTypes.hs > +++ b/src/Ganeti/BasicTypes.hs > @@@ -2,7 -2,8 +2,9 @@@ > {-# LANGUAGE FlexibleContexts #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE TypeFamilies #-} > +{-# LANGUAGE DeriveFunctor #-} > + {-# LANGUAGE UndecidableInstances #-} > + {-# LANGUAGE CPP #-} > > {- > > diff --cc src/Ganeti/Logging/WriterLog.hs > index 5e3d3bb,90b0339..e3a1499 > --- a/src/Ganeti/Logging/WriterLog.hs > +++ b/src/Ganeti/Logging/WriterLog.hs > @@@ -1,6 -1,5 +1,5 @@@ > --{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, > - MultiParamTypeClasses, GeneralizedNewtypeDeriving, > - StandaloneDeriving #-} > - MultiParamTypeClasses, UndecidableInstances, CPP #-} > ++{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, > GeneralizedNewtypeDeriving, > ++ StandaloneDeriving, MultiParamTypeClasses, > UndecidableInstances, CPP #-} > > {-| A pure implementation of MonadLog using MonadWriter > > @@@ -108,7 -111,42 +115,14 @@@ execWriterLog k = d > instance (Monad m) => MonadLog (WriterLogT m) where > logAt = curry (WriterLogT . tell . singleton) > > -instance (MonadIO m) => MonadIO (WriterLogT m) where > - liftIO = WriterLogT . liftIO > - > -instance (MonadPlus m) => MonadPlus (WriterLogT m) where > - mzero = lift mzero > - mplus (WriterLogT x) (WriterLogT y) = WriterLogT $ mplus x y > - > -instance (MonadBase IO m) => MonadBase IO (WriterLogT m) where > - liftBase = WriterLogT . liftBase > - > -instance MonadTrans WriterLogT where > - lift = WriterLogT . lift > - > instance MonadTransControl WriterLogT where > + #if MIN_VERSION_monad_control(1,0,0) > + -- Needs Undecidable instances > + type StT WriterLogT a = (a, LogSeq) > + liftWith f = WriterLogT . WriterT $ liftM (\x -> (x, mempty)) > + (f runWriterLogT) > + restoreT = WriterLogT . WriterT > + #else > newtype StT WriterLogT a = > StWriterLog { unStWriterLog :: (a, LogSeq) } > liftWith f = WriterLogT . WriterT $ liftM (\x -> (x, mempty)) > diff --cc src/Ganeti/THH/HsRPC.hs > index 791b81d,5660472..20c7089 > --- a/src/Ganeti/THH/HsRPC.hs > +++ b/src/Ganeti/THH/HsRPC.hs > @@@ -1,6 -1,6 +1,5 @@@ > - {-# LANGUAGE TemplateHaskell, FunctionalDependencies, FlexibleContexts, > - GeneralizedNewtypeDeriving, TypeFamilies #-} > - -- {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} > + {-# LANGUAGE TemplateHaskell, FunctionalDependencies, FlexibleContexts, > CPP, > - TypeFamilies, UndecidableInstances #-} > --- {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} > ++ GeneralizedNewtypeDeriving, TypeFamilies, > UndecidableInstances #-} > > {-| Creates a client out of list of RPC server components. > > @@@ -66,10 -74,37 +73,17 @@@ import Ganeti.UDSServe > -- result or the error. > newtype RpcClientMonad a = > RpcClientMonad { runRpcClientMonad :: ReaderT Client ResultG a } > - > -instance Functor RpcClientMonad where > - fmap f = RpcClientMonad . fmap f . runRpcClientMonad > - > -instance Applicative RpcClientMonad where > - pure = RpcClientMonad . pure > - (RpcClientMonad f) <*> (RpcClientMonad k) = RpcClientMonad (f <*> k) > - > -instance Monad RpcClientMonad where > - return = RpcClientMonad . return > - (RpcClientMonad k) >>= f = RpcClientMonad (k >>= runRpcClientMonad . f) > - > -instance MonadBase IO RpcClientMonad where > - liftBase = RpcClientMonad . liftBase > - > -instance MonadIO RpcClientMonad where > - liftIO = RpcClientMonad . liftIO > - > -instance MonadError GanetiException RpcClientMonad where > - throwError = RpcClientMonad . throwError > - catchError (RpcClientMonad k) h = > - RpcClientMonad (catchError k (runRpcClientMonad . h)) > + deriving (Functor, Applicative, Monad, MonadIO, MonadBase IO, > + MonadError GanetiException) > > instance MonadBaseControl IO RpcClientMonad where > + #if MIN_VERSION_monad_control(1,0,0) > + -- Needs Undecidable instances > + type StM RpcClientMonad b = StM (ReaderT Client ResultG) b > + liftBaseWith f = RpcClientMonad . liftBaseWith > + $ \r -> f (r . runRpcClientMonad) > + restoreM = RpcClientMonad . restoreM > + #else > newtype StM RpcClientMonad b = StMRpcClientMonad > { runStMRpcClientMonad :: StM (ReaderT Client ResultG) b } > liftBaseWith f = RpcClientMonad . liftBaseWith > diff --cc src/Ganeti/WConfd/Core.hs > index d48720b,07b6ec6..569182a > --- a/src/Ganeti/WConfd/Core.hs > +++ b/src/Ganeti/WConfd/Core.hs > @@@ -48,14 -51,19 +51,20 @@@ import System.Posix.Process (getProcess > import qualified System.Random as Rand > > import Ganeti.BasicTypes > + import qualified Ganeti.Constants as C > import qualified Ganeti.JSON as J > import qualified Ganeti.Locking.Allocation as L > - import Ganeti.Locking.Locks ( GanetiLocks(ConfigLock), > LockLevel(LevelConfig) > - , lockLevel, LockLevel, ClientId ) > + import Ganeti.Logging (logDebug) > + import Ganeti.Locking.Locks ( GanetiLocks(ConfigLock, BGL) > + , LockLevel(LevelConfig) > + , lockLevel, LockLevel > + , ClientType(ClientOther), ClientId(..) ) > import qualified Ganeti.Locking.Waiting as LW > import Ganeti.Objects (ConfigData, DRBDSecret, LogicalVolume, Ip4Address) > + import Ganeti.Objects.Lens (configClusterL, clusterMasterNodeL) > + import Ganeti.WConfd.ConfigState (csConfigDataL) > import qualified Ganeti.WConfd.ConfigVerify as V > +import Ganeti.WConfd.DeathDetection (cleanupLocks) > import Ganeti.WConfd.Language > import Ganeti.WConfd.Monad > import qualified Ganeti.WConfd.TempRes as T > @@@ -314,7 -355,7 +356,8 @@@ prepareClusterDestruction cid = d > > exportedFunctions :: [Name] > exportedFunctions = [ 'echo > + , 'cleanupLocks > + , 'prepareClusterDestruction > -- config > , 'readConfig > , 'writeConfig > diff --cc src/Ganeti/WConfd/DeathDetection.hs > index 96d0fd5,ecfb5ce..20b85cd > --- a/src/Ganeti/WConfd/DeathDetection.hs > +++ b/src/Ganeti/WConfd/DeathDetection.hs > @@@ -62,10 -61,12 +62,11 @@@ import Ganeti.WConfd.Persisten > cleanupInterval :: Int > cleanupInterval = C.wconfdDeathdetectionIntervall * 1000000 > > --- | Thread periodically cleaning up locks of lock owners that died. > -cleanupLocksTask :: WConfdMonadInt () > -cleanupLocksTask = forever . runResultT $ do > - logDebug "Death detection timer fired" > +-- | Go through all owners once and clean them up, if they're dead. > +cleanupLocks :: WConfdMonad () > +cleanupLocks = do > owners <- liftM L.lockOwners readLockAllocation > + mylivelock <- liftM dhLivelock daemonHandle > logDebug $ "Current lock owners: " ++ show owners > let cleanupIfDead owner = do > let fpath = ciLockFile owner > @@@ -78,16 -81,12 +81,19 @@@ > :: WConfdMonad (Either IOError ()) > return () > mapM_ cleanupIfDead owners > + > +-- | Thread periodically cleaning up locks of lock owners that died. > +cleanupLocksTask :: WConfdMonadInt () > +cleanupLocksTask = forever . runResultT $ do > + logDebug "Death detection timer fired" > + cleanupLocks > remainingFiles <- liftIO listLiveLocks > ++ mylivelock <- liftM dhLivelock daemonHandle > logDebug $ "Livelockfiles remaining: " ++ show remainingFiles > let cleanupStaleIfDead fpath = do > - died <- liftIO (isDead fpath) > + died <- if fpath == mylivelock > + then return False > + else liftIO (isDead fpath) > when died $ do > logInfo $ "Cleaning up stale file " ++ fpath > _ <- liftIO . E.try $ removeFile fpath > diff --cc src/Ganeti/WConfd/Monad.hs > index e0a9ec0,3148937..59ec4ce > --- a/src/Ganeti/WConfd/Monad.hs > +++ b/src/Ganeti/WConfd/Monad.hs > @@@ -1,7 -1,6 +1,6 @@@ > {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, > - GeneralizedNewtypeDeriving #-} > - {-# LANGUAGE TemplateHaskell #-} > - > ++ GeneralizedNewtypeDeriving, > + TemplateHaskell, CPP, UndecidableInstances #-} > - > {-| All RPC calls are run within this monad. > > It encapsulates: > @@@ -166,15 -179,42 +179,23 @@@ type WConfdMonadIntType = ReaderT Daemo > -- | The internal part of the monad without error handling. > newtype WConfdMonadInt a = WConfdMonadInt > { getWConfdMonadInt :: WConfdMonadIntType a } > - > -instance Functor WConfdMonadInt where > - fmap f = WConfdMonadInt . fmap f . getWConfdMonadInt > - > -instance Applicative WConfdMonadInt where > - pure = WConfdMonadInt . pure > - WConfdMonadInt f <*> WConfdMonadInt k = WConfdMonadInt $ f <*> k > - > -instance Monad WConfdMonadInt where > - return = WConfdMonadInt . return > - (WConfdMonadInt k) >>= f = WConfdMonadInt $ k >>= getWConfdMonadInt . f > - > -instance MonadIO WConfdMonadInt where > - liftIO = WConfdMonadInt . liftIO > - > -instance MonadBase IO WConfdMonadInt where > - liftBase = WConfdMonadInt . liftBase > + deriving (Functor, Applicative, Monad, MonadIO, MonadBase IO, MonadLog) > > instance MonadBaseControl IO WConfdMonadInt where > + #if MIN_VERSION_monad_control(1,0,0) > + -- Needs Undecidable instances > + type StM WConfdMonadInt b = StM WConfdMonadIntType b > + liftBaseWith f = WConfdMonadInt . liftBaseWith > + $ \r -> f (r . getWConfdMonadInt) > + restoreM = WConfdMonadInt . restoreM > + #else > newtype StM WConfdMonadInt b = StMWConfdMonadInt > { runStMWConfdMonadInt :: StM WConfdMonadIntType b } > liftBaseWith f = WConfdMonadInt . liftBaseWith > $ \r -> f (liftM StMWConfdMonadInt . r . > getWConfdMonadInt) > restoreM = WConfdMonadInt . restoreM . runStMWConfdMonadInt > + #endif > > -instance MonadLog WConfdMonadInt where > - logAt p = WConfdMonadInt . logAt p > - > -- | Runs the internal part of the WConfdMonad monad on a given daemon > -- handle. > runWConfdMonadInt :: WConfdMonadInt a -> DaemonHandle -> IO a > @@@ -226,10 -266,9 +247,10 @@@ modifyConfigStateErr f = d > logDebug "Config write and distribution finished" > else do > -- trigger the config. saving worker and wait for it > - logDebug "Triggering config write\ > - \ and asynchronous distribution" > + logDebug $ "Triggering config write" ++ > + " and asynchronous distribution" > liftBase . triggerAndWait (Any False) . dhSaveConfigWorker $ dh > + logDebug "Config writer finished with local task" > return () > return r > > > -- > Klaus Aehlig > Google Germany GmbH, Dienerstr. 12, 80331 Muenchen > Registergericht und -nummer: Hamburg, HRB 86891 > Sitz der Gesellschaft: Hamburg > Geschaeftsfuehrer: Graham Law, Christine Elizabeth Flores >
