From 59bb9730f6d245c2e917d048f2de3f5db3d00298 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 1 Mar 2016 15:31:39 -0400
Subject: Fix shared lock file FD leak.

This fixes behavior in this situation:

	l1 <- lockShared Nothing "lck"
	l2 <- lockShared Nothing "lck"
	dropLock l1
	dropLock l2

Before, the lock was dropped upon the second dropLock call, but the fd
remained open, and would never be closed while the program was running.

Fixed by a rather round-about method, but it should work well enough.

It would have been simpler to open open the shared lock once, and not open
it again in the second call to lockShared. But, that's difficult to do
atomically.

This also affects Windows and PID locks, not just posix locks.

In the case of pid locks, multiple calls to waitLock within the same
process are allowed because the side lock is locked using a posix lock,
and so multiple exclusive locks can be taken in the same process. So,
this change fixes a similar problem with pid locks.

	l1 <- waitLock (Seconds 1) "lck"
	l2 <- waitLock (Seconds 1) "lck"
	dropLock l1
	dropLock l2

Here the l2 side lock fd remained open but not locked,
although the pid lock file was removed. After this change, the second
dropLock will close both fds to the side lock, and delete the pidlock.
---
 Utility/LockPool/Posix.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

(limited to 'Utility/LockPool/Posix.hs')

diff --git a/Utility/LockPool/Posix.hs b/Utility/LockPool/Posix.hs
index a77ed8f01..2c0b7c78e 100644
--- a/Utility/LockPool/Posix.hs
+++ b/Utility/LockPool/Posix.hs
@@ -33,27 +33,27 @@ import Prelude
 
 -- Takes a shared lock, blocking until the lock is available.
 lockShared :: Maybe FileMode -> LockFile -> IO LockHandle
-lockShared mode file = makeLockHandle
-	(P.waitTakeLock P.lockPool file LockShared)
-	(mk <$> F.lockShared mode file)
+lockShared mode file = makeLockHandle P.lockPool file
+	(\p f -> P.waitTakeLock p f LockShared)
+	(\f -> mk <$> F.lockShared mode f)
 
 -- Takes an exclusive lock, blocking until the lock is available.
 lockExclusive :: Maybe FileMode -> LockFile -> IO LockHandle
-lockExclusive mode file = makeLockHandle
-	(P.waitTakeLock P.lockPool file LockExclusive)
-	(mk <$> F.lockExclusive mode file)
+lockExclusive mode file = makeLockHandle P.lockPool file
+	(\p f -> P.waitTakeLock p f LockExclusive)
+	(\f -> mk <$> F.lockExclusive mode f)
 
 -- Tries to take a shared lock, but does not block.
 tryLockShared :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
-tryLockShared mode file = tryMakeLockHandle
-	(P.tryTakeLock P.lockPool file LockShared)
-	(fmap mk <$> F.tryLockShared mode file)
+tryLockShared mode file = tryMakeLockHandle P.lockPool file
+	(\p f -> P.tryTakeLock p f LockShared)
+	(\f -> fmap mk <$> F.tryLockShared mode f)
 
 -- Tries to take an exclusive lock, but does not block.
 tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
-tryLockExclusive mode file = tryMakeLockHandle
-	(P.tryTakeLock P.lockPool file LockExclusive)
-	(fmap mk <$> F.tryLockExclusive mode file)
+tryLockExclusive mode file = tryMakeLockHandle P.lockPool file
+	(\p f -> P.tryTakeLock p f LockExclusive)
+	(\f -> fmap mk <$> F.tryLockExclusive mode f)
 
 -- Returns Nothing when the file doesn't exist, for cases where
 -- that is different from it not being locked.
-- 
cgit v1.2.3