kLGTM, thanks.
On Thu, Feb 6, 2014 at 10:52 AM, Klaus Aehlig <[email protected]> wrote: > For jobs still queued, we ask the queue to change the priority, > and replicate the changed job. For jobs that have already been > started, we have to contact the job directly, which, at the moment, > means forwarding the request to masterd. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/Query/Server.hs | 22 +++++++++++++++++++++- > 1 file changed, 21 insertions(+), 1 deletion(-) > > diff --git a/src/Ganeti/Query/Server.hs b/src/Ganeti/Query/Server.hs > index 391fb52..dc0016e 100644 > --- a/src/Ganeti/Query/Server.hs > +++ b/src/Ganeti/Query/Server.hs > @@ -33,6 +33,7 @@ import Control.Applicative > import Control.Concurrent > import Control.Exception > import Control.Monad (forever, when, zipWithM, liftM) > +import Control.Monad.IO.Class > import Data.Bits (bitSize) > import qualified Data.Set as Set (toList) > import Data.IORef > @@ -57,7 +58,8 @@ import Ganeti.Logging > import Ganeti.Luxi > import qualified Ganeti.Query.Language as Qlang > import qualified Ganeti.Query.Cluster as QCluster > -import Ganeti.Path (queueDir, jobQueueLockFile, jobQueueDrainFile) > +import Ganeti.Path ( queueDir, jobQueueLockFile, jobQueueDrainFile > + , defaultMasterSocket) > import Ganeti.Rpc > import Ganeti.Query.Query > import Ganeti.Query.Filter (makeSimpleFilter) > @@ -303,6 +305,24 @@ handleCall _ _ cfg (SetDrainFlag value) = do > _ <- executeRpcCall mcs $ RpcCallSetDrainFlag value > return . Ok . showJSON $ True > > +handleCall _ qstat cfg (ChangeJobPriority jid prio) = do > + maybeJob <- setJobPriority qstat jid prio > + case maybeJob of > + Bad s -> return . Ok $ showJSON (False, s) > + Ok (Just job) -> runResultT $ do > + let mcs = Config.getMasterCandidates cfg > + qDir <- liftIO queueDir > + liftIO $ replicateManyJobs qDir mcs [job] > + return $ showJSON (True, "Priorities of pending opcodes for job " > + ++ show (fromJobId jid) ++ " have been > changed" > + ++ " to " ++ show prio) > + Ok Nothing -> runResultT $ do > + -- Job has already started; so we have to forward the request > + -- to the job, currently handled by masterd. > + socketpath <- liftIO defaultMasterSocket > + cl <- liftIO $ getLuxiClient socketpath > + ResultT $ callMethod (ChangeJobPriority jid prio) cl > + > handleCall _ qstat cfg (CancelJob jid) = do > let jName = (++) "job " . show $ fromJobId jid > dequeueResult <- dequeueJob qstat jid > -- > 1.9.0.rc1.175.g0b1dcb5 > >
