Revision 859fc11d
b/Ganeti/HTools/Cluster.hs | ||
---|---|---|
87 | 87 |
, asSolutions :: [Node.AllocElement] -- ^ The actual result, length |
88 | 88 |
-- of the list depends on the |
89 | 89 |
-- allocation/relocation mode |
90 |
|
|
90 |
, asLog :: [String] -- ^ A list of informational messages |
|
91 | 91 |
} |
92 | 92 |
|
93 | 93 |
-- | The empty solution we start with when computing allocations |
94 | 94 |
emptySolution :: AllocSolution |
95 | 95 |
emptySolution = AllocSolution { asFailures = [], asAllocs = 0 |
96 |
, asSolutions = [] } |
|
96 |
, asSolutions = [], asLog = [] }
|
|
97 | 97 |
|
98 | 98 |
-- | The complete state for the balancing solution |
99 | 99 |
data Table = Table Node.List Instance.List Score [Placement] |
... | ... | |
569 | 569 |
-- elements of the tuple |
570 | 570 |
in nsols `seq` nsuc `seq` as { asAllocs = nsuc, asSolutions = nsols } |
571 | 571 |
|
572 |
-- | Given a solution, generates a reasonable description for it |
|
573 |
describeSolution :: AllocSolution -> String |
|
574 |
describeSolution as = |
|
575 |
let fcnt = asFailures as |
|
576 |
sols = asSolutions as |
|
577 |
freasons = |
|
578 |
intercalate ", " . map (\(a, b) -> printf "%s: %d" (show a) b) . |
|
579 |
filter ((> 0) . snd) . collapseFailures $ fcnt |
|
580 |
in if null sols |
|
581 |
then "No valid allocation solutions, failure reasons: " ++ |
|
582 |
(if null fcnt |
|
583 |
then "unknown reasons" |
|
584 |
else freasons) |
|
585 |
else let (_, _, nodes, cv) = head sols |
|
586 |
in printf ("score: %.8f, successes %d, failures %d (%s)" ++ |
|
587 |
" for node(s) %s") cv (asAllocs as) (length fcnt) freasons |
|
588 |
(intercalate "/" . map Node.name $ nodes) |
|
589 |
|
|
590 |
-- | Annotates a solution with the appropriate string |
|
591 |
annotateSolution :: AllocSolution -> AllocSolution |
|
592 |
annotateSolution as = as { asLog = describeSolution as : asLog as } |
|
593 |
|
|
572 | 594 |
-- | Try to allocate an instance on the cluster. |
573 | 595 |
tryAlloc :: (Monad m) => |
574 | 596 |
Node.List -- ^ The node list |
... | ... | |
583 | 605 |
sols = foldl' (\cstate (p, s) -> |
584 | 606 |
concatAllocs cstate $ allocateOnPair nl inst p s |
585 | 607 |
) emptySolution ok_pairs |
586 |
in return sols |
|
608 |
|
|
609 |
in return $ annotateSolution sols |
|
587 | 610 |
|
588 | 611 |
tryAlloc nl _ inst 1 = |
589 | 612 |
let all_nodes = getOnline nl |
590 | 613 |
sols = foldl' (\cstate -> |
591 | 614 |
concatAllocs cstate . allocateOnSingle nl inst |
592 | 615 |
) emptySolution all_nodes |
593 |
in return sols |
|
616 |
in return $ annotateSolution sols
|
|
594 | 617 |
|
595 | 618 |
tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \ |
596 | 619 |
\destinations required (" ++ show reqn ++ |
... | ... | |
649 | 672 |
-- this relocation failed, so we fail |
650 | 673 |
-- the entire evac |
651 | 674 |
_ -> fail $ "Can't evacuate instance " ++ |
652 |
Instance.name (Container.find idx il) |
|
675 |
Instance.name (Container.find idx il) ++ |
|
676 |
": " ++ describeSolution new_as |
|
653 | 677 |
) (nl, emptySolution) all_insts |
654 |
return sol |
|
678 |
return $ annotateSolution sol
|
|
655 | 679 |
|
656 | 680 |
-- | Recursively place instances on the cluster until we're out of space |
657 | 681 |
iterateAlloc :: Node.List |
Also available in: Unified diff