code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Jobs.hs

   1 {-| Generic code to work with jobs, e.g. submit jobs and check their status.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.Jobs
  27   ( submitJobs
  28   , execJobsWait
  29   , execJobsWaitOk
  30   , waitForJobs
  31   ) where
  32
  33 import Control.Concurrent (threadDelay)
  34 import Data.List
  35
  36 import Ganeti.BasicTypes
  37 import Ganeti.Errors
  38 import qualified Ganeti.Luxi as L
  39 import Ganeti.OpCodes
  40 import Ganeti.Types
  41
  42 -- | Submits a set of jobs and returns their job IDs without waiting for
  43 -- completion.
  44 submitJobs :: [[MetaOpCode]] -> L.Client -> IO (Result [L.JobId])
  45 submitJobs opcodes client = do
  46   jids <- L.submitManyJobs client opcodes
  47   return (case jids of
  48             Bad e    -> Bad $ "Job submission error: " ++ formatError e
  49             Ok jids' -> Ok jids')
  50
  51 -- | Executes a set of jobs and waits for their completion, returning their
  52 -- status.
  53 execJobsWait :: [[MetaOpCode]]        -- ^ The list of jobs
  54              -> ([L.JobId] -> IO ())  -- ^ Post-submission callback
  55              -> L.Client              -- ^ The Luxi client
  56              -> IO (Result [(L.JobId, JobStatus)])
  57 execJobsWait opcodes callback client = do
  58   jids <- submitJobs opcodes client
  59   case jids of
  60     Bad e -> return $ Bad e
  61     Ok jids' -> do
  62       callback jids'
  63       waitForJobs jids' client
  64
  65 -- | Polls a set of jobs at a fixed interval until all are finished
  66 -- one way or another.
  67 waitForJobs :: [L.JobId] -> L.Client -> IO (Result [(L.JobId, JobStatus)])
  68 waitForJobs jids client = do
  69   sts <- L.queryJobsStatus client jids
  70   case sts of
  71     Bad e -> return . Bad $ "Checking job status: " ++ formatError e
  72     Ok sts' -> if any (<= JOB_STATUS_RUNNING) sts'
  73             then do
  74               -- TODO: replace hardcoded value with a better thing
  75               threadDelay (1000000 * 15)
  76               waitForJobs jids client
  77             else return . Ok $ zip jids sts'
  78
  79 -- | Execute jobs and return @Ok@ only if all of them succeeded.
  80 execJobsWaitOk :: [[MetaOpCode]] -> L.Client -> IO (Result ())
  81 execJobsWaitOk opcodes client = do
  82   let nullog = const (return () :: IO ())
  83       failed = filter ((/=) JOB_STATUS_SUCCESS . snd)
  84       fmtfail (i, s) = show (fromJobId i) ++ "=>" ++ jobStatusToRaw s
  85   sts <- execJobsWait opcodes nullog client
  86   case sts of
  87     Bad e -> return $ Bad e
  88     Ok sts' -> return (if null $ failed sts' then
  89                          Ok ()
  90                        else
  91                          Bad ("The following jobs failed: " ++
  92                               (intercalate ", " . map fmtfail $ failed sts')))