code.grnet.gr Git - ganeti-local/blob - src/Ganeti/HTools/Program/Harep.hs

   1 {-# LANGUAGE TupleSections #-}
   2
   3 {-| Auto-repair tool for Ganeti.
   4
   5 -}
   6
   7 {-
   8
   9 Copyright (C) 2013 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.HTools.Program.Harep
  29   ( main
  30   , arguments
  31   , options) where
  32
  33 import Control.Exception (bracket)
  34 import Control.Monad
  35 import Data.Function
  36 import Data.List
  37 import Data.Maybe
  38 import Data.Ord
  39 import System.Time
  40 import qualified Data.Map as Map
  41
  42 import Ganeti.BasicTypes
  43 import Ganeti.Common
  44 import Ganeti.Errors
  45 import Ganeti.Jobs
  46 import Ganeti.OpCodes
  47 import Ganeti.OpParams
  48 import Ganeti.Types
  49 import Ganeti.Utils
  50 import qualified Ganeti.Constants as C
  51 import qualified Ganeti.Luxi as L
  52 import qualified Ganeti.Path as Path
  53
  54 import Ganeti.HTools.CLI
  55 import Ganeti.HTools.Loader
  56 import Ganeti.HTools.ExtLoader
  57 import Ganeti.HTools.Types
  58 import qualified Ganeti.HTools.Container as Container
  59 import qualified Ganeti.HTools.Instance as Instance
  60 import qualified Ganeti.HTools.Node as Node
  61
  62 -- | Options list and functions.
  63 options :: IO [OptType]
  64 options = do
  65   luxi <- oLuxiSocket
  66   return
  67     [ luxi
  68     , oJobDelay
  69     ]
  70
  71 arguments :: [ArgCompletion]
  72 arguments = []
  73
  74 data InstanceData = InstanceData { arInstance :: Instance.Instance
  75                                  , arState :: AutoRepairStatus
  76                                  , tagsToRemove :: [String]
  77                                  }
  78                     deriving (Eq, Show)
  79
  80 -- | Parse a tag into an 'AutoRepairData' record.
  81 --
  82 -- @Nothing@ is returned if the tag is not an auto-repair tag, or if it's
  83 -- malformed.
  84 parseInitTag :: String -> Maybe AutoRepairData
  85 parseInitTag tag =
  86   let parsePending = do
  87         subtag <- chompPrefix C.autoRepairTagPending tag
  88         case sepSplit ':' subtag of
  89           [rtype, uuid, ts, jobs] -> makeArData rtype uuid ts jobs
  90           _                       -> fail ("Invalid tag: " ++ show tag)
  91
  92       parseResult = do
  93         subtag <- chompPrefix C.autoRepairTagResult tag
  94         case sepSplit ':' subtag of
  95           [rtype, uuid, ts, result, jobs] -> do
  96             arData <- makeArData rtype uuid ts jobs
  97             result' <- autoRepairResultFromRaw result
  98             return arData { arResult = Just result' }
  99           _                               -> fail ("Invalid tag: " ++ show tag)
 100
 101       makeArData rtype uuid ts jobs = do
 102         rtype' <- autoRepairTypeFromRaw rtype
 103         ts' <- tryRead "auto-repair time" ts
 104         jobs' <- mapM makeJobIdS $ sepSplit '+' jobs
 105         return AutoRepairData { arType = rtype'
 106                               , arUuid = uuid
 107                               , arTime = TOD ts' 0
 108                               , arJobs = jobs'
 109                               , arResult = Nothing
 110                               , arTag = tag
 111                               }
 112   in
 113    parsePending `mplus` parseResult
 114
 115 -- | Return the 'AutoRepairData' element of an 'AutoRepairStatus' type.
 116 getArData :: AutoRepairStatus -> Maybe AutoRepairData
 117 getArData status =
 118   case status of
 119     ArHealthy (Just d) -> Just d
 120     ArFailedRepair  d  -> Just d
 121     ArPendingRepair d  -> Just d
 122     ArNeedsRepair   d  -> Just d
 123     _                  -> Nothing
 124
 125 -- | Return a short name for each auto-repair status.
 126 --
 127 -- This is a more concise representation of the status, because the default
 128 -- "Show" formatting includes all the accompanying auto-repair data.
 129 arStateName :: AutoRepairStatus -> String
 130 arStateName status =
 131   case status of
 132     ArHealthy _       -> "Healthy"
 133     ArFailedRepair _  -> "Failure"
 134     ArPendingRepair _ -> "Pending repair"
 135     ArNeedsRepair _   -> "Needs repair"
 136
 137 -- | Return a new list of tags to remove that includes @arTag@ if present.
 138 delCurTag :: InstanceData -> [String]
 139 delCurTag instData =
 140   let arData = getArData $ arState instData
 141       rmTags = tagsToRemove instData
 142   in
 143    case arData of
 144      Just d  -> arTag d : rmTags
 145      Nothing -> rmTags
 146
 147 -- | Set the initial auto-repair state of an instance from its auto-repair tags.
 148 --
 149 -- The rules when there are multiple tags is:
 150 --
 151 --   * the earliest failure result always wins
 152 --
 153 --   * two or more pending repairs results in a fatal error
 154 --
 155 --   * a pending result from id X and a success result from id Y result in error
 156 --     if Y is newer than X
 157 --
 158 --   * if there are no pending repairs, the newest success result wins,
 159 --     otherwise the pending result is used.
 160 setInitialState :: Instance.Instance -> Result InstanceData
 161 setInitialState inst =
 162   let arData = mapMaybe parseInitTag $ Instance.allTags inst
 163       -- Group all the AutoRepairData records by id (i.e. by repair task), and
 164       -- present them from oldest to newest.
 165       arData' = sortBy (comparing arUuid) arData
 166       arGroups = groupBy ((==) `on` arUuid) arData'
 167       arGroups' = sortBy (comparing $ minimum . map arTime) arGroups
 168   in
 169    foldM arStatusCmp (InstanceData inst (ArHealthy Nothing) []) arGroups'
 170
 171 -- | Update the initial status of an instance with new repair task tags.
 172 --
 173 -- This function gets called once per repair group in an instance's tag, and it
 174 -- determines whether to set the status of the instance according to this new
 175 -- group, or to keep the existing state. See the documentation for
 176 -- 'setInitialState' for the rules to be followed when determining this.
 177 arStatusCmp :: InstanceData -> [AutoRepairData] -> Result InstanceData
 178 arStatusCmp instData arData =
 179   let curSt = arState instData
 180       arData' = sortBy (comparing keyfn) arData
 181       keyfn d = (arResult d, arTime d)
 182       newData = last arData'
 183       newSt = case arResult newData of
 184                 Just ArSuccess -> ArHealthy $ Just newData
 185                 Just ArEnoperm -> ArHealthy $ Just newData
 186                 Just ArFailure -> ArFailedRepair newData
 187                 Nothing        -> ArPendingRepair newData
 188   in
 189    case curSt of
 190      ArFailedRepair _ -> Ok instData  -- Always keep the earliest failure.
 191      ArHealthy _      -> Ok instData { arState = newSt
 192                                      , tagsToRemove = delCurTag instData
 193                                      }
 194      ArPendingRepair d -> Bad (
 195        "An unfinished repair was found in instance " ++
 196        Instance.name (arInstance instData) ++ ": found tag " ++
 197        show (arTag newData) ++ ", but older pending tag " ++
 198        show (arTag d) ++ "exists.")
 199
 200      ArNeedsRepair _ -> Bad
 201        "programming error: ArNeedsRepair found as an initial state"
 202
 203 -- | Query jobs of a pending repair, returning the new instance data.
 204 processPending :: L.Client -> InstanceData -> IO InstanceData
 205 processPending client instData =
 206   case arState instData of
 207     (ArPendingRepair arData) -> do
 208       sts <- L.queryJobsStatus client $ arJobs arData
 209       time <- getClockTime
 210       case sts of
 211         Bad e -> exitErr $ "could not check job status: " ++ formatError e
 212         Ok sts' ->
 213           if any (<= JOB_STATUS_RUNNING) sts' then
 214             return instData -- (no change)
 215           else do
 216             let iname = Instance.name $ arInstance instData
 217                 srcSt = arStateName $ arState instData
 218                 destSt = arStateName arState'
 219             putStrLn ("Moving " ++ iname ++ " from " ++ show srcSt ++ " to " ++
 220                       show destSt)
 221             commitChange client instData'
 222           where
 223             instData' =
 224               instData { arState = arState'
 225                        , tagsToRemove = delCurTag instData
 226                        }
 227             arState' =
 228               if all (== JOB_STATUS_SUCCESS) sts' then
 229                 ArHealthy $ Just (updateTag $ arData { arResult = Just ArSuccess
 230                                                      , arTime = time })
 231               else
 232                 ArFailedRepair (updateTag $ arData { arResult = Just ArFailure
 233                                                    , arTime = time })
 234
 235     _ -> return instData
 236
 237 -- | Update the tag of an 'AutoRepairData' record to match all the other fields.
 238 updateTag :: AutoRepairData -> AutoRepairData
 239 updateTag arData =
 240   let ini = [autoRepairTypeToRaw $ arType arData,
 241              arUuid arData,
 242              clockTimeToString $ arTime arData]
 243       end = [intercalate "+" . map (show . fromJobId) $ arJobs arData]
 244       (pfx, middle) =
 245          case arResult arData of
 246           Nothing -> (C.autoRepairTagPending, [])
 247           Just rs -> (C.autoRepairTagResult, [autoRepairResultToRaw rs])
 248   in
 249    arData { arTag = pfx ++ intercalate ":" (ini ++ middle ++ end) }
 250
 251 -- | Apply and remove tags from an instance as indicated by 'InstanceData'.
 252 --
 253 -- If the /arState/ of the /InstanceData/ record has an associated
 254 -- 'AutoRepairData', add its tag to the instance object. Additionally, if
 255 -- /tagsToRemove/ is not empty, remove those tags from the instance object. The
 256 -- returned /InstanceData/ object always has an empty /tagsToRemove/.
 257 commitChange :: L.Client -> InstanceData -> IO InstanceData
 258 commitChange client instData = do
 259   let iname = Instance.name $ arInstance instData
 260       arData = getArData $ arState instData
 261       rmTags = tagsToRemove instData
 262       execJobsWaitOk' opcodes = do
 263         res <- execJobsWaitOk [map wrapOpCode opcodes] client
 264         case res of
 265           Ok _ -> return ()
 266           Bad e -> exitErr e
 267
 268   when (isJust arData) $ do
 269     let tag = arTag $ fromJust arData
 270     putStrLn (">>> Adding the following tag to " ++ iname ++ ":\n" ++ show tag)
 271     execJobsWaitOk' [OpTagsSet (TagInstance iname) [tag]]
 272
 273   unless (null rmTags) $ do
 274     putStr (">>> Removing the following tags from " ++ iname ++ ":\n" ++
 275             unlines (map show rmTags))
 276     execJobsWaitOk' [OpTagsDel (TagInstance iname) rmTags]
 277
 278   return instData { tagsToRemove = [] }
 279
 280 -- | Detect brokenness with an instance and suggest repair type and jobs to run.
 281 detectBroken :: Node.List -> Instance.Instance
 282              -> Maybe (AutoRepairType, [OpCode])
 283 detectBroken nl inst =
 284   let disk = Instance.diskTemplate inst
 285       iname = Instance.name inst
 286       offPri = Node.offline $ Container.find (Instance.pNode inst) nl
 287       offSec = Node.offline $ Container.find (Instance.sNode inst) nl
 288   in
 289    case disk of
 290      DTDrbd8
 291        | offPri && offSec ->
 292          Just (
 293            ArReinstall,
 294            [ OpInstanceRecreateDisks { opInstanceName = iname
 295                                      , opRecreateDisksInfo = RecreateDisksAll
 296                                      , opNodes = []
 297                                        -- FIXME: there should be a better way to
 298                                        -- specify opcode parameters than abusing
 299                                        -- mkNonEmpty in this way (using the fact
 300                                        -- that Maybe is used both for optional
 301                                        -- fields, and to express failure).
 302                                      , opIallocator = mkNonEmpty "hail"
 303                                      }
 304            , OpInstanceReinstall { opInstanceName = iname
 305                                  , opOsType = Nothing
 306                                  , opTempOsParams = Nothing
 307                                  , opForceVariant = False
 308                                  }
 309            ])
 310        | offPri ->
 311          Just (
 312            ArFailover,
 313            [ OpInstanceFailover { opInstanceName = iname
 314                                   -- FIXME: ditto, see above.
 315                                 , opShutdownTimeout = fromJust $ mkNonNegative
 316                                                       C.defaultShutdownTimeout
 317                                 , opIgnoreConsistency = False
 318                                 , opTargetNode = Nothing
 319                                 , opIgnoreIpolicy = False
 320                                 , opIallocator = Nothing
 321                                 , opMigrationCleanup = False
 322                                 }
 323            ])
 324        | offSec ->
 325          Just (
 326            ArFixStorage,
 327            [ OpInstanceReplaceDisks { opInstanceName = iname
 328                                     , opReplaceDisksMode = ReplaceNewSecondary
 329                                     , opReplaceDisksList = []
 330                                     , opRemoteNode = Nothing
 331                                       -- FIXME: ditto, see above.
 332                                     , opIallocator = mkNonEmpty "hail"
 333                                     , opEarlyRelease = False
 334                                     , opIgnoreIpolicy = False
 335                                     }
 336             ])
 337        | otherwise -> Nothing
 338
 339      DTPlain
 340        | offPri ->
 341          Just (
 342            ArReinstall,
 343            [ OpInstanceRecreateDisks { opInstanceName = iname
 344                                      , opRecreateDisksInfo = RecreateDisksAll
 345                                      , opNodes = []
 346                                        -- FIXME: ditto, see above.
 347                                      , opIallocator = mkNonEmpty "hail"
 348                                      }
 349            , OpInstanceReinstall { opInstanceName = iname
 350                                  , opOsType = Nothing
 351                                  , opTempOsParams = Nothing
 352                                  , opForceVariant = False
 353                                  }
 354            ])
 355        | otherwise -> Nothing
 356
 357      _ -> Nothing  -- Other cases are unimplemented for now: DTDiskless,
 358                    -- DTFile, DTSharedFile, DTBlock, DTRbd, DTExt.
 359
 360 -- | Perform the suggested repair on an instance if its policy allows it.
 361 doRepair :: L.Client     -- ^ The Luxi client
 362          -> Double       -- ^ Delay to insert before the first repair opcode
 363          -> InstanceData -- ^ The instance data
 364          -> (AutoRepairType, [OpCode]) -- ^ The repair job to perform
 365          -> IO InstanceData -- ^ The updated instance data
 366 doRepair client delay instData (rtype, opcodes) =
 367   let inst = arInstance instData
 368       ipol = Instance.arPolicy inst
 369       iname = Instance.name inst
 370   in
 371   case ipol of
 372     ArEnabled maxtype ->
 373       if rtype > maxtype then do
 374         uuid <- newUUID
 375         time <- getClockTime
 376
 377         let arState' = ArNeedsRepair (
 378               updateTag $ AutoRepairData rtype uuid time [] (Just ArEnoperm) "")
 379             instData' = instData { arState = arState'
 380                                  , tagsToRemove = delCurTag instData
 381                                  }
 382
 383         putStrLn ("Not performing a repair of type " ++ show rtype ++ " on " ++
 384           iname ++ " because only repairs up to " ++ show maxtype ++
 385           " are allowed")
 386         commitChange client instData'  -- Adds "enoperm" result label.
 387       else do
 388         putStrLn ("Executing " ++ show rtype ++ " repair on " ++ iname)
 389
 390         -- After submitting the job, we must write an autorepair:pending tag,
 391         -- that includes the repair job IDs so that they can be checked later.
 392         -- One problem we run into is that the repair job immediately grabs
 393         -- locks for the affected instance, and the subsequent TAGS_SET job is
 394         -- blocked, introducing an unnecessary delay for the end-user. One
 395         -- alternative would be not to wait for the completion of the TAGS_SET
 396         -- job, contrary to what commitChange normally does; but we insist on
 397         -- waiting for the tag to be set so as to abort in case of failure,
 398         -- because the cluster is left in an invalid state in that case.
 399         --
 400         -- The proper solution (in 2.9+) would be not to use tags for storing
 401         -- autorepair data, or make the TAGS_SET opcode not grab an instance's
 402         -- locks (if that's deemed safe). In the meantime, we introduce an
 403         -- artificial delay in the repair job (via a TestDelay opcode) so that
 404         -- once we have the job ID, the TAGS_SET job can complete before the
 405         -- repair job actually grabs the locks. (Please note that this is not
 406         -- about synchronization, but merely about speeding up the execution of
 407         -- the harep tool. If this TestDelay opcode is removed, the program is
 408         -- still correct.)
 409         let opcodes' =
 410               if delay > 0 then
 411                 OpTestDelay { opDelayDuration = delay
 412                             , opDelayOnMaster = True
 413                             , opDelayOnNodes = []
 414                             , opDelayRepeat = fromJust $ mkNonNegative 0
 415                             } : opcodes
 416               else
 417                 opcodes
 418
 419         uuid <- newUUID
 420         time <- getClockTime
 421         jids <- submitJobs [map wrapOpCode opcodes'] client
 422
 423         case jids of
 424           Bad e    -> exitErr e
 425           Ok jids' ->
 426             let arState' = ArPendingRepair (
 427                   updateTag $ AutoRepairData rtype uuid time jids' Nothing "")
 428                 instData' = instData { arState = arState'
 429                                      , tagsToRemove = delCurTag instData
 430                                      }
 431             in
 432              commitChange client instData'  -- Adds "pending" label.
 433
 434     otherSt -> do
 435       putStrLn ("Not repairing " ++ iname ++ " because it's in state " ++
 436                 show otherSt)
 437       return instData
 438
 439 -- | Main function.
 440 main :: Options -> [String] -> IO ()
 441 main opts args = do
 442   unless (null args) $
 443     exitErr "this program doesn't take any arguments."
 444
 445   luxiDef <- Path.defaultLuxiSocket
 446   let master = fromMaybe luxiDef $ optLuxi opts
 447       opts' = opts { optLuxi = Just master }
 448
 449   (ClusterData _ nl il _ _) <- loadExternalData opts'
 450
 451   let iniDataRes = mapM setInitialState $ Container.elems il
 452   iniData <- exitIfBad "when parsing auto-repair tags" iniDataRes
 453
 454   -- First step: check all pending repairs, see if they are completed.
 455   iniData' <- bracket (L.getClient master) L.closeClient $
 456               forM iniData . processPending
 457
 458   -- Second step: detect any problems.
 459   let repairs = map (detectBroken nl . arInstance) iniData'
 460
 461   -- Third step: create repair jobs for broken instances that are in ArHealthy.
 462   let maybeRepair c (i, r) = maybe (return i) (repairHealthy c i) r
 463       jobDelay = optJobDelay opts
 464       repairHealthy c i = case arState i of
 465                             ArHealthy _ -> doRepair c jobDelay i
 466                             _           -> const (return i)
 467
 468   repairDone <- bracket (L.getClient master) L.closeClient $
 469                 forM (zip iniData' repairs) . maybeRepair
 470
 471   -- Print some stats and exit.
 472   let states = map ((, 1 :: Int) . arStateName . arState) repairDone
 473       counts = Map.fromListWith (+) states
 474
 475   putStrLn "---------------------"
 476   putStrLn "Instance status count"
 477   putStrLn "---------------------"
 478   putStr . unlines . Map.elems $
 479     Map.mapWithKey (\k v -> k ++ ": " ++ show v) counts