Revision a5e58418

b/src/Ganeti/HTools/Program/Harep.hs
28 28
  , arguments
29 29
  , options) where
30 30

  
31
import Control.Exception (bracket)
31 32
import Control.Monad
32 33
import Data.Function
33 34
import Data.List
......
37 38

  
38 39
import Ganeti.BasicTypes
39 40
import Ganeti.Common
41
import Ganeti.Errors
42
import Ganeti.Jobs
43
import Ganeti.OpCodes
40 44
import Ganeti.Types
41 45
import Ganeti.Utils
42 46
import qualified Ganeti.Constants as C
47
import qualified Ganeti.Luxi as L
43 48
import qualified Ganeti.Path as Path
44 49

  
45 50
import Ganeti.HTools.CLI
......
111 116
    ArNeedsRepair   d  -> Just d
112 117
    _                  -> Nothing
113 118

  
119
-- | Return a short name for each auto-repair status.
120
--
121
-- This is a more concise representation of the status, because the default
122
-- "Show" formatting includes all the accompanying auto-repair data.
123
arStateName :: AutoRepairStatus -> String
124
arStateName status =
125
  case status of
126
    ArHealthy _       -> "Healthy"
127
    ArFailedRepair _  -> "Failure"
128
    ArPendingRepair _ -> "Pending repair"
129
    ArNeedsRepair _   -> "Needs repair"
130

  
114 131
-- | Return a new list of tags to remove that includes @arTag@ if present.
115 132
delCurTag :: InstanceData -> [String]
116 133
delCurTag instData =
......
177 194
     ArNeedsRepair _ -> Bad
178 195
       "programming error: ArNeedsRepair found as an initial state"
179 196

  
197
-- | Query jobs of a pending repair, returning the new instance data.
198
processPending :: L.Client -> InstanceData -> IO InstanceData
199
processPending client instData =
200
  case arState instData of
201
    (ArPendingRepair arData) -> do
202
      sts <- L.queryJobsStatus client $ arJobs arData
203
      time <- getClockTime
204
      case sts of
205
        Bad e -> exitErr $ "could not check job status: " ++ formatError e
206
        Ok sts' ->
207
          if any (<= JOB_STATUS_RUNNING) sts' then
208
            return instData -- (no change)
209
          else do
210
            let iname = Instance.name $ arInstance instData
211
                srcSt = arStateName $ arState instData
212
                destSt = arStateName arState'
213
            putStrLn ("Moving " ++ iname ++ " from " ++ show srcSt ++ " to " ++
214
                      show destSt)
215
            commitChange client instData'
216
          where
217
            instData' =
218
              instData { arState = arState'
219
                       , tagsToRemove = delCurTag instData
220
                       }
221
            arState' =
222
              if all (== JOB_STATUS_SUCCESS) sts' then
223
                ArHealthy $ Just (updateTag $ arData { arResult = Just ArSuccess
224
                                                     , arTime = time })
225
              else
226
                ArFailedRepair (updateTag $ arData { arResult = Just ArFailure
227
                                                   , arTime = time })
228

  
229
    _ -> return instData
230

  
231
-- | Update the tag of an 'AutoRepairData' record to match all the other fields.
232
updateTag :: AutoRepairData -> AutoRepairData
233
updateTag arData =
234
  let ini = [autoRepairTypeToRaw $ arType arData,
235
             arUuid arData,
236
             clockTimeToString $ arTime arData]
237
      end = [intercalate "+" . map (show . fromJobId) $ arJobs arData]
238
      (pfx, middle) =
239
         case arResult arData of
240
          Nothing -> (C.autoRepairTagPending, [])
241
          Just rs -> (C.autoRepairTagResult, [autoRepairResultToRaw rs])
242
  in
243
   arData { arTag = pfx ++ intercalate ":" (ini ++ middle ++ end) }
244

  
245
-- | Apply and remove tags from an instance as indicated by 'InstanceData'.
246
--
247
-- If the /arState/ of the /InstanceData/ record has an associated
248
-- 'AutoRepairData', add its tag to the instance object. Additionally, if
249
-- /tagsToRemove/ is not empty, remove those tags from the instance object. The
250
-- returned /InstanceData/ object always has an empty /tagsToRemove/.
251
commitChange :: L.Client -> InstanceData -> IO InstanceData
252
commitChange client instData = do
253
  let iname = Instance.name $ arInstance instData
254
      arData = getArData $ arState instData
255
      rmTags = tagsToRemove instData
256
      execJobsWaitOk' opcodes = do
257
        res <- execJobsWaitOk [map wrapOpCode opcodes] client
258
        case res of
259
          Ok _ -> return ()
260
          Bad e -> exitErr e
261

  
262
  when (isJust arData) $ do
263
    let tag = arTag $ fromJust arData
264
    putStrLn (">>> Adding the following tag to " ++ iname ++ ":\n" ++ show tag)
265
    execJobsWaitOk' [OpTagsSet (TagInstance iname) [tag]]
266

  
267
  unless (null rmTags) $ do
268
    putStr (">>> Removing the following tags from " ++ iname ++ ":\n" ++
269
            unlines (map show rmTags))
270
    execJobsWaitOk' [OpTagsDel (TagInstance iname) rmTags]
271

  
272
  return instData { tagsToRemove = [] }
273

  
180 274
-- | Main function.
181 275
main :: Options -> [String] -> IO ()
182 276
main opts args = do
......
190 284
  (ClusterData _ _ il _ _) <- loadExternalData opts'
191 285

  
192 286
  let iniDataRes = mapM setInitialState $ Container.elems il
193
  _unused_iniData <- exitIfBad "when parsing auto-repair tags" iniDataRes
287
  iniData <- exitIfBad "when parsing auto-repair tags" iniDataRes
288

  
289
  -- First step: check all pending repairs, see if they are completed.
290
  _unused_iniData' <- bracket (L.getClient master) L.closeClient $
291
                      forM iniData . processPending
194 292

  
195 293
  return ()

Also available in: Unified diff