Revision a5f248ac

b/htools/Ganeti/HTools/Cluster.hs
61 61
    , tryAlloc
62 62
    , tryMGAlloc
63 63
    , tryReloc
64
    , tryMGReloc
65 64
    , tryEvac
66
    , tryMGEvac
67 65
    , tryNodeEvac
68 66
    , tryChangeGroup
69 67
    , collapseFailures
......
634 632
    -- elements of the tuple
635 633
    in nsols `seq` nsuc `seq` as { asAllocs = nsuc, asSolutions = nsols }
636 634

  
637
-- | Sums two allocation solutions (e.g. for two separate node groups).
638
sumAllocs :: AllocSolution -> AllocSolution -> AllocSolution
639
sumAllocs (AllocSolution af aa as al) (AllocSolution bf ba bs bl) =
640
    AllocSolution (af ++ bf) (aa + ba) (as ++ bs) (al ++ bl)
641

  
642 635
-- | Given a solution, generates a reasonable description for it.
643 636
describeSolution :: AllocSolution -> String
644 637
describeSolution as =
......
820 813
                                \destinations required (" ++ show reqn ++
821 814
                                                  "), only one supported"
822 815

  
823
tryMGReloc :: (Monad m) =>
824
              Group.List      -- ^ The group list
825
           -> Node.List       -- ^ The node list
826
           -> Instance.List   -- ^ The instance list
827
           -> Idx             -- ^ The index of the instance to move
828
           -> Int             -- ^ The number of nodes required
829
           -> [Ndx]           -- ^ Nodes which should not be used
830
           -> m AllocSolution -- ^ Solution list
831
tryMGReloc _ mgnl mgil xid ncount ex_ndx = do
832
  let groups = splitCluster mgnl mgil
833
      -- TODO: we only relocate inside the group for now
834
      inst = Container.find xid mgil
835
  (nl, il) <- case lookup (instancePriGroup mgnl inst) groups of
836
                Nothing -> fail $ "Cannot find group for instance " ++
837
                           Instance.name inst
838
                Just v -> return v
839
  tryReloc nl il xid ncount ex_ndx
840

  
841 816
-- | Change an instance's secondary node.
842 817
evacInstance :: (Monad m) =>
843 818
                [Ndx]                      -- ^ Excluded nodes
......
877 852
  (_, sol) <- foldM (evacInstance ex_ndx il) (nl, emptyAllocSolution) idxs
878 853
  return sol
879 854

  
880
-- | Multi-group evacuation of a list of nodes.
881
tryMGEvac :: (Monad m) =>
882
             Group.List -- ^ The group list
883
          -> Node.List       -- ^ The node list
884
          -> Instance.List   -- ^ The instance list
885
          -> [Ndx]           -- ^ Nodes to be evacuated
886
          -> m AllocSolution -- ^ Solution list
887
tryMGEvac _ nl il ex_ndx =
888
    let ex_nodes = map (`Container.find` nl) ex_ndx
889
        all_insts = nub . concatMap Node.sList $ ex_nodes
890
        all_insts' = associateIdxs all_insts $ splitCluster nl il
891
    in do
892
      results <- mapM (\(_, (gnl, gil, idxs)) -> tryEvac gnl gil idxs ex_ndx)
893
                 all_insts'
894
      let sol = foldl' sumAllocs emptyAllocSolution results
895
      return $ annotateSolution sol
896

  
897 855
-- | Function which fails if the requested mode is change secondary.
898 856
--
899 857
-- This is useful since except DRBD, no other disk template can
......
1426 1384
               instances = Container.filter ((`elem` nidxs) . Instance.pNode) il
1427 1385
           in (guuid, (Container.fromList nodes', instances))) ngroups
1428 1386

  
1429
-- | Split a global instance index map into per-group, and associate
1430
-- it with the group/node/instance lists.
1431
associateIdxs :: [Idx] -- ^ Instance indices to be split/associated
1432
              -> [(Gdx, (Node.List, Instance.List))]        -- ^ Input groups
1433
              -> [(Gdx, (Node.List, Instance.List, [Idx]))] -- ^ Result
1434
associateIdxs idxs =
1435
    map (\(gdx, (nl, il)) ->
1436
             (gdx, (nl, il, filter (`Container.member` il) idxs)))
1437

  
1438 1387
-- | Compute the list of nodes that are to be evacuated, given a list
1439 1388
-- of instances and an evacuation mode.
1440 1389
nodesToEvacuate :: Instance.List -- ^ The cluster-wide instance list

Also available in: Unified diff