Commit 4a340313 authored by Iustin Pop's avatar Iustin Pop
Browse files

Implement hail allocate (for 2-node requests)

This patch implements allocate for two node requests. One node requests
can be done as soon as we have a valid allocateOn function for single
nodes.
parent 58709f92
......@@ -33,6 +33,8 @@ module Ganeti.HTools.Cluster
, checkMove
, compCV
, printStats
-- * IAllocator functions
, allocateOn
) where
import Data.List
......@@ -407,6 +409,16 @@ applyMove nl inst (FailoverAndReplace new_sdx) =
Container.addTwo old_sdx new_p old_pdx int_p nl
in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)
allocateOn nl inst new_pdx new_sdx =
let
tgt_p = Container.find new_pdx nl
tgt_s = Container.find new_sdx nl
new_nl = do -- Maybe monad
new_p <- Node.addPri tgt_p inst
new_s <- Node.addSec tgt_s inst new_pdx
return $ Container.addTwo new_pdx new_p new_sdx new_s nl
in (new_nl, Instance.setBoth inst new_pdx new_sdx)
checkSingleStep :: Table -- ^ The original table
-> Instance.Instance -- ^ The instance to move
-> Table -- ^ The current best table
......
......@@ -119,7 +119,42 @@ tryAlloc :: NodeList
-> Instance.Instance
-> Int
-> Result (String, [Node.Node])
tryAlloc nl il xi _ = Bad "alloc not implemented"
tryAlloc nl il inst 2 =
let all_nodes = Container.elems nl
all_nidx = map Node.idx all_nodes
all_pairs = liftM2 (,) all_nodes all_nodes
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
sols1 = map (\(p, s) -> let pdx = Node.idx p
sdx = Node.idx s
(mnl, _) = Cluster.allocateOn nl
inst pdx sdx
in (mnl, (p, s))
) ok_pairs
sols2 = filter (isJust . fst) sols1
in if null sols1 then
Bad "No pairs onto which to allocate at all"
else if null sols2 then
Bad "No valid allocation solutions"
else
let sols3 = map (\(x, (y, z)) ->
(Cluster.compCV $ fromJust x,
(fromJust x, y, z)))
sols2
sols4 = sortBy (compare `on` fst) sols3
(best, (final_nl, w1, w2)) = head sols4
(worst, (_, l1, l2)) = last sols4
info = printf "Valid results: %d, best score: %.8f \
\(nodes %s/%s), worst score: %.8f (nodes \
\%s/%s)"
(length sols3)
best (Node.name w1) (Node.name w2)
worst (Node.name l1) (Node.name w2)
in Ok (info, [w1, w2])
tryAlloc _ _ _ reqn = Bad $ "Unsupported number of alllocation \
\destinations required (" ++ (show reqn) ++
"), only two supported"
-- | Try to allocate an instance on the cluster
tryReloc :: NodeList
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment