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
