ef3ab0769e
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
92 lines
2.5 KiB
Haskell
92 lines
2.5 KiB
Haskell
{- Handles for lock pools.
|
|
-
|
|
- Copyright 2015-2021 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Utility.LockPool.LockHandle (
|
|
LockHandle(..),
|
|
FileLockOps(..),
|
|
dropLock,
|
|
#ifndef mingw32_HOST_OS
|
|
checkSaneLock,
|
|
#endif
|
|
makeLockHandle,
|
|
tryMakeLockHandle,
|
|
) where
|
|
|
|
import qualified Utility.LockPool.STM as P
|
|
import Utility.LockPool.STM (LockFile)
|
|
import Utility.DebugLocks
|
|
|
|
import Control.Concurrent.STM
|
|
import Control.Monad.Catch
|
|
import Control.Monad.IO.Class (liftIO, MonadIO)
|
|
import Prelude
|
|
|
|
data LockHandle = LockHandle P.LockHandle FileLockOps
|
|
|
|
data FileLockOps = FileLockOps
|
|
{ fDropLock :: IO ()
|
|
#ifndef mingw32_HOST_OS
|
|
, fCheckSaneLock :: LockFile -> IO Bool
|
|
#endif
|
|
}
|
|
|
|
dropLock :: LockHandle -> IO ()
|
|
dropLock (LockHandle ph _) = P.releaseLock ph
|
|
|
|
#ifndef mingw32_HOST_OS
|
|
checkSaneLock :: LockFile -> LockHandle -> IO Bool
|
|
checkSaneLock lockfile (LockHandle _ flo) = fCheckSaneLock flo lockfile
|
|
#endif
|
|
|
|
-- 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
|
|
:: (MonadIO m, MonadMask m)
|
|
=> P.LockPool
|
|
-> LockFile
|
|
-> (P.LockPool -> LockFile -> STM (P.LockHandle, P.FirstLock))
|
|
-> (LockFile -> P.FirstLock -> m (FileLockOps, t))
|
|
-> m (LockHandle, t)
|
|
makeLockHandle pool file pa fa = bracketOnError setup cleanup go
|
|
where
|
|
setup = debugLocks $ liftIO $ atomically (pa pool file)
|
|
cleanup (ph, _) = debugLocks $ liftIO $ P.releaseLock ph
|
|
go (ph, firstlock) = do
|
|
(flo, t) <- fa file firstlock
|
|
h <- liftIO $ mkLockHandle ph flo
|
|
return (h, t)
|
|
|
|
tryMakeLockHandle
|
|
:: (MonadIO m, MonadMask m)
|
|
=> P.LockPool
|
|
-> LockFile
|
|
-> (P.LockPool -> LockFile -> STM (Maybe (P.LockHandle, P.FirstLock)))
|
|
-> (LockFile -> P.FirstLock -> m (Maybe (FileLockOps, t)))
|
|
-> m (Maybe (LockHandle, t))
|
|
tryMakeLockHandle pool file pa fa = bracketOnError setup cleanup go
|
|
where
|
|
setup = liftIO $ atomically (pa pool file)
|
|
cleanup Nothing = return ()
|
|
cleanup (Just (ph, _)) = liftIO $ P.releaseLock ph
|
|
go Nothing = return Nothing
|
|
go (Just (ph, firstlock)) = do
|
|
mfo <- fa file firstlock
|
|
case mfo of
|
|
Nothing -> do
|
|
liftIO $ cleanup (Just (ph, firstlock))
|
|
return Nothing
|
|
Just (fo, t) -> do
|
|
h <- liftIO $ mkLockHandle ph fo
|
|
return (Just (h, t))
|
|
|
|
mkLockHandle :: P.LockHandle -> FileLockOps -> IO LockHandle
|
|
mkLockHandle ph fo = do
|
|
atomically $ P.registerCloseLockFile ph (fDropLock fo)
|
|
return $ LockHandle ph fo
|