Revision 6fdc84ab

b/src/Ganeti/Query/Server.hs
334 334
      cancelJob jid
335 335
    Bad s -> return . Ok . showJSON $ (False, s)
336 336

  
337
handleCall qlock _ cfg (ArchiveJob jid) = do
338
  let archiveFailed = putMVar qlock  () >> (return . Ok $ showJSON False)
339
                      :: IO (ErrorResult JSValue)
340
  qDir <- queueDir
341
  takeMVar qlock
342
  result <- loadJobFromDisk qDir False jid
343
  case result of
344
    Bad _ -> archiveFailed
345
    Ok (job, _) -> if jobFinalized job
346
                     then do
347
                       let mcs = Config.getMasterCandidates cfg
348
                           live = liveJobFile qDir jid
349
                           archive = archivedJobFile qDir jid
350
                       renameResult <- try $ renameFile live archive
351
                                       :: IO (Either IOError ())
352
                       putMVar qlock ()
353
                       case renameResult of
354
                         Left e -> return . Bad . JobQueueError
355
                                     $ "Archiving failed in an unexpected way: "
356
                                         ++ show e
357
                         Right () -> do
358
                           _ <- executeRpcCall mcs
359
                                  $ RpcCallJobqueueRename [(live, archive)]
360
                          return . Ok $ showJSON True
361
                     else archiveFailed
362

  
337 363
handleCall _ _ _ op =
338 364
  return . Bad $
339 365
    GenericError ("Luxi call '" ++ strOfOp op ++ "' not implemented")

Also available in: Unified diff