diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs index 1e3c36e818bfe739efc7247a0a559a40c6603936..b099ce31ee9eaaaca356dfec36d6c8b8e139f164 100644 --- a/htools/Ganeti/HTools/Cluster.hs +++ b/htools/Ganeti/HTools/Cluster.hs @@ -110,8 +110,8 @@ data AllocSolution = AllocSolution -- type consists of actual opcodes (a restricted subset) that are -- transmitted back to Ganeti. data EvacSolution = EvacSolution - { esMoved :: [String] -- ^ Instance moved successfully - , esFailed :: [String] -- ^ Instance which were not + { esMoved :: [(Idx, Gdx, [Ndx])] -- ^ Instances moved successfully + , esFailed :: [(Idx, String)] -- ^ Instances which were not -- relocated , esOpCodes :: [[[OpCodes.OpCode]]] -- ^ List of lists of jobs } @@ -1063,14 +1063,18 @@ availableGroupNodes group_nodes excl_ndx gdx = do -- | Updates the evac solution with the results of an instance -- evacuation. updateEvacSolution :: (Node.List, Instance.List, EvacSolution) - -> Instance.Instance + -> Idx -> Result (Node.List, Instance.List, [OpCodes.OpCode]) -> (Node.List, Instance.List, EvacSolution) -updateEvacSolution (nl, il, es) inst (Bad msg) = - (nl, il, es { esFailed = (Instance.name inst ++ ": " ++ msg):esFailed es}) -updateEvacSolution (_, _, es) inst (Ok (nl, il, opcodes)) = - (nl, il, es { esMoved = Instance.name inst:esMoved es +updateEvacSolution (nl, il, es) idx (Bad msg) = + (nl, il, es { esFailed = (idx, msg):esFailed es}) +updateEvacSolution (_, _, es) idx (Ok (nl, il, opcodes)) = + (nl, il, es { esMoved = new_elem:esMoved es , esOpCodes = [opcodes]:esOpCodes es }) + where inst = Container.find idx il + new_elem = (idx, + instancePriGroup nl inst, + Instance.allNodes inst) -- | Node-evacuation IAllocator mode main function. tryNodeEvac :: Group.List -- ^ The cluster groups @@ -1088,7 +1092,7 @@ tryNodeEvac _ ini_nl ini_il mode idxs = splitCluster ini_nl ini_il (_, _, esol) = foldl' (\state@(nl, il, _) inst -> - updateEvacSolution state inst $ + updateEvacSolution state (Instance.idx inst) $ availableGroupNodes group_ndx excl_ndx (instancePriGroup nl inst) >>= nodeEvacInstance nl il mode inst @@ -1144,13 +1148,13 @@ tryChangeGroup gl ini_nl ini_il gdxs idxs = av_nodes <- availableGroupNodes group_ndx excl_ndx gdx nodeEvacInstance nl il ChangeAll inst av_nodes - in updateEvacSolution state inst solution + in updateEvacSolution state + (Instance.idx inst) solution ) (ini_nl, ini_il, emptyEvacSolution) (map (`Container.find` ini_il) idxs) in return $ reverseEvacSolution esol - -- | Recursively place instances on the cluster until we're out of space. iterateAlloc :: Node.List -> Instance.List diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs index 5d6d69ea4a2e052bbfa4323246bc15f1b7c79b32..4c6c2b43f304dae87b0c574d81f4390cc408ca7e 100644 --- a/htools/Ganeti/HTools/IAlloc.hs +++ b/htools/Ganeti/HTools/IAlloc.hs @@ -241,10 +241,18 @@ formatAllocate as = do _ -> fail "Internal error: multiple allocation solutions" -- | Convert a node-evacuation/change group result. -formatNodeEvac :: Cluster.EvacSolution -> Result IAllocResult -formatNodeEvac es = - let fes = Cluster.esFailed es - mes = Cluster.esMoved es +formatNodeEvac :: Group.List + -> Node.List + -> Instance.List + -> Cluster.EvacSolution + -> Result IAllocResult +formatNodeEvac gl nl il es = + let iname = Instance.name . flip Container.find il + nname = Node.name . flip Container.find nl + gname = Group.name . flip Container.find gl + fes = map (\(idx, msg) -> (iname idx, msg)) $ Cluster.esFailed es + mes = map (\(idx, gdx, ndxs) -> (iname idx, gname gdx, map nname ndxs)) + $ Cluster.esMoved es failed = length fes moved = length mes info = show failed ++ " instances failed to move and " ++ show moved ++ @@ -263,9 +271,11 @@ processRequest request = Evacuate exnodes -> Cluster.tryMGEvac gl nl il exnodes >>= formatEvacuate ChangeGroup gdxs idxs -> - Cluster.tryChangeGroup gl nl il idxs gdxs >>= formatNodeEvac + Cluster.tryChangeGroup gl nl il idxs gdxs >>= + formatNodeEvac gl nl il NodeEvacuate xi mode -> - Cluster.tryNodeEvac gl nl il mode xi >>= formatNodeEvac + Cluster.tryNodeEvac gl nl il mode xi >>= + formatNodeEvac gl nl il -- | Reads the request from the data file(s) readRequest :: Options -> [String] -> IO Request