diff options
| -rw-r--r-- | Annex.hs | 6 | ||||
| -rw-r--r-- | Annex/Content.hs | 2 | ||||
| -rw-r--r-- | Annex/LockFile.hs | 36 | ||||
| -rw-r--r-- | Annex/Ssh.hs | 6 | ||||
| -rw-r--r-- | Annex/Transfer.hs | 2 | ||||
| -rw-r--r-- | Database/Fsck.hs | 2 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 2 | ||||
| -rw-r--r-- | Remote/Helper/Hooks.hs | 6 | ||||
| -rw-r--r-- | Types/LockCache.hs (renamed from Types/LockPool.hs) | 10 | ||||
| -rw-r--r-- | Utility/LockFile.hs | 3 | ||||
| -rw-r--r-- | Utility/LockPool/Posix.hs | 4 | ||||
| -rw-r--r-- | Utility/LockPool/STM.hs | 9 | ||||
| -rw-r--r-- | debian/changelog | 1 |
13 files changed, 45 insertions, 44 deletions
@@ -57,7 +57,7 @@ import Types.Messages import Types.UUID import Types.FileMatcher import Types.NumCopies -import Types.LockPool +import Types.LockCache import Types.MetaData import Types.DesktopNotify import Types.CleanupActions @@ -120,7 +120,7 @@ data AnnexState = AnnexState , trustmap :: Maybe TrustMap , groupmap :: Maybe GroupMap , ciphers :: M.Map StorableCipher Cipher - , lockpool :: LockPool + , lockcache :: LockCache , flags :: M.Map String Bool , fields :: M.Map String String , modmeta :: [ModMeta] @@ -166,7 +166,7 @@ newState c r = AnnexState , trustmap = Nothing , groupmap = Nothing , ciphers = M.empty - , lockpool = M.empty + , lockcache = M.empty , flags = M.empty , fields = M.empty , modmeta = [] diff --git a/Annex/Content.hs b/Annex/Content.hs index 2b11f1baf..801bbdef2 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -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. -} diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs index 62a101aa5..928b36ec5 100644 --- a/Annex/LockFile.hs +++ b/Annex/LockFile.hs @@ -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. -} diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index cd28d1fc0..627c04532 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -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 diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index 2511ae436..a2bac34be 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -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 diff --git a/Database/Fsck.hs b/Database/Fsck.hs index 50c08cf61..d9416927b 100644 --- a/Database/Fsck.hs +++ b/Database/Fsck.hs @@ -74,7 +74,7 @@ openDb u = do liftIO $ do void $ tryIO $ removeDirectoryRecursive dbdir rename tmpdbdir dbdir - lockFileShared =<< fromRepo (gitAnnexFsckDbLock u) + lockFileCached =<< fromRepo (gitAnnexFsckDbLock u) h <- liftIO $ H.openDb db "fscked" return $ FsckHandle h u diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 244e9f375..ef1db879c 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -17,7 +17,7 @@ import Utility.Metered import Utility.Percentage import Utility.QuickCheck import Utility.PID -import Utility.LockFile +import Utility.LockPool import Logs.TimeStamp import Data.Time.Clock diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 53bb370a6..1f46eaa4b 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -16,7 +16,7 @@ import Types.Remote import Types.CleanupActions import qualified Annex import Annex.LockFile -import Utility.LockFile +import Utility.LockPool #ifndef mingw32_HOST_OS import Annex.Perms #endif @@ -47,7 +47,7 @@ runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a runHooks r starthook stophook a = do dir <- fromRepo gitAnnexRemotesDir let lck = dir </> remoteid ++ ".lck" - whenM (notElem lck . M.keys <$> getLockPool) $ do + whenM (notElem lck . M.keys <$> getLockCache) $ do liftIO $ createDirectoryIfMissing True dir firstrun lck a @@ -62,7 +62,7 @@ runHooks r starthook stophook a = do -- of it from running the stophook. If another -- instance is shutting down right now, this -- will block waiting for its exclusive lock to clear. - lockFileShared lck + lockFileCached lck -- The starthook is run even if some other git-annex -- is already running, and ran it before. diff --git a/Types/LockPool.hs b/Types/LockCache.hs index 803822042..c1f394cf0 100644 --- a/Types/LockPool.hs +++ b/Types/LockCache.hs @@ -1,16 +1,16 @@ -{- git-annex lock pool data types +{- git-annex lock cache data types - - Copyright 2014 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} -module Types.LockPool ( - LockPool, +module Types.LockCache ( + LockCache, LockHandle ) where import qualified Data.Map as M -import Utility.LockFile +import Utility.LockPool -type LockPool = M.Map FilePath LockHandle +type LockCache = M.Map FilePath LockHandle diff --git a/Utility/LockFile.hs b/Utility/LockFile.hs index f9a0e6783..1d924fc1e 100644 --- a/Utility/LockFile.hs +++ b/Utility/LockFile.hs @@ -4,6 +4,9 @@ - This module does *not* attempt to be a portability shim, it just exposes - the native locking of the OS. - + - Posix fcntl locks have some gotchas. So, consider using + - Utility.LockPool instead of using this module directly. + - - Copyright 2014 Joey Hess <id@joeyh.name> - - License: BSD-2-clause diff --git a/Utility/LockPool/Posix.hs b/Utility/LockPool/Posix.hs index e460272f2..e05ab9754 100644 --- a/Utility/LockPool/Posix.hs +++ b/Utility/LockPool/Posix.hs @@ -18,11 +18,9 @@ module Utility.LockPool.Posix ( import qualified Utility.LockFile.Posix as F import qualified Utility.LockPool.STM as P -import Utility.LockPool.STM (LockPool, LockFile, LockMode(..)) +import Utility.LockPool.STM (LockFile, LockMode(..)) import Utility.LockPool.LockHandle -import Utility.Monad -import Control.Concurrent.STM import System.IO import System.Posix import Data.Maybe diff --git a/Utility/LockPool/STM.hs b/Utility/LockPool/STM.hs index a60bbc7bf..f422c8a73 100644 --- a/Utility/LockPool/STM.hs +++ b/Utility/LockPool/STM.hs @@ -80,16 +80,15 @@ tryTakeLock pool file mode = -- -- Note that the lock pool is left empty while the checker action is run. -- This allows checker actions that open/close files, and so would be in --- danger of conflicting with existing locks. Since the lock pool is --- kept empty, anything that attempts to take a lock will block, --- avoiding that race. +-- danger of conflicting with locks created at the same time this is +-- running. With the lock pool empty, anything that attempts +-- to take a lock will block, avoiding that race. getLockStatus :: LockPool -> LockFile -> IO v -> IO (Maybe v) -> IO (Maybe v) getLockStatus pool file getdefault checker = do v <- atomically $ do m <- takeTMVar pool let threadlocked = case M.lookup file m of - Just (LockStatus _ n) - | n > 0 -> True + Just (LockStatus _ n) | n > 0 -> True _ -> False if threadlocked then do diff --git a/debian/changelog b/debian/changelog index 77477078c..104648315 100644 --- a/debian/changelog +++ b/debian/changelog @@ -23,6 +23,7 @@ git-annex (5.20150508.2) UNRELEASED; urgency=medium all refs used. * webapp: Fix zombie xdg-open process left when opening file browser. Closes: #785498 + * Safer posix fctnl locking implementation, using lock pools and STM. -- Joey Hess <id@joeyh.name> Mon, 11 May 2015 12:45:06 -0400 |