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