Race condition in withLock

[qnikst]

Current implementation for withLock have a race condition in presence of exceptions

withLockP :: (Exclusive e) => e -> Process a -> Process a
withLockP excl act = do
  Process.catch (do { -- (0)
                      liftIO $ acquire excl
                    ; result <- act 
                    ; liftIO $ release excl
                    ; return result  -- (2)
                    })
                (\(e :: SomeException) -> (liftIO $ release excl) >> throw e)

if exception will arrive either in (0) then release will be called on the resourse that was not acquired, same if exception will arrive in (2). Correct solution will be to use bracket to acquire and release resource after action, simplest way to do that is to merge patch that introduces MonadMask to Process.

This patch will fix situation:

 diff --git a/distributed-process-extras.cabal b/distributed-process-extras.cabal
index 3992acd..2a2f06a 100644
--- a/distributed-process-extras.cabal
+++ b/distributed-process-extras.cabal
@@ -37,6 +37,7 @@ library
                    fingertree < 0.2,
                    stm >= 2.4 && < 2.5,
                    time > 1.4 && < 1.6,
+                   exceptions >= 0.8,
                    transformers
   if impl(ghc <= 7.5)
     Build-Depends:   template-haskell == 2.7.0.0,
diff --git a/src/Control/Concurrent/Utils.hs b/src/Control/Concurrent/Utils.hs
index b9ab5c9..02088f1 100644
--- a/src/Control/Concurrent/Utils.hs
+++ b/src/Control/Concurrent/Utils.hs
@@ -11,9 +11,7 @@ module Control.Concurrent.Utils
 import Control.Distributed.Process
   ( Process
   )
-import qualified Control.Distributed.Process as Process (catch)
-import Control.Exception (SomeException, throw)
-import qualified Control.Exception as Exception (catch)
+import Control.Monad.Catch (MonadMask, bracket_)
 import Control.Concurrent.MVar
   ( MVar
   , tryPutMVar
@@ -44,22 +42,8 @@ instance Synchronised Lock IO where
   synchronised = withLock

 instance Synchronised Lock Process where
-  synchronised = withLockP
-
-withLockP :: (Exclusive e) => e -> Process a -> Process a
-withLockP excl act = do
-  Process.catch (do { liftIO $ acquire excl
-                    ; result <- act
-                    ; liftIO $ release excl
-                    ; return result
-                    })
-                (\(e :: SomeException) -> (liftIO $ release excl) >> throw e)
+  synchronised = withLock

-withLock :: (Exclusive e) => e -> IO a -> IO a
-withLock excl act = do
-  Exception.catch (do { acquire excl
-                      ; result <- act
-                      ; release excl
-                      ; return result
-                      })
-                  (\(e :: SomeException) -> release excl >> throw e)
+withLock :: (Exclusive e, MonadMask m, MonadIO m) => e -> m a -> m a
+withLock excl = bracket_ (liftIO $ acquire excl)
+                         (liftIO $ release excl)
lines 1-60/60 (END)

I can prepare PR once required feature will land on d-p.

[hyperthunk]

Awesome, thanks for this @qnikst!

[qnikst]

This issue is addressed by #10