e60766543f
WIP: This is mostly complete, but there is a problem: createDirectoryUnder throws an error when annex.dbdir is set to outside the git repo. annex.dbdir is a workaround for filesystems where sqlite does not work, due to eg, the filesystem not properly supporting locking. It's intended to be set before initializing the repository. Changing it in an existing repository can be done, but would be the same as making a new repository and moving all the annexed objects into it. While the databases get recreated from the git-annex branch in that situation, any information that is in the databases but not stored in the branch gets lost. It may be that no information ever gets stored in the databases that cannot be reconstructed from the branch, but I have not verified that. Sponsored-by: Dartmouth College's Datalad project
113 lines
3.1 KiB
Haskell
113 lines
3.1 KiB
Haskell
{- git-annex lock files.
|
|
-
|
|
- Copyright 2012-2020 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,
|
|
) 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 <- noUmask mode $ 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 = noUmask 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 = noUmask 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 = noUmask mode . tryLockExclusive (Just mode)
|
|
#else
|
|
lock _mode = liftIO . lockExclusive
|
|
#endif
|
|
unlock = maybe noop dropLock
|
|
go Nothing = return Nothing
|
|
go (Just _) = Just <$> a
|