Revision 859fc11d Ganeti/HTools/Cluster.hs
| 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