diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index 8b771ea95eb2d39a542f83967fa6b615d8d0e172..5918a77b0f232c63fc8d8245a3938817c0128e23 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -838,23 +838,23 @@ tryMGEvac _ nl il ex_ndx = iterateAlloc :: Node.List -> Instance.List -> Instance.Instance - -> Int + -> AllocNodes -> [Instance.Instance] -> [CStats] -> Result AllocResult -iterateAlloc nl il newinst nreq ixes cstats = +iterateAlloc nl il newinst allocnodes ixes cstats = let depth = length ixes newname = printf "new-%d" depth::String newidx = length (Container.elems il) + depth newi2 = Instance.setIdx (Instance.setName newinst newname) newidx - in case genAllocNodes nl nreq >>= tryAlloc nl il newi2 of + in case tryAlloc nl il newi2 allocnodes of Bad s -> Bad s Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) -> case sols3 of [] -> Ok (collapseFailures errs, nl, il, ixes, cstats) (xnl, xi, _, _):[] -> iterateAlloc xnl (Container.add newidx xi il) - newinst nreq (xi:ixes) + newinst allocnodes (xi:ixes) (totalResources xnl:cstats) _ -> Bad "Internal error: multiple solutions for single\ \ allocation" @@ -863,19 +863,19 @@ iterateAlloc nl il newinst nreq ixes cstats = tieredAlloc :: Node.List -> Instance.List -> Instance.Instance - -> Int + -> AllocNodes -> [Instance.Instance] -> [CStats] -> Result AllocResult -tieredAlloc nl il newinst nreq ixes cstats = - case iterateAlloc nl il newinst nreq ixes cstats of +tieredAlloc nl il newinst allocnodes ixes cstats = + case iterateAlloc nl il newinst allocnodes ixes cstats of Bad s -> Bad s Ok (errs, nl', il', ixes', cstats') -> case Instance.shrinkByType newinst . fst . last $ sortBy (comparing snd) errs of Bad _ -> Ok (errs, nl', il', ixes', cstats') Ok newinst' -> - tieredAlloc nl' il' newinst' nreq ixes' cstats' + tieredAlloc nl' il' newinst' allocnodes ixes' cstats' -- | Compute the tiered spec string description from a list of -- allocated instances. diff --git a/Ganeti/HTools/QC.hs b/Ganeti/HTools/QC.hs index 0a36a0bcf063c61bd4212bbcc0c54b7192e5fa43..9257939c8ac498236d61618abad677553b9a3ff7 100644 --- a/Ganeti/HTools/QC.hs +++ b/Ganeti/HTools/QC.hs @@ -707,7 +707,9 @@ prop_ClusterCanTieredAlloc node inst = ==> let nl = makeSmallCluster node count il = Container.empty - in case Cluster.tieredAlloc nl il inst rqnodes [] []of + allocnodes = Cluster.genAllocNodes nl rqnodes + in case allocnodes >>= \allocnodes' -> + Cluster.tieredAlloc nl il inst allocnodes' [] [] of Types.Bad _ -> False Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) && IntMap.size il' == length ixes && @@ -749,9 +751,10 @@ prop_ClusterAllocBalance node = let nl = makeSmallCluster node count (hnode, nl') = IntMap.deleteFindMax nl il = Container.empty - rqnodes = 2 + allocnodes = Cluster.genAllocNodes nl' 2 i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu - in case Cluster.iterateAlloc nl' il i_templ rqnodes [] [] of + in case allocnodes >>= \allocnodes' -> + Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of Types.Bad _ -> False Types.Ok (_, xnl, il', _, _) -> let ynl = Container.add (Node.idx hnode) hnode xnl diff --git a/hspace.hs b/hspace.hs index 55199838bbabbacca7069ffffe84e78226ec6d4f..e207566570475b5e4fca45a878d18572737797d4 100644 --- a/hspace.hs +++ b/hspace.hs @@ -4,7 +4,7 @@ {- -Copyright (C) 2009, 2010 Google Inc. +Copyright (C) 2009, 2010, 2011 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -290,6 +290,8 @@ main = do let reqinst = iofspec ispec + allocnodes <- exitifbad $ Cluster.genAllocNodes nl req_nodes + -- Run the tiered allocation, if enabled (case optTieredSpec opts of @@ -299,7 +301,7 @@ main = do if stop_allocation then return result_noalloc else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec) - req_nodes [] []) + allocnodes [] []) let spec_map' = Cluster.tieredSpecMap trl_ixes printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes @@ -319,7 +321,7 @@ main = do (ereason, fin_nl, fin_il, ixes, _) <- if stop_allocation then return result_noalloc - else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [] []) + else exitifbad (Cluster.iterateAlloc nl il reqinst allocnodes [] []) let allocs = length ixes sreason = reverse $ sortBy (comparing snd) ereason