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
74 lines
2.2 KiB
Haskell
74 lines
2.2 KiB
Haskell
{- Posix lock files, using lock pools.
|
|
-
|
|
- Copyright 2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
module Utility.LockPool.Posix (
|
|
P.LockFile,
|
|
LockHandle,
|
|
lockShared,
|
|
lockExclusive,
|
|
tryLockShared,
|
|
tryLockExclusive,
|
|
checkLocked,
|
|
getLockStatus,
|
|
LockStatus(..),
|
|
dropLock,
|
|
checkSaneLock,
|
|
) where
|
|
|
|
import qualified Utility.LockFile.Posix as F
|
|
import Utility.LockFile.LockStatus
|
|
import qualified Utility.LockPool.STM as P
|
|
import Utility.LockPool.STM (LockFile, LockMode(..))
|
|
import Utility.LockPool.LockHandle
|
|
|
|
import System.IO
|
|
import System.Posix
|
|
import Data.Maybe
|
|
import Control.Applicative
|
|
import Prelude
|
|
|
|
-- Takes a shared lock, blocking until the lock is available.
|
|
lockShared :: Maybe FileMode -> LockFile -> IO LockHandle
|
|
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 = 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 = 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 = fmap fst <$> 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.
|
|
checkLocked :: LockFile -> IO (Maybe Bool)
|
|
checkLocked file = P.getLockStatus P.lockPool file
|
|
(pure (Just True))
|
|
(F.checkLocked file)
|
|
|
|
getLockStatus :: LockFile -> IO LockStatus
|
|
getLockStatus file = P.getLockStatus P.lockPool file
|
|
(StatusLockedBy <$> getProcessID)
|
|
(F.getLockStatus file)
|
|
|
|
mk :: F.LockHandle -> (FileLockOps, ())
|
|
mk h = (FileLockOps
|
|
{ fDropLock = F.dropLock h
|
|
, fCheckSaneLock = \f -> F.checkSaneLock f h
|
|
}, ())
|