3b74386ed4
This fixes the build on windows. Changed it to use lock pools, which will behave better if two threads call getLiveRepoSizes at the same time. Also this should make it work when annex.pidlock is set. In that case, once the current process locks this file, or anything, any other process will have to wait on the pid lock. So checkStaleSizeChanges will correctly identify any other live changes in the database as stale, since there can only be one git-annex process running.
127 lines
3.4 KiB
Haskell
127 lines
3.4 KiB
Haskell
{- git-annex lock files.
|
|
-
|
|
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.LockFile (
|
|
lockFileCached,
|
|
unlockFile,
|
|
getLockCache,
|
|
fromLockCache,
|
|
withSharedLock,
|
|
withExclusiveLock,
|
|
takeExclusiveLock,
|
|
tryExclusiveLock,
|
|
trySharedLock,
|
|
) where
|
|
|
|
import Annex.Common
|
|
import Annex
|
|
import Types.LockCache
|
|
import Annex.Perms
|
|
import Annex.LockPool
|
|
|
|
import qualified Data.Map as M
|
|
import qualified System.FilePath.ByteString as P
|
|
|
|
{- Create a specified lock file, and takes a shared lock, which is retained
|
|
- in the cache. -}
|
|
lockFileCached :: RawFilePath -> Annex ()
|
|
lockFileCached file = go =<< fromLockCache file
|
|
where
|
|
go (Just _) = noop -- already locked
|
|
go Nothing = do
|
|
#ifndef mingw32_HOST_OS
|
|
mode <- annexFileMode
|
|
lockhandle <- lockShared (Just mode) file
|
|
#else
|
|
lockhandle <- liftIO $ waitToLock $ lockShared file
|
|
#endif
|
|
changeLockCache $ M.insert file lockhandle
|
|
|
|
unlockFile :: RawFilePath -> Annex ()
|
|
unlockFile file = maybe noop go =<< fromLockCache file
|
|
where
|
|
go lockhandle = do
|
|
liftIO $ dropLock lockhandle
|
|
changeLockCache $ M.delete file
|
|
|
|
getLockCache :: Annex LockCache
|
|
getLockCache = getState lockcache
|
|
|
|
fromLockCache :: RawFilePath -> Annex (Maybe LockHandle)
|
|
fromLockCache file = M.lookup file <$> getLockCache
|
|
|
|
changeLockCache :: (LockCache -> LockCache) -> Annex ()
|
|
changeLockCache a = do
|
|
m <- getLockCache
|
|
changeState $ \s -> s { lockcache = a m }
|
|
|
|
{- Runs an action with a shared lock held. If an exclusive lock is held,
|
|
- blocks until it becomes free. -}
|
|
withSharedLock :: RawFilePath -> Annex a -> Annex a
|
|
withSharedLock lockfile a = debugLocks $ do
|
|
createAnnexDirectory $ P.takeDirectory lockfile
|
|
mode <- annexFileMode
|
|
bracket (lock mode lockfile) (liftIO . dropLock) (const a)
|
|
where
|
|
#ifndef mingw32_HOST_OS
|
|
lock mode = lockShared (Just mode)
|
|
#else
|
|
lock _mode = liftIO . waitToLock . lockShared
|
|
#endif
|
|
|
|
{- Runs an action with an exclusive lock held. If the lock is already
|
|
- held, blocks until it becomes free. -}
|
|
withExclusiveLock :: RawFilePath -> Annex a -> Annex a
|
|
withExclusiveLock lockfile a = bracket
|
|
(takeExclusiveLock lockfile)
|
|
(liftIO . dropLock)
|
|
(const a)
|
|
|
|
{- Takes an exclusive lock, blocking until it's free. -}
|
|
takeExclusiveLock :: RawFilePath -> Annex LockHandle
|
|
takeExclusiveLock lockfile = debugLocks $ do
|
|
createAnnexDirectory $ P.takeDirectory lockfile
|
|
mode <- annexFileMode
|
|
lock mode lockfile
|
|
where
|
|
#ifndef mingw32_HOST_OS
|
|
lock mode = lockExclusive (Just mode)
|
|
#else
|
|
lock _mode = liftIO . waitToLock . lockExclusive
|
|
#endif
|
|
|
|
{- Tries to take an exclusive lock and run an action. If the lock is
|
|
- already held, returns Nothing. -}
|
|
tryExclusiveLock :: RawFilePath -> Annex a -> Annex (Maybe a)
|
|
tryExclusiveLock lockfile a = debugLocks $ do
|
|
createAnnexDirectory $ P.takeDirectory lockfile
|
|
mode <- annexFileMode
|
|
bracket (lock mode lockfile) (liftIO . unlock) go
|
|
where
|
|
#ifndef mingw32_HOST_OS
|
|
lock mode = tryLockExclusive (Just mode)
|
|
#else
|
|
lock _mode = liftIO . lockExclusive
|
|
#endif
|
|
unlock = maybe noop dropLock
|
|
go Nothing = return Nothing
|
|
go (Just _) = Just <$> a
|
|
|
|
{- Tries to take a shared lock, without blocking.
|
|
-
|
|
- Does not create the lock directory or lock file if it does not exist,
|
|
- taking an exclusive lock will create them.
|
|
-}
|
|
trySharedLock :: RawFilePath -> Annex (Maybe LockHandle)
|
|
trySharedLock lockfile = debugLocks $
|
|
#ifndef mingw32_HOST_OS
|
|
tryLockShared Nothing lockfile
|
|
#else
|
|
liftIO $ lockShared lockfile
|
|
#endif
|