Revision d5ccec02
| b/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 748 | 748 |
-> Instance.Instance |
| 749 | 749 |
-> Int |
| 750 | 750 |
-> [Instance.Instance] |
| 751 |
-> [CStats] |
|
| 751 | 752 |
-> Result (FailStats, Node.List, Instance.List, |
| 752 |
[Instance.Instance]) |
|
| 753 |
iterateAlloc nl il newinst nreq ixes = |
|
| 753 |
[Instance.Instance], [CStats])
|
|
| 754 |
iterateAlloc nl il newinst nreq ixes cstats =
|
|
| 754 | 755 |
let depth = length ixes |
| 755 | 756 |
newname = printf "new-%d" depth::String |
| 756 | 757 |
newidx = length (Container.elems il) + depth |
| ... | ... | |
| 759 | 760 |
Bad s -> Bad s |
| 760 | 761 |
Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
|
| 761 | 762 |
case sols3 of |
| 762 |
[] -> Ok (collapseFailures errs, nl, il, ixes) |
|
| 763 |
[] -> Ok (collapseFailures errs, nl, il, ixes, cstats)
|
|
| 763 | 764 |
(xnl, xi, _, _):[] -> |
| 764 | 765 |
iterateAlloc xnl (Container.add newidx xi il) |
| 765 |
newinst nreq $! (xi:ixes) |
|
| 766 |
newinst nreq (xi:ixes) |
|
| 767 |
(totalResources xnl:cstats) |
|
| 766 | 768 |
_ -> Bad "Internal error: multiple solutions for single\ |
| 767 | 769 |
\ allocation" |
| 768 | 770 |
|
| ... | ... | |
| 772 | 774 |
-> Instance.Instance |
| 773 | 775 |
-> Int |
| 774 | 776 |
-> [Instance.Instance] |
| 777 |
-> [CStats] |
|
| 775 | 778 |
-> Result (FailStats, Node.List, Instance.List, |
| 776 |
[Instance.Instance]) |
|
| 777 |
tieredAlloc nl il newinst nreq ixes = |
|
| 778 |
case iterateAlloc nl il newinst nreq ixes of |
|
| 779 |
[Instance.Instance], [CStats])
|
|
| 780 |
tieredAlloc nl il newinst nreq ixes cstats =
|
|
| 781 |
case iterateAlloc nl il newinst nreq ixes cstats of
|
|
| 779 | 782 |
Bad s -> Bad s |
| 780 |
Ok (errs, nl', il', ixes') -> |
|
| 783 |
Ok (errs, nl', il', ixes', cstats') ->
|
|
| 781 | 784 |
case Instance.shrinkByType newinst . fst . last $ |
| 782 | 785 |
sortBy (comparing snd) errs of |
| 783 |
Bad _ -> Ok (errs, nl', il', ixes') |
|
| 786 |
Bad _ -> Ok (errs, nl', il', ixes', cstats')
|
|
| 784 | 787 |
Ok newinst' -> |
| 785 |
tieredAlloc nl' il' newinst' nreq ixes' |
|
| 788 |
tieredAlloc nl' il' newinst' nreq ixes' cstats'
|
|
| 786 | 789 |
|
| 787 | 790 |
-- | Compute the tiered spec string description from a list of |
| 788 | 791 |
-- allocated instances. |
| b/Ganeti/HTools/QC.hs | ||
|---|---|---|
| 708 | 708 |
==> |
| 709 | 709 |
let nl = makeSmallCluster node count |
| 710 | 710 |
il = Container.empty |
| 711 |
in case Cluster.tieredAlloc nl il inst rqnodes [] of |
|
| 711 |
in case Cluster.tieredAlloc nl il inst rqnodes [] []of
|
|
| 712 | 712 |
Types.Bad _ -> False |
| 713 |
Types.Ok (_, _, il', ixes) -> not (null ixes) && |
|
| 714 |
IntMap.size il' == length ixes |
|
| 713 |
Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) && |
|
| 714 |
IntMap.size il' == length ixes && |
|
| 715 |
length ixes == length cstats |
|
| 715 | 716 |
|
| 716 | 717 |
-- | Checks that on a 4-8 node cluster, once we allocate an instance, |
| 717 | 718 |
-- we can also evacuate it |
| ... | ... | |
| 752 | 753 |
il = Container.empty |
| 753 | 754 |
rqnodes = 2 |
| 754 | 755 |
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu |
| 755 |
in case Cluster.iterateAlloc nl' il i_templ rqnodes [] of |
|
| 756 |
in case Cluster.iterateAlloc nl' il i_templ rqnodes [] [] of
|
|
| 756 | 757 |
Types.Bad _ -> False |
| 757 |
Types.Ok (_, xnl, il', _) -> |
|
| 758 |
Types.Ok (_, xnl, il', _, _) ->
|
|
| 758 | 759 |
let ynl = Container.add (Node.idx hnode) hnode xnl |
| 759 | 760 |
cv = Cluster.compCV ynl |
| 760 | 761 |
tbl = Cluster.Table ynl il' cv [] |
| b/hspace.hs | ||
|---|---|---|
| 276 | 276 |
|
| 277 | 277 |
let bad_nodes = fst $ Cluster.computeBadItems nl il |
| 278 | 278 |
stop_allocation = length bad_nodes > 0 |
| 279 |
result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, []) |
|
| 279 |
result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], [])
|
|
| 280 | 280 |
|
| 281 | 281 |
-- utility functions |
| 282 | 282 |
let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx) |
| ... | ... | |
| 295 | 295 |
(case optTieredSpec opts of |
| 296 | 296 |
Nothing -> return () |
| 297 | 297 |
Just tspec -> do |
| 298 |
(_, trl_nl, trl_il, trl_ixes) <- |
|
| 298 |
(_, trl_nl, trl_il, trl_ixes, _) <-
|
|
| 299 | 299 |
if stop_allocation |
| 300 | 300 |
then return result_noalloc |
| 301 | 301 |
else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec) |
| 302 |
req_nodes []) |
|
| 302 |
req_nodes [] [])
|
|
| 303 | 303 |
let spec_map' = Cluster.tieredSpecMap trl_ixes |
| 304 | 304 |
|
| 305 | 305 |
printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes |
| ... | ... | |
| 316 | 316 |
|
| 317 | 317 |
-- Run the standard (avg-mode) allocation |
| 318 | 318 |
|
| 319 |
(ereason, fin_nl, fin_il, ixes) <- |
|
| 319 |
(ereason, fin_nl, fin_il, ixes, _) <-
|
|
| 320 | 320 |
if stop_allocation |
| 321 | 321 |
then return result_noalloc |
| 322 |
else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes []) |
|
| 322 |
else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [] [])
|
|
| 323 | 323 |
|
| 324 | 324 |
let allocs = length ixes |
| 325 | 325 |
sreason = reverse $ sortBy (comparing snd) ereason |
Also available in: Unified diff