Parse auto-repair tags to set each instance in one of ArHealthy, ArFailed, or ArPendingRepair. The implementation tries to be well behaved when old tags have been left behind, which future patches will still try _not_ to do.
Signed-off-by: Dato Simó <[email protected]> --- src/Ganeti/HTools/Program/Harep.hs | 128 +++++++++++++++++++++++++++++++++++++ 1 file changed, 128 insertions(+) diff --git a/src/Ganeti/HTools/Program/Harep.hs b/src/Ganeti/HTools/Program/Harep.hs index d8274bc..484b859 100644 --- a/src/Ganeti/HTools/Program/Harep.hs +++ b/src/Ganeti/HTools/Program/Harep.hs @@ -29,12 +29,23 @@ module Ganeti.HTools.Program.Harep , options) where import Control.Monad +import Data.Function +import Data.List import Data.Maybe +import Data.Ord +import System.Time import Ganeti.Common +import Ganeti.Types import Ganeti.Utils +import qualified Ganeti.Constants as C import Ganeti.HTools.CLI +import Ganeti.HTools.Loader +import Ganeti.HTools.ExtLoader +import Ganeti.HTools.Types +import qualified Ganeti.HTools.Container as Container +import qualified Ganeti.HTools.Instance as Instance -- | Options list and functions. options :: IO [OptType] @@ -47,6 +58,119 @@ options = do arguments :: [ArgCompletion] arguments = [] +data InstanceData = InstanceData { arInstance :: Instance.Instance + , arState :: AutoRepairStatus + , tagsToRemove :: [String] + } + deriving (Eq, Show) + +-- | Parse a tag into an 'AutoRepairData' record. +-- +-- @Nothing@ is returned if the tag is not an auto-repair tag, or if it's +-- malformed. +parseInitTag :: String -> Maybe AutoRepairData +parseInitTag tag = + let parsePending = do + subtag <- chompPrefix C.autoRepairTagPending tag + let [rtype, uuid, ts, jobs] = sepSplit ':' subtag + makeArData rtype uuid ts jobs + + parseResult = do + subtag <- chompPrefix C.autoRepairTagResult tag + let [rtype, uuid, ts, result, jobs] = sepSplit ':' subtag + arData <- makeArData rtype uuid ts jobs + result' <- autoRepairResultFromRaw result + return arData { arResult = Just result' } + + makeArData rtype uuid ts jobs = do + rtype' <- autoRepairTypeFromRaw rtype + ts' <- tryRead "auto-repair time" ts + jobs' <- mapM makeJobIdS $ sepSplit '+' jobs + return AutoRepairData { arType = rtype' + , arUuid = uuid + , arTime = TOD ts' 0 + , arJobs = jobs' + , arResult = Nothing + , arTag = tag + } + in + mplus parsePending parseResult + +-- | Return the 'AutoRepairData' element of an 'AutoRepairStatus' type. +getArData :: AutoRepairStatus -> Maybe AutoRepairData +getArData status = + case status of + ArHealthy (Just d) -> Just d + ArFailedRepair d -> Just d + ArPendingRepair d -> Just d + ArNeedsRepair d -> Just d + _ -> Nothing + +-- | Return a new list of tags to remove that includes @arTag@ if present. +delCurTag :: InstanceData -> [String] +delCurTag instData = + let arData = getArData $ arState instData + rmTags = tagsToRemove instData + in + case arData of + Just d -> arTag d : rmTags + Nothing -> rmTags + +-- | Set the initial auto-repair state of an instance from its auto-repair tags. +-- +-- The rules when there are multiple tags is: +-- +-- * the earliest failure result always wins +-- +-- * two or more pending repairs results in a fatal error +-- +-- * a pending result from id X and a success result from id Y result in error +-- if Y is newer than X +-- +-- * if there are no pending repairs, the newest success result wins, +-- otherwise the pending result is used. +setInitialState :: Instance.Instance -> InstanceData +setInitialState inst = + let arData = mapMaybe parseInitTag $ Instance.allTags inst + -- Group all the AutoRepairData records by id (i.e. by repair task), and + -- present them from oldest to newest. + arData' = sortBy (comparing arUuid) arData + arGroups = groupBy ((==) `on` arUuid) arData' + arGroups' = sortBy (comparing $ minimum . map arTime) arGroups + in + foldl arStatusCmp (InstanceData inst (ArHealthy Nothing) []) arGroups' + +-- | Update the initial status of an instance with new repair task tags. +-- +-- This function gets called once per repair group in an instance's tag, and it +-- determines whether to set the status of the instance according to this new +-- group, or to keep the existing state. See the documentation for +-- 'setInitialState' for the rules to be followed when determining this. +arStatusCmp :: InstanceData -> [AutoRepairData] -> InstanceData +arStatusCmp instData arData = + let curSt = arState instData + arData' = sortBy (comparing keyfn) arData + keyfn d = (arResult d, arTime d) + newData = last arData' + newSt = case arResult newData of + Just ArSuccess -> ArHealthy $ Just newData + Just ArEnoperm -> ArHealthy $ Just newData + Just ArFailure -> ArFailedRepair newData + Nothing -> ArPendingRepair newData + in + case curSt of + ArFailedRepair _ -> instData -- Always keep the earliest failure. + ArHealthy _ -> instData { arState = newSt + , tagsToRemove = delCurTag instData + } + ArPendingRepair d -> error ( + "An unfinished repair was found in instance " ++ + Instance.name (arInstance instData) ++ ": found tag " ++ + show (arTag newData) ++ ", but older pending tag " ++ + show (arTag d) ++ "exists.") + + ArNeedsRepair _ -> instData -- Never happens, but silence GHC. + -- | Main function. main :: Options -> [String] -> IO () main opts args = do @@ -58,4 +182,8 @@ main opts args = do when (isNothing lsock) $ exitErr "Luxi socket (-L) required to execute jobs." + (ClusterData _ _ il _ _) <- loadExternalData opts + + let _unused_iniData = map setInitialState $ Container.elems il + return () -- 1.8.0.2-x20-1
