Always accept no-op requests
authorKlaus Aehlig <aehlig@google.com>
Thu, 28 May 2015 15:53:42 +0000 (17:53 +0200)
committerKlaus Aehlig <aehlig@google.com>
Mon, 1 Jun 2015 08:19:22 +0000 (10:19 +0200)
In order to have update requests repeatable, always
accept requests that do not require any change to the
state. Note that this is not implied by the current
definition, as the request might ask for two locks at
different level, and thus the repetition would violate
lock order.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Petr Pudlak <pudlak@google.com>

src/Ganeti/Locking/Waiting.hs

index c5faeb7..bd2c6fb 100644 (file)
@@ -230,6 +230,16 @@ updateLocksWaiting' prio owner reqs state =
                                 }
   in (state'', (result, notify))
 
+-- | Predicate whether a request is already fulfilled in a given state
+-- and no requests for that owner are pending.
+requestFulfilled :: (Ord a, Ord b)
+                 => b -> [L.LockRequest a] -> LockWaiting a b c -> Bool
+requestFulfilled owner req state =
+  let locks = L.listLocks owner $ lwAllocation state
+      isFulfilled r = M.lookup (L.lockAffected r) locks
+                        == L.lockRequestType r
+  in not (hasPendingRequest owner state) && all isFulfilled req
+
 -- | Update the locks on an onwer according to the given request, if possible.
 -- Additionally (if the request succeeds) fulfill any pending requests that
 -- became possible through this request. Return the new state of the waiting
@@ -237,18 +247,22 @@ updateLocksWaiting' prio owner reqs state =
 -- The result is, as for lock allocation, the set of owners the request is
 -- blocked on. Again, the type is chosen to be suitable for use in
 -- atomicModifyIORef.
+-- For convenience, fulfilled requests are always accepted.
 updateLocks :: (Lock a, Ord b, Ord c)
             => b
             -> [L.LockRequest a]
             -> LockWaiting a b c
             -> (LockWaiting a b c, (Result (S.Set b), S.Set b))
 updateLocks owner req state =
-  second (second $ S.delete owner) $ updateLocks' owner req state
+  if requestFulfilled owner req state
+    then (state, (Ok S.empty, S.empty))
+    else second (second $ S.delete owner) $ updateLocks' owner req state
 
 -- | Update locks as soon as possible. If the request cannot be fulfilled
 -- immediately add the request to the waiting queue. The first argument is
 -- the priority at which the owner is waiting, the remaining are as for
 -- updateLocks, and so is the output.
+-- For convenience, fulfilled requests are always accepted.
 updateLocksWaiting :: (Lock a, Ord b, Ord c)
                    => c
                    -> b
@@ -256,7 +270,10 @@ updateLocksWaiting :: (Lock a, Ord b, Ord c)
                    -> LockWaiting a b c
                    -> (LockWaiting a b c, (Result (S.Set b), S.Set b))
 updateLocksWaiting prio owner req state =
-  second (second $ S.delete owner) $ updateLocksWaiting' prio owner req state
+  if requestFulfilled owner req state
+    then (state, (Ok S.empty, S.empty))
+     else second (second $ S.delete owner)
+            $ updateLocksWaiting' prio owner req state
 
 -- | Compute the state of a waiting after an owner gives up
 -- on his pending request.