Revision ae858516 src/Ganeti/JQueue.hs
b/src/Ganeti/JQueue.hs | ||
---|---|---|
46 | 46 |
, loadJobFromDisk |
47 | 47 |
, noSuchJob |
48 | 48 |
, readSerialFromDisk |
49 |
, allocateJobIds |
|
50 |
, allocateJobId |
|
49 | 51 |
) where |
50 | 52 |
|
53 |
import Control.Concurrent.MVar |
|
51 | 54 |
import Control.Exception |
52 | 55 |
import Control.Monad |
53 | 56 |
import Data.List |
... | ... | |
66 | 69 |
import qualified Ganeti.Constants as C |
67 | 70 |
import Ganeti.JSON |
68 | 71 |
import Ganeti.Logging |
72 |
import Ganeti.Objects (Node) |
|
69 | 73 |
import Ganeti.OpCodes |
70 | 74 |
import Ganeti.Path |
75 |
import Ganeti.Rpc (executeRpcCall, RpcCallJobqueueUpdate(..)) |
|
71 | 76 |
import Ganeti.THH |
72 | 77 |
import Ganeti.Types |
73 | 78 |
import Ganeti.Utils |
... | ... | |
338 | 343 |
filename <- jobQueueSerialFile |
339 | 344 |
tryAndLogIOError (readFile filename) "Failed to read serial file" |
340 | 345 |
(makeJobIdS . rStripSpace) |
346 |
|
|
347 |
-- | Allocate new job ids. |
|
348 |
-- To avoid races while accessing the serial file, the threads synchronize |
|
349 |
-- over a lock, as usual provided by an MVar. |
|
350 |
allocateJobIds :: [Node] -> MVar () -> Int -> IO (Result [JobId]) |
|
351 |
allocateJobIds mastercandidates lock n = |
|
352 |
if n <= 0 |
|
353 |
then return . Bad $ "Can only allocate positive number of job ids" |
|
354 |
else do |
|
355 |
takeMVar lock |
|
356 |
rjobid <- readSerialFromDisk |
|
357 |
case rjobid of |
|
358 |
Bad s -> do |
|
359 |
putMVar lock () |
|
360 |
return . Bad $ s |
|
361 |
Ok jid -> do |
|
362 |
let current = fromJobId jid |
|
363 |
serial_content = show (current + n) ++ "\n" |
|
364 |
serial <- jobQueueSerialFile |
|
365 |
write_result <- try $ atomicWriteFile serial serial_content |
|
366 |
:: IO (Either IOError ()) |
|
367 |
putMVar lock () |
|
368 |
case write_result of |
|
369 |
Left e -> do |
|
370 |
let msg = "Failed to write serial file: " ++ show e |
|
371 |
logError msg |
|
372 |
return . Bad $ msg |
|
373 |
Right () -> do |
|
374 |
_ <- executeRpcCall mastercandidates |
|
375 |
$ RpcCallJobqueueUpdate serial serial_content |
|
376 |
return $ mapM makeJobId [(current+1)..(current+n)] |
|
377 |
|
|
378 |
-- | Allocate one new job id. |
|
379 |
allocateJobId :: [Node] -> MVar () -> IO (Result JobId) |
|
380 |
allocateJobId mastercandidates lock = do |
|
381 |
jids <- allocateJobIds mastercandidates lock 1 |
|
382 |
return (jids >>= monadicThe "Failed to allocate precisely one Job ID") |
Also available in: Unified diff