close pid lock only once no threads use it

This fixes a FD leak when annex.pidlock is set and -J is used. Also, it
fixes bugs where the pid lock file got deleted because one thread was
done with it, while another thread was still holding it open.

The LockPool now has two distinct types of resources,
one is per-LockHandle and is used for file Handles, which get closed
when the associated LockHandle is closed. The other one is per lock
file, and gets closed when no more LockHandles use that lock file,
including other shared locks of the same file.

That latter kind is used for the pid lock file, so it's opened by the
first thread to use a lock, and closed when the last thread closes a lock.

In practice, this means that eg git-annex get of several files opens and
closes the pidlock file a few times per file. While with -J5 it will open
the pidlock file, process a number of files, until all the threads happen to
finish together, at which point the pidlock file gets closed, and then
that repeats. So in either case, another process still gets a chance to
take the pidlock.

registerPostRelease has a rather intricate dance, there are fine-grained
STM locks, a STM lock of the pidfile itself, and the actual pidlock file
on disk that are all resolved in stages by it.

Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
Joey Hess 2021-12-06 15:01:39 -04:00
parent 774c7dab2f
commit ef3ab0769e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 128 additions and 90 deletions

View file

@ -33,25 +33,25 @@ import Prelude
-- Takes a shared lock, blocking until the lock is available.
lockShared :: Maybe FileMode -> LockFile -> IO LockHandle
lockShared mode file = makeLockHandle P.lockPool file
lockShared mode file = fst <$> 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.lockPool file
lockExclusive mode file = fst <$> 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.lockPool file
tryLockShared mode file = fmap fst <$> 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.lockPool file
tryLockExclusive mode file = fmap fst <$> tryMakeLockHandle P.lockPool file
(\p f -> P.tryTakeLock p f LockExclusive)
(\f _ -> fmap mk <$> F.tryLockExclusive mode f)
@ -67,8 +67,8 @@ getLockStatus file = P.getLockStatus P.lockPool file
(StatusLockedBy <$> getProcessID)
(F.getLockStatus file)
mk :: F.LockHandle -> FileLockOps
mk h = FileLockOps
mk :: F.LockHandle -> (FileLockOps, ())
mk h = (FileLockOps
{ fDropLock = F.dropLock h
, fCheckSaneLock = \f -> F.checkSaneLock f h
}
}, ())