use lock pools throughout git-annex

The one exception is in Utility.Daemon. As long as a process only
daemonizes once, which seems reasonable, and as long as it avoids calling
checkDaemon once it's already running as a daemon, the fcntl locking
gotchas won't be a problem there.

Annex.LockFile has it's own separate lock pool layer, which has been
renamed to LockCache. This is a persistent cache of locks that persist
until closed.

This is not quite done; lockContent stil needs to be converted.
This commit is contained in:
Joey Hess 2015-05-18 16:23:07 -04:00
parent 6915b71c57
commit ecb0d5c087
13 changed files with 45 additions and 44 deletions

View file

@ -58,7 +58,7 @@ import Annex.Perms
import Annex.Link
import Annex.Content.Direct
import Annex.ReplaceFile
import Utility.LockFile
import Utility.LockPool
import Messages.Progress
{- Checks if a given key's content is currently present. -}

View file

@ -8,26 +8,26 @@
{-# LANGUAGE CPP #-}
module Annex.LockFile (
lockFileShared,
lockFileCached,
unlockFile,
getLockPool,
getLockCache,
withExclusiveLock,
tryExclusiveLock,
) where
import Common.Annex
import Annex
import Types.LockPool
import Types.LockCache
import qualified Git
import Annex.Perms
import Utility.LockFile
import Utility.LockPool
import qualified Data.Map as M
{- Create a specified lock file, and takes a shared lock, which is retained
- in the pool. -}
lockFileShared :: FilePath -> Annex ()
lockFileShared file = go =<< fromLockPool file
- in the cache. -}
lockFileCached :: FilePath -> Annex ()
lockFileCached file = go =<< fromLockCache file
where
go (Just _) = noop -- already locked
go Nothing = do
@ -37,25 +37,25 @@ lockFileShared file = go =<< fromLockPool file
#else
lockhandle <- liftIO $ waitToLock $ lockShared file
#endif
changeLockPool $ M.insert file lockhandle
changeLockCache $ M.insert file lockhandle
unlockFile :: FilePath -> Annex ()
unlockFile file = maybe noop go =<< fromLockPool file
unlockFile file = maybe noop go =<< fromLockCache file
where
go lockhandle = do
liftIO $ dropLock lockhandle
changeLockPool $ M.delete file
changeLockCache $ M.delete file
getLockPool :: Annex LockPool
getLockPool = getState lockpool
getLockCache :: Annex LockCache
getLockCache = getState lockcache
fromLockPool :: FilePath -> Annex (Maybe LockHandle)
fromLockPool file = M.lookup file <$> getLockPool
fromLockCache :: FilePath -> Annex (Maybe LockHandle)
fromLockCache file = M.lookup file <$> getLockCache
changeLockPool :: (LockPool -> LockPool) -> Annex ()
changeLockPool a = do
m <- getLockPool
changeState $ \s -> s { lockpool = a m }
changeLockCache :: (LockCache -> LockCache) -> Annex ()
changeLockCache a = do
m <- getLockCache
changeState $ \s -> s { lockcache = a m }
{- Runs an action with an exclusive lock held. If the lock is already
- held, blocks until it becomes free. -}

View file

@ -37,7 +37,7 @@ import Types.CleanupActions
import Annex.Index (addGitEnv)
#ifndef mingw32_HOST_OS
import Annex.Perms
import Utility.LockFile
import Utility.LockPool
#endif
{- Generates parameters to ssh to a given host (or user@host) on a given
@ -126,13 +126,13 @@ prepSocket socketfile = do
-- If the lock pool is empty, this is the first ssh of this
-- run. There could be stale ssh connections hanging around
-- from a previous git-annex run that was interrupted.
whenM (not . any isLock . M.keys <$> getLockPool)
whenM (not . any isLock . M.keys <$> getLockCache)
sshCleanup
-- Cleanup at end of this run.
Annex.addCleanup SshCachingCleanup sshCleanup
liftIO $ createDirectoryIfMissing True $ parentDir socketfile
lockFileShared $ socket2lock socketfile
lockFileCached $ socket2lock socketfile
enumSocketFiles :: Annex [FilePath]
enumSocketFiles = go =<< sshCacheDir

View file

@ -23,7 +23,7 @@ import Logs.Transfer as X
import Annex.Notification as X
import Annex.Perms
import Utility.Metered
import Utility.LockFile
import Utility.LockPool
import Control.Concurrent