Revision 23f9ab76
b/Ganeti/HTools/Cluster.hs | ||
---|---|---|
73 | 73 |
-- * Types |
74 | 74 |
|
75 | 75 |
-- | Allocation\/relocation solution. |
76 |
type AllocSolution = ([FailMode], Int, Maybe (Score, AllocElement))
|
|
76 |
type AllocSolution = ([FailMode], Int, [(Score, AllocElement)])
|
|
77 | 77 |
|
78 | 78 |
-- | Allocation\/relocation element. |
79 | 79 |
type AllocElement = (Node.List, Instance.Instance, [Node.Node]) |
... | ... | |
499 | 499 |
let nscore = compCV nl |
500 | 500 |
-- Choose the old or new solution, based on the cluster score |
501 | 501 |
nsols = case osols of |
502 |
Nothing -> Just (nscore, ns)
|
|
503 |
Just (oscore, _) ->
|
|
502 |
[] -> [(nscore, ns)]
|
|
503 |
(oscore, _):[] ->
|
|
504 | 504 |
if oscore < nscore |
505 | 505 |
then osols |
506 |
else Just (nscore, ns) |
|
506 |
else [(nscore, ns)] |
|
507 |
-- FIXME: here we simply concat to lists with more |
|
508 |
-- than one element; we should instead abort, since |
|
509 |
-- this is not a valid usage of this function |
|
510 |
xs -> (nscore, ns):xs |
|
507 | 511 |
nsuc = cntok + 1 |
508 | 512 |
-- Note: we force evaluation of nsols here in order to keep the |
509 | 513 |
-- memory profile low - we know that we will need nsols for sure |
... | ... | |
525 | 529 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
526 | 530 |
sols = foldl' (\cstate (p, s) -> |
527 | 531 |
concatAllocs cstate $ allocateOnPair nl inst p s |
528 |
) ([], 0, Nothing) ok_pairs
|
|
532 |
) ([], 0, []) ok_pairs
|
|
529 | 533 |
in return sols |
530 | 534 |
|
531 | 535 |
tryAlloc nl _ inst 1 = |
532 | 536 |
let all_nodes = getOnline nl |
533 | 537 |
sols = foldl' (\cstate -> |
534 | 538 |
concatAllocs cstate . allocateOnSingle nl inst |
535 |
) ([], 0, Nothing) all_nodes
|
|
539 |
) ([], 0, []) all_nodes
|
|
536 | 540 |
in return sols |
537 | 541 |
|
538 | 542 |
tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \ |
... | ... | |
559 | 563 |
applyMove nl inst (ReplaceSecondary x) |
560 | 564 |
return (mnl, i, [Container.find x mnl]) |
561 | 565 |
in concatAllocs cstate em |
562 |
) ([], 0, Nothing) valid_idxes
|
|
566 |
) ([], 0, []) valid_idxes
|
|
563 | 567 |
in return sols1 |
564 | 568 |
|
565 | 569 |
tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \ |
b/hail.hs | ||
---|---|---|
50 | 50 |
processResults :: (Monad m) => Cluster.AllocSolution -> m (String, [Node.Node]) |
51 | 51 |
processResults (fstats, successes, sols) = |
52 | 52 |
case sols of |
53 |
Nothing -> fail "No valid allocation solutions"
|
|
54 |
Just (best, (_, _, w)) ->
|
|
53 |
[] -> fail "No valid allocation solutions"
|
|
54 |
(best, (_, _, w)):[] ->
|
|
55 | 55 |
let tfails = length fstats |
56 | 56 |
info = printf "successes %d, failures %d,\ |
57 | 57 |
\ best score: %.8f for node(s) %s" |
58 | 58 |
successes tfails |
59 | 59 |
best (intercalate "/" . map Node.name $ w)::String |
60 | 60 |
in return (info, w) |
61 |
_ -> fail "Internal error: multiple allocation solutions" |
|
61 | 62 |
|
62 | 63 |
-- | Process a request and return new node lists |
63 | 64 |
processRequest :: Request |
b/hspace.hs | ||
---|---|---|
131 | 131 |
Bad s -> Bad s |
132 | 132 |
Ok (errs, _, sols3) -> |
133 | 133 |
case sols3 of |
134 |
Nothing -> Ok (Cluster.collapseFailures errs, nl, ixes)
|
|
135 |
Just (_, (xnl, xi, _)) ->
|
|
134 |
[] -> Ok (Cluster.collapseFailures errs, nl, ixes)
|
|
135 |
(_, (xnl, xi, _)):[] ->
|
|
136 | 136 |
iterateDepth xnl il newinst nreq $! (xi:ixes) |
137 |
_ -> Bad "Internal error: multiple solutions for single\ |
|
138 |
\ allocation" |
|
137 | 139 |
|
138 | 140 |
tieredAlloc :: Node.List |
139 | 141 |
-> Instance.List |
Also available in: Unified diff