From 7e723913f36ce7fabed62a766dee762b5f0805a7 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Mon, 3 Dec 2012 12:22:00 +0100
Subject: [PATCH] Switch luxi submit job calls to use MetaOpCode
This patch changes the luxi submit job calls to use wrapped opcodes,
and therefore it changes Hbal to submit actual meta opcodes. For
nicety, hbal also submits a comment now, showing who generated the
job.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htools/Ganeti/HTools/Program/Hbal.hs | 9 +++++++++
htools/Ganeti/Luxi.hs | 6 +++---
2 files changed, 12 insertions(+), 3 deletions(-)
diff --git a/htools/Ganeti/HTools/Program/Hbal.hs b/htools/Ganeti/HTools/Program/Hbal.hs
index c7e63728e..deea30f52 100644
--- a/htools/Ganeti/HTools/Program/Hbal.hs
+++ b/htools/Ganeti/HTools/Program/Hbal.hs
@@ -56,11 +56,13 @@ import Ganeti.HTools.CLI
import Ganeti.HTools.ExtLoader
import Ganeti.HTools.Types
import Ganeti.HTools.Loader
+import Ganeti.OpCodes (wrapOpCode, setOpComment, OpCode, MetaOpCode)
import Ganeti.Types (fromJobId)
import Ganeti.Utils
import qualified Ganeti.Luxi as L
import Ganeti.Jobs
+import Ganeti.Version (version)
-- | Options list and functions.
options :: IO [OptType]
@@ -99,6 +101,12 @@ options = do
arguments :: [ArgCompletion]
arguments = []
+-- | Wraps an 'OpCode' in a 'MetaOpCode' while also adding a comment
+-- about what generated the opcode.
+annotateOpCode :: OpCode -> MetaOpCode
+annotateOpCode =
+ setOpComment ("rebalancing via hbal " ++ version) . wrapOpCode
+
{- | Start computing the solution at the given depth and recurse until
we find a valid solution or we exceed the maximum depth.
@@ -205,6 +213,7 @@ execJobSet _ _ _ _ [] = return True
execJobSet master nl il cref (js:jss) = do
-- map from jobset (htools list of positions) to [[opcodes]]
let jobs = map (\(_, idx, move, _) ->
+ map annotateOpCode $
Cluster.iMoveToJob nl il idx move) js
let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
putStrLn $ "Executing jobset for instances " ++ commaJoin descr
diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs
index b7d99b944..a59bd9bb2 100644
--- a/htools/Ganeti/Luxi.hs
+++ b/htools/Ganeti/Luxi.hs
@@ -138,10 +138,10 @@ $(genLuxiOp "LuxiOp"
, (luxiReqQueryTags,
[ pTagsObject ])
, (luxiReqSubmitJob,
- [ simpleField "job" [t| [OpCode] |] ]
+ [ simpleField "job" [t| [MetaOpCode] |] ]
)
, (luxiReqSubmitManyJobs,
- [ simpleField "ops" [t| [[OpCode]] |] ]
+ [ simpleField "ops" [t| [[MetaOpCode]] |] ]
)
, (luxiReqWaitForJobChange,
[ simpleField "job" [t| JobId |]
@@ -443,7 +443,7 @@ parseSubmitJobResult v =
show (pp_value v)
-- | Specialized submitManyJobs call.
-submitManyJobs :: Client -> [[OpCode]] -> IO (ErrorResult [JobId])
+submitManyJobs :: Client -> [[MetaOpCode]] -> IO (ErrorResult [JobId])
submitManyJobs s jobs = do
rval <- callMethod (SubmitManyJobs jobs) s
-- map each result (status, payload) pair into a nice Result ADT
--
GitLab