Revision b1142361 src/Ganeti/HTools/Cluster.hs
b/src/Ganeti/HTools/Cluster.hs | ||
---|---|---|
85 | 85 |
import Ganeti.BasicTypes |
86 | 86 |
import qualified Ganeti.HTools.Container as Container |
87 | 87 |
import qualified Ganeti.HTools.Instance as Instance |
88 |
import qualified Ganeti.HTools.Nic as Nic |
|
88 | 89 |
import qualified Ganeti.HTools.Node as Node |
89 | 90 |
import qualified Ganeti.HTools.Group as Group |
90 | 91 |
import Ganeti.HTools.Types |
... | ... | |
772 | 773 |
in return $ annotateSolution sols |
773 | 774 |
|
774 | 775 |
-- | Given a group/result, describe it as a nice (list of) messages. |
775 |
solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String] |
|
776 |
solutionDescription gl (groupId, result) = |
|
776 |
solutionDescription :: (Group.Group, Result AllocSolution) |
|
777 |
-> [String] |
|
778 |
solutionDescription (grp, result) = |
|
777 | 779 |
case result of |
778 | 780 |
Ok solution -> map (printf "Group %s (%s): %s" gname pol) (asLog solution) |
779 | 781 |
Bad message -> [printf "Group %s: error %s" gname message] |
780 |
where grp = Container.find groupId gl |
|
781 |
gname = Group.name grp |
|
782 |
where gname = Group.name grp |
|
782 | 783 |
pol = allocPolicyToRaw (Group.allocPolicy grp) |
783 | 784 |
|
784 | 785 |
-- | From a list of possibly bad and possibly empty solutions, filter |
785 | 786 |
-- only the groups with a valid result. Note that the result will be |
786 | 787 |
-- reversed compared to the original list. |
787 |
filterMGResults :: Group.List |
|
788 |
-> [(Gdx, Result AllocSolution)] |
|
789 |
-> [(Gdx, AllocSolution)] |
|
790 |
filterMGResults gl = foldl' fn [] |
|
791 |
where unallocable = not . Group.isAllocable . flip Container.find gl |
|
792 |
fn accu (gdx, rasol) = |
|
788 |
filterMGResults :: [(Group.Group, Result AllocSolution)] |
|
789 |
-> [(Group.Group, AllocSolution)] |
|
790 |
filterMGResults = foldl' fn [] |
|
791 |
where unallocable = not . Group.isAllocable |
|
792 |
fn accu (grp, rasol) = |
|
793 | 793 |
case rasol of |
794 | 794 |
Bad _ -> accu |
795 | 795 |
Ok sol | isNothing (asSolution sol) -> accu |
796 |
| unallocable gdx -> accu
|
|
797 |
| otherwise -> (gdx, sol):accu
|
|
796 |
| unallocable grp -> accu
|
|
797 |
| otherwise -> (grp, sol):accu
|
|
798 | 798 |
|
799 | 799 |
-- | Sort multigroup results based on policy and score. |
800 |
sortMGResults :: Group.List |
|
801 |
-> [(Gdx, AllocSolution)] |
|
802 |
-> [(Gdx, AllocSolution)] |
|
803 |
sortMGResults gl sols = |
|
800 |
sortMGResults :: [(Group.Group, AllocSolution)] |
|
801 |
-> [(Group.Group, AllocSolution)] |
|
802 |
sortMGResults sols = |
|
804 | 803 |
let extractScore (_, _, _, x) = x |
805 |
solScore (gdx, sol) = (Group.allocPolicy (Container.find gdx gl),
|
|
804 |
solScore (grp, sol) = (Group.allocPolicy grp,
|
|
806 | 805 |
(extractScore . fromJust . asSolution) sol) |
807 | 806 |
in sortBy (comparing solScore) sols |
808 | 807 |
|
808 |
-- | Removes node groups which can't accommodate the instance |
|
809 |
filterValidGroups :: [(Group.Group, (Node.List, Instance.List))] |
|
810 |
-> Instance.Instance |
|
811 |
-> ([(Group.Group, (Node.List, Instance.List))], [String]) |
|
812 |
filterValidGroups [] _ = ([], []) |
|
813 |
filterValidGroups (ng:ngs) inst = |
|
814 |
let (valid_ngs, msgs) = filterValidGroups ngs inst |
|
815 |
hasNetwork nic = case Nic.network nic of |
|
816 |
Just net -> net `elem` Group.networks (fst ng) |
|
817 |
Nothing -> True |
|
818 |
hasRequiredNetworks = all hasNetwork (Instance.nics inst) |
|
819 |
in if hasRequiredNetworks |
|
820 |
then (ng:valid_ngs, msgs) |
|
821 |
else (valid_ngs, |
|
822 |
("group " ++ Group.name (fst ng) ++ |
|
823 |
" is not connected to a network required by instance " ++ |
|
824 |
Instance.name inst):msgs) |
|
825 |
|
|
809 | 826 |
-- | Finds the best group for an instance on a multi-group cluster. |
810 | 827 |
-- |
811 | 828 |
-- Only solutions in @preferred@ and @last_resort@ groups will be |
... | ... | |
818 | 835 |
-> Maybe [Gdx] -- ^ The allowed groups |
819 | 836 |
-> Instance.Instance -- ^ The instance to allocate |
820 | 837 |
-> Int -- ^ Required number of nodes |
821 |
-> Result (Gdx, AllocSolution, [String])
|
|
838 |
-> Result (Group.Group, AllocSolution, [String])
|
|
822 | 839 |
findBestAllocGroup mggl mgnl mgil allowed_gdxs inst cnt = |
823 |
let groups = splitCluster mgnl mgil |
|
824 |
groups' = maybe groups (\gs -> filter ((`elem` gs) . fst) groups) |
|
840 |
let groups_by_idx = splitCluster mgnl mgil |
|
841 |
groups = map (\(gid, d) -> (Container.find gid mggl, d)) groups_by_idx |
|
842 |
groups' = maybe groups |
|
843 |
(\gs -> filter ((`elem` gs) . Group.idx . fst) groups) |
|
825 | 844 |
allowed_gdxs |
826 |
sols = map (\(gid, (nl, il)) -> |
|
827 |
(gid, genAllocNodes mggl nl cnt False >>= |
|
828 |
tryAlloc nl il inst)) |
|
829 |
groups'::[(Gdx, Result AllocSolution)] |
|
830 |
all_msgs = concatMap (solutionDescription mggl) sols |
|
831 |
goodSols = filterMGResults mggl sols |
|
832 |
sortedSols = sortMGResults mggl goodSols |
|
845 |
(groups'', filter_group_msgs) = filterValidGroups groups' inst |
|
846 |
sols = map (\(gr, (nl, il)) -> |
|
847 |
(gr, genAllocNodes mggl nl cnt False >>= |
|
848 |
tryAlloc nl il inst)) |
|
849 |
groups''::[(Group.Group, Result AllocSolution)] |
|
850 |
all_msgs = filter_group_msgs ++ (concatMap solutionDescription sols) |
|
851 |
goodSols = filterMGResults sols |
|
852 |
sortedSols = sortMGResults goodSols |
|
833 | 853 |
in case sortedSols of |
834 | 854 |
[] -> Bad $ if null groups' |
835 | 855 |
then "no groups for evacuation: allowed groups was" ++ |
... | ... | |
848 | 868 |
tryMGAlloc mggl mgnl mgil inst cnt = do |
849 | 869 |
(best_group, solution, all_msgs) <- |
850 | 870 |
findBestAllocGroup mggl mgnl mgil Nothing inst cnt |
851 |
let group_name = Group.name $ Container.find best_group mggl
|
|
871 |
let group_name = Group.name best_group
|
|
852 | 872 |
selmsg = "Selected group: " ++ group_name |
853 | 873 |
return $ solution { asLog = selmsg:all_msgs } |
854 | 874 |
|
... | ... | |
1222 | 1242 |
let solution = do |
1223 | 1243 |
let ncnt = Instance.requiredNodes $ |
1224 | 1244 |
Instance.diskTemplate inst |
1225 |
(gdx, _, _) <- findBestAllocGroup gl nl il
|
|
1245 |
(grp, _, _) <- findBestAllocGroup gl nl il
|
|
1226 | 1246 |
(Just target_gdxs) inst ncnt |
1247 |
let gdx = Group.idx grp |
|
1227 | 1248 |
av_nodes <- availableGroupNodes group_ndx |
1228 | 1249 |
excl_ndx gdx |
1229 | 1250 |
nodeEvacInstance nl il ChangeAll inst gdx av_nodes |
... | ... | |
1522 | 1543 |
[(Gdx, (Node.List, Instance.List))] |
1523 | 1544 |
splitCluster nl il = |
1524 | 1545 |
let ngroups = Node.computeGroups (Container.elems nl) |
1525 |
in map (\(guuid, nodes) ->
|
|
1546 |
in map (\(gdx, nodes) ->
|
|
1526 | 1547 |
let nidxs = map Node.idx nodes |
1527 | 1548 |
nodes' = zip nidxs nodes |
1528 | 1549 |
instances = Container.filter ((`elem` nidxs) . Instance.pNode) il |
1529 |
in (guuid, (Container.fromList nodes', instances))) ngroups
|
|
1550 |
in (gdx, (Container.fromList nodes', instances))) ngroups
|
|
1530 | 1551 |
|
1531 | 1552 |
-- | Compute the list of nodes that are to be evacuated, given a list |
1532 | 1553 |
-- of instances and an evacuation mode. |
Also available in: Unified diff