Revision 8f48f67d htools/Ganeti/HTools/Cluster.hs
| b/htools/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 1036 | 1036 |
-- | Recursively place instances on the cluster until we're out of space. |
| 1037 | 1037 |
iterateAlloc :: Node.List |
| 1038 | 1038 |
-> Instance.List |
| 1039 |
-> Maybe Int |
|
| 1039 | 1040 |
-> Instance.Instance |
| 1040 | 1041 |
-> AllocNodes |
| 1041 | 1042 |
-> [Instance.Instance] |
| 1042 | 1043 |
-> [CStats] |
| 1043 | 1044 |
-> Result AllocResult |
| 1044 |
iterateAlloc nl il newinst allocnodes ixes cstats = |
|
| 1045 |
iterateAlloc nl il limit newinst allocnodes ixes cstats =
|
|
| 1045 | 1046 |
let depth = length ixes |
| 1046 | 1047 |
newname = printf "new-%d" depth::String |
| 1047 | 1048 |
newidx = length (Container.elems il) + depth |
| 1048 | 1049 |
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx |
| 1050 |
newlimit = fmap (flip (-) 1) limit |
|
| 1049 | 1051 |
in case tryAlloc nl il newi2 allocnodes of |
| 1050 | 1052 |
Bad s -> Bad s |
| 1051 | 1053 |
Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
|
| 1054 |
let newsol = Ok (collapseFailures errs, nl, il, ixes, cstats) in |
|
| 1052 | 1055 |
case sols3 of |
| 1053 |
[] -> Ok (collapseFailures errs, nl, il, ixes, cstats)
|
|
| 1056 |
[] -> newsol
|
|
| 1054 | 1057 |
(xnl, xi, _, _):[] -> |
| 1055 |
iterateAlloc xnl (Container.add newidx xi il) |
|
| 1056 |
newinst allocnodes (xi:ixes) |
|
| 1057 |
(totalResources xnl:cstats) |
|
| 1058 |
if limit == Just 0 |
|
| 1059 |
then newsol |
|
| 1060 |
else iterateAlloc xnl (Container.add newidx xi il) |
|
| 1061 |
newlimit newinst allocnodes (xi:ixes) |
|
| 1062 |
(totalResources xnl:cstats) |
|
| 1058 | 1063 |
_ -> Bad "Internal error: multiple solutions for single\ |
| 1059 | 1064 |
\ allocation" |
| 1060 | 1065 |
|
| 1061 | 1066 |
-- | The core of the tiered allocation mode. |
| 1062 | 1067 |
tieredAlloc :: Node.List |
| 1063 | 1068 |
-> Instance.List |
| 1069 |
-> Maybe Int |
|
| 1064 | 1070 |
-> Instance.Instance |
| 1065 | 1071 |
-> AllocNodes |
| 1066 | 1072 |
-> [Instance.Instance] |
| 1067 | 1073 |
-> [CStats] |
| 1068 | 1074 |
-> Result AllocResult |
| 1069 |
tieredAlloc nl il newinst allocnodes ixes cstats = |
|
| 1070 |
case iterateAlloc nl il newinst allocnodes ixes cstats of |
|
| 1075 |
tieredAlloc nl il limit newinst allocnodes ixes cstats =
|
|
| 1076 |
case iterateAlloc nl il limit newinst allocnodes ixes cstats of
|
|
| 1071 | 1077 |
Bad s -> Bad s |
| 1072 | 1078 |
Ok (errs, nl', il', ixes', cstats') -> |
| 1079 |
let newsol = Ok (errs, nl', il', ixes', cstats') |
|
| 1080 |
ixes_cnt = length ixes' |
|
| 1081 |
(stop, newlimit) = case limit of |
|
| 1082 |
Nothing -> (False, Nothing) |
|
| 1083 |
Just n -> (n <= ixes_cnt, |
|
| 1084 |
Just (n - ixes_cnt)) in |
|
| 1085 |
if stop then newsol else |
|
| 1073 | 1086 |
case Instance.shrinkByType newinst . fst . last $ |
| 1074 | 1087 |
sortBy (comparing snd) errs of |
| 1075 |
Bad _ -> Ok (errs, nl', il', ixes', cstats')
|
|
| 1076 |
Ok newinst' -> |
|
| 1077 |
tieredAlloc nl' il' newinst' allocnodes ixes' cstats'
|
|
| 1088 |
Bad _ -> newsol
|
|
| 1089 |
Ok newinst' -> tieredAlloc nl' il' newlimit
|
|
| 1090 |
newinst' allocnodes ixes' cstats'
|
|
| 1078 | 1091 |
|
| 1079 | 1092 |
-- | Compute the tiered spec string description from a list of |
| 1080 | 1093 |
-- allocated instances. |
Also available in: Unified diff