Re: [PATCH master 4/4] Implement job cancellation in luxid

[Petr Pudlák]

LGTM, thanks

(Just nitpicking: instead of 'do _ <- ...' we can write just 'do ...' (or
was it intentional?))


On Wed, Jan 15, 2014 at 10:54 AM, Klaus Aehlig <aeh...@google.com> wrote:

> As luxid handles the job queue, this daemon is the natural
> place to handle job cancellation. Answering to CancelJob requests
> is also necessary for luxid to be feature compliant with masterd,
> even for command-line requests only.
>
> Signed-off-by: Klaus Aehlig <aeh...@google.com>
> ---
>  src/Ganeti/Query/Server.hs | 29 +++++++++++++++++++++++++++++
>  1 file changed, 29 insertions(+)
>
> diff --git a/src/Ganeti/Query/Server.hs b/src/Ganeti/Query/Server.hs
> index 1db4ed5..9556fe3 100644
> --- a/src/Ganeti/Query/Server.hs
> +++ b/src/Ganeti/Query/Server.hs
> @@ -303,6 +303,35 @@ handleCall _ _ cfg (SetDrainFlag value) = do
>    _ <- executeRpcCall mcs $ RpcCallSetDrainFlag value
>    return . Ok . showJSON $ True
>
> +handleCall _ qstat  cfg (CancelJob jid) = do
> +  let jName = (++) "job " . show $ fromJobId jid
> +  dequeueResult <- dequeueJob qstat jid
> +  case dequeueResult of
> +    Ok True -> do
> +      logDebug $ jName ++ " dequeued, marking as canceled"
> +      qDir <- queueDir
> +      readResult <- loadJobFromDisk qDir True jid
> +      let jobFileFailed = return . Ok . showJSON . (,) False
> +                            . (++) ("Dequeued " ++ jName
> +                                    ++ ", but failed to mark as
> cancelled: ")
> +                          :: String -> IO (ErrorResult JSValue)
> +      case readResult of
> +        Bad s -> jobFileFailed s
> +        Ok (job, _) -> do
> +          now <- currentTimestamp
> +          let job' = cancelQueuedJob now job
> +              mcs = Config.getMasterCandidates cfg
> +          write_result <- writeJobToDisk qDir job'
> +          case write_result of
> +            Bad s -> jobFileFailed s
> +            Ok () -> do
> +              _ <- replicateManyJobs qDir mcs [job']
> +              return . Ok . showJSON $ (True, "Dequeued " ++ jName)
> +    Ok False -> do
> +      logDebug $ jName ++ " not queued; trying to cancel directly"
> +      cancelJob jid
> +    Bad s -> return . Ok . showJSON $ (False, s)
> +
>  handleCall _ _ _ op =
>    return . Bad $
>      GenericError ("Luxi call '" ++ strOfOp op ++ "' not implemented")
> --
> 1.8.5.2
>
>