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