Fix a lock file descriptor leak that could occur when running commands like git-annex add with -J

Bug was introduced as part of a different FD leak fix in version 6.20160318.
This commit is contained in:
Joey Hess 2020-07-21 15:30:47 -04:00
parent fd8339005a
commit ac56a5c2a0
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 54 additions and 27 deletions

View file

@ -52,7 +52,7 @@ makeLockHandle pool file pa fa = bracketOnError setup cleanup go
where
setup = debugLocks $ atomically (pa pool file)
cleanup ph = debugLocks $ P.releaseLock ph
go ph = mkLockHandle pool file ph =<< fa file
go ph = mkLockHandle ph =<< fa file
tryMakeLockHandle :: P.LockPool -> LockFile -> (P.LockPool -> LockFile -> STM (Maybe P.LockHandle)) -> (LockFile -> IO (Maybe FileLockOps)) -> IO (Maybe LockHandle)
tryMakeLockHandle pool file pa fa = bracketOnError setup cleanup go
@ -67,10 +67,10 @@ tryMakeLockHandle pool file pa fa = bracketOnError setup cleanup go
Nothing -> do
cleanup (Just ph)
return Nothing
Just fo -> Just <$> mkLockHandle pool file ph fo
Just fo -> Just <$> mkLockHandle ph fo
mkLockHandle :: P.LockPool -> LockFile -> P.LockHandle -> FileLockOps -> IO LockHandle
mkLockHandle pool file ph fo = do
atomically $ P.registerCloseLockFile pool file (fDropLock fo)
mkLockHandle :: P.LockHandle -> FileLockOps -> IO LockHandle
mkLockHandle ph fo = do
atomically $ P.registerCloseLockFile ph (fDropLock fo)
return $ LockHandle ph fo