diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-03-01 15:31:39 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-03-01 15:31:39 -0400 |
commit | 59bb9730f6d245c2e917d048f2de3f5db3d00298 (patch) | |
tree | fe58da62730efc299bbc96d6f52af270c733f4dc /Utility/LockPool/LockHandle.hs | |
parent | 784c3fa0139a5fc0ce459501d713cfe5c39d5a23 (diff) |
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.
Diffstat (limited to 'Utility/LockPool/LockHandle.hs')
-rw-r--r-- | Utility/LockPool/LockHandle.hs | 48 |
1 files changed, 29 insertions, 19 deletions
diff --git a/Utility/LockPool/LockHandle.hs b/Utility/LockPool/LockHandle.hs index 68c979b5d..5697b89cb 100644 --- a/Utility/LockPool/LockHandle.hs +++ b/Utility/LockPool/LockHandle.hs @@ -7,7 +7,16 @@ {-# LANGUAGE CPP #-} -module Utility.LockPool.LockHandle where +module Utility.LockPool.LockHandle ( + LockHandle, + FileLockOps(..), + dropLock, +#ifndef mingw32_HOST_OS + checkSaneLock, +#endif + makeLockHandle, + tryMakeLockHandle, +) where import qualified Utility.LockPool.STM as P #ifndef mingw32_HOST_OS @@ -17,10 +26,7 @@ import Utility.LockPool.STM (LockFile) import Control.Concurrent.STM import Control.Exception -data LockHandle = LockHandle - { poolHandle :: P.LockHandle - , fileLockOps :: FileLockOps - } +data LockHandle = LockHandle P.LockHandle FileLockOps data FileLockOps = FileLockOps { fDropLock :: IO () @@ -30,7 +36,7 @@ data FileLockOps = FileLockOps } dropLock :: LockHandle -> IO () -dropLock h = P.releaseLock (poolHandle h) (fDropLock (fileLockOps h)) +dropLock (LockHandle ph _) = P.releaseLock ph #ifndef mingw32_HOST_OS checkSaneLock :: LockFile -> LockHandle -> IO Bool @@ -40,26 +46,30 @@ checkSaneLock lockfile (LockHandle _ flo) = fCheckSaneLock flo lockfile -- Take a lock, by first updating the lock pool, and then taking the file -- lock. If taking the file lock fails for any reason, take care to -- release the lock in the lock pool. -makeLockHandle :: STM P.LockHandle -> IO FileLockOps -> IO LockHandle -makeLockHandle pa fa = bracketOnError setup cleanup go +makeLockHandle :: P.LockPool -> LockFile -> (P.LockPool -> LockFile -> STM P.LockHandle) -> (LockFile -> IO FileLockOps) -> IO LockHandle +makeLockHandle pool file pa fa = bracketOnError setup cleanup go where - setup = atomically pa - cleanup ph = P.releaseLock ph (return ()) - go ph = do - fo <- fa - return $ LockHandle ph fo + setup = atomically (pa pool file) + cleanup ph = P.releaseLock ph + go ph = mkLockHandle pool file ph =<< fa file -tryMakeLockHandle :: STM (Maybe P.LockHandle) -> IO (Maybe FileLockOps) -> IO (Maybe LockHandle) -tryMakeLockHandle pa fa = bracketOnError setup cleanup go +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 where - setup = atomically pa + setup = atomically (pa pool file) cleanup Nothing = return () - cleanup (Just ph) = P.releaseLock ph (return ()) + cleanup (Just ph) = P.releaseLock ph go Nothing = return Nothing go (Just ph) = do - mfo <- fa + mfo <- fa file case mfo of Nothing -> do cleanup (Just ph) return Nothing - Just fo -> return $ Just $ LockHandle ph fo + Just fo -> Just <$> mkLockHandle pool file ph fo + +mkLockHandle :: P.LockPool -> LockFile -> P.LockHandle -> FileLockOps -> IO LockHandle +mkLockHandle pool file ph fo = do + atomically $ P.registerCloseLockFile pool file (fDropLock fo) + return $ LockHandle ph fo + |