Revision ef947a42 src/Ganeti/HTools/Loader.hs

b/src/Ganeti/HTools/Loader.hs
182 182 
            -> Group.List     -- ^ List of node groups
183 183 
            -> Node.List      -- ^ List of nodes
184 184 
            -> Instance.List  -- ^ List of instances
185 
            -> ClockTime      -- ^ Current timestamp, to evaluate ArSuspended
185 186 
            -> Instance.List  -- ^ Updated list of instances
186 
setArPolicy ctags gl nl il =
187 
  let cpol = fromMaybe ArNotEnabled $ getArPolicy ctags
188 
      gpols = Container.map (fromMaybe cpol . getArPolicy . Group.allTags) gl
189 
      ipolfn = getArPolicy . Instance.allTags
187 
setArPolicy ctags gl nl il time =
188 
  let getArPolicy' = flip getArPolicy time
189 
      cpol = fromMaybe ArNotEnabled $ getArPolicy' ctags
190 
      gpols = Container.map (fromMaybe cpol . getArPolicy' . Group.allTags) gl
191 
      ipolfn = getArPolicy' . Instance.allTags
190 192 
      nlookup = flip Container.find nl . Instance.pNode
191 193 
      glookup = flip Container.find gpols . Node.group . nlookup
192 194 
      updateInstance inst = inst {
......
199 201 
-- This examines the ganeti:watcher:autorepair and
200 202 
-- ganeti:watcher:autorepair:suspend tags to determine the policy. If none of
201 203 
-- these tags are present, Nothing (and not ArNotEnabled) is returned.
202 
getArPolicy :: [String] -> Maybe AutoRepairPolicy
203 
getArPolicy tags =
204 
getArPolicy :: [String] -> ClockTime -> Maybe AutoRepairPolicy
205 
getArPolicy tags time =
204 206 
  let enabled = mapMaybe (autoRepairTypeFromRaw <=<
205 207 
                          chompPrefix C.autoRepairTagEnabled) tags
206 208 
      suspended = mapMaybe (chompPrefix C.autoRepairTagSuspended) tags
207 
      suspTime = if "" `elem` suspended
208 
                   then Forever
209 
                   else Until . flip TOD 0 . maximum $
210 
                        mapMaybe (tryRead "auto-repair suspend time") suspended
209 
      futureTs = filter (> time) . map (flip TOD 0) $
210 
                   mapMaybe (tryRead "auto-repair suspend time") suspended
211 211 
  in
212 212 
   case () of
213 213 
     -- Note how we must return ArSuspended even if "enabled" is empty, so that
214 214 
     -- node groups or instances can suspend repairs that were enabled at an
215 215 
     -- upper scope (cluster or node group).
216 
     _ | not $ null suspended -> Just $ ArSuspended suspTime
217 
       | not $ null enabled   -> Just $ ArEnabled (minimum enabled)
218 
       | otherwise            -> Nothing
216 
     _ | "" `elem` suspended -> Just $ ArSuspended Forever
217 
       | not $ null futureTs -> Just . ArSuspended . Until . maximum $ futureTs
218 
       | not $ null enabled  -> Just $ ArEnabled (minimum enabled)
219 
       | otherwise           -> Nothing
219 220 

  		





  220
  221
  
    
-- | Compute the longest common suffix of a list of strings that


  		





  221
  222
  
    
-- starts with a dot.


  		





  ......




  244
  245
  
    
          -> [String]             -- ^ Exclusion tags


  		





  245
  246
  
    
          -> [String]             -- ^ Selected instances (if not empty)


  		





  246
  247
  
    
          -> [String]             -- ^ Excluded instances


  		





  
  248
  
    
          -> ClockTime            -- ^ The current timestamp


  		





  247
  249
  
    
          -> ClusterData          -- ^ Data from backends


  		





  248
  250
  
    
          -> Result ClusterData   -- ^ Fixed cluster data


  		





  249
  
  
    
mergeData um extags selinsts exinsts cdata@(ClusterData gl nl il ctags _) =


  		





  250
  
  
    
  let il2 = setArPolicy ctags gl nl il


  		





  
  251
  
    
mergeData um extags selinsts exinsts time cdata@(ClusterData gl nl il ctags _) =


  		





  
  252
  
    
  let il2 = setArPolicy ctags gl nl il time


  		





  251
  253
  
    
      il3 = foldl' (\im (name, n_util) ->


  		





  252
  254
  
    
                        case Container.findByName im name of


  		





  253
  255
  
    
                          Nothing -> im -- skipping unknown instance


  		












Also available in:
  Unified diff