diff --git a/Annex/LockPool/PosixOrPid.hs b/Annex/LockPool/PosixOrPid.hs index 632d967640..151a5b3193 100644 --- a/Annex/LockPool/PosixOrPid.hs +++ b/Annex/LockPool/PosixOrPid.hs @@ -1,7 +1,7 @@ {- Wraps Utility.LockPool, making pid locks be used when git-annex is so - configured. - - - Copyright 2015 Joey Hess + - Copyright 2015-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -31,6 +31,7 @@ import Utility.LockFile.Posix (openLockFile) import Utility.LockPool.STM (LockFile) import Utility.LockFile.LockStatus import Config (pidLockFile) +import Messages (warning) import System.Posix @@ -72,9 +73,8 @@ pidLock m f posixlock = debugLocks $ go =<< pidLockFile go Nothing = liftIO posixlock go (Just pidlock) = do timeout <- annexPidLockTimeout <$> Annex.getGitConfig - liftIO $ do - dummyPosixLock m f - Pid.waitLock timeout pidlock + liftIO $ dummyPosixLock m f + Pid.waitLock timeout pidlock warning tryPidLock :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) -> Annex (Maybe LockHandle) tryPidLock m f posixlock = debugLocks $ liftIO . go =<< pidLockFile diff --git a/CHANGELOG b/CHANGELOG index d816e0f53c..824d217b57 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -12,6 +12,8 @@ git-annex (8.20200815) UNRELEASED; urgency=medium * Fix reversion in 8.20200617 that made annex.pidlock being enabled result in some commands stalling, particularly those needing to autoinit. + * Display a message when git-annex has to wait for a pid lock file + held by another process. -- Joey Hess Fri, 14 Aug 2020 14:57:45 -0400 diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs index 12d4c0a5c6..1a8bfd72a2 100644 --- a/Utility/LockFile/PidLock.hs +++ b/Utility/LockFile/PidLock.hs @@ -38,6 +38,8 @@ import System.Posix.IO import System.Posix.Types import System.Posix.Files import System.Posix.Process +import Control.Monad +import Control.Monad.IO.Class (liftIO, MonadIO) import Data.Maybe import Data.List import Network.BSD @@ -240,19 +242,24 @@ checkInsaneLustre dest = do -- | Waits as necessary to take a lock. -- --- Uses a 1 second wait-loop. +-- Uses a 1 second wait-loop, retrying until a timeout. -- --- May wait until timeout if the lock file is stale and is on a network file --- system, or on a system where the side lock cannot be taken. -waitLock :: Seconds -> LockFile -> IO LockHandle -waitLock (Seconds timeout) lockfile = go timeout +-- After the first second waiting, runs the callback to display a message, +-- so the user knows why it's stalled. +waitLock :: MonadIO m => Seconds -> LockFile -> (String -> m ()) -> m LockHandle +waitLock (Seconds timeout) lockfile displaymessage = go timeout where go n - | n > 0 = maybe (threadDelaySeconds (Seconds 1) >> go (pred n)) return - =<< tryLock lockfile + | n > 0 = liftIO (tryLock lockfile) >>= \case + Nothing -> do + when (n == pred timeout) $ + displaymessage $ "waiting for pid lock file " ++ lockfile ++ " which is held by another process (or may be stale)" + liftIO $ threadDelaySeconds (Seconds 1) + go (pred n) + Just lckh -> return lckh | otherwise = do - hPutStrLn stderr $ show timeout ++ " second timeout exceeded while waiting for pid lock file " ++ lockfile - giveup $ "Gave up waiting for possibly stale pid lock file " ++ lockfile + displaymessage $ show timeout ++ " second timeout exceeded while waiting for pid lock file " ++ lockfile + giveup $ "Gave up waiting for pid lock file " ++ lockfile dropLock :: LockHandle -> IO () dropLock (LockHandle lockfile _ sidelock) = do diff --git a/Utility/LockPool/LockHandle.hs b/Utility/LockPool/LockHandle.hs index e8701a5b61..e2a954fdeb 100644 --- a/Utility/LockPool/LockHandle.hs +++ b/Utility/LockPool/LockHandle.hs @@ -1,6 +1,6 @@ {- Handles for lock pools. - - - Copyright 2015 Joey Hess + - Copyright 2015-2020 Joey Hess - - License: BSD-2-clause -} @@ -23,7 +23,8 @@ import Utility.LockPool.STM (LockFile) import Utility.DebugLocks import Control.Concurrent.STM -import Control.Exception +import Control.Monad.Catch +import Control.Monad.IO.Class (liftIO, MonadIO) import Control.Applicative import Prelude @@ -47,27 +48,39 @@ checkSaneLock lockfile (LockHandle _ flo) = fCheckSaneLock flo lockfile -- Take a lock, by first updating the lock pool, and then taking the file -- lock. If taking the file lock fails for any reason, take care to -- release the lock in the lock pool. -makeLockHandle :: P.LockPool -> LockFile -> (P.LockPool -> LockFile -> STM P.LockHandle) -> (LockFile -> IO FileLockOps) -> IO LockHandle +makeLockHandle + :: (MonadIO m, MonadMask m) + => P.LockPool + -> LockFile + -> (P.LockPool -> LockFile -> STM P.LockHandle) + -> (LockFile -> m FileLockOps) + -> m LockHandle makeLockHandle pool file pa fa = bracketOnError setup cleanup go where - setup = debugLocks $ atomically (pa pool file) - cleanup ph = debugLocks $ P.releaseLock ph - go ph = mkLockHandle ph =<< fa file + setup = debugLocks $ liftIO $ atomically (pa pool file) + cleanup ph = debugLocks $ liftIO $ P.releaseLock ph + go ph = liftIO . mkLockHandle ph =<< fa file -tryMakeLockHandle :: P.LockPool -> LockFile -> (P.LockPool -> LockFile -> STM (Maybe P.LockHandle)) -> (LockFile -> IO (Maybe FileLockOps)) -> IO (Maybe LockHandle) +tryMakeLockHandle + :: (MonadIO m, MonadMask m) + => P.LockPool + -> LockFile + -> (P.LockPool -> LockFile -> STM (Maybe P.LockHandle)) + -> (LockFile -> m (Maybe FileLockOps)) + -> m (Maybe LockHandle) tryMakeLockHandle pool file pa fa = bracketOnError setup cleanup go where - setup = atomically (pa pool file) + setup = liftIO $ atomically (pa pool file) cleanup Nothing = return () - cleanup (Just ph) = P.releaseLock ph + cleanup (Just ph) = liftIO $ P.releaseLock ph go Nothing = return Nothing go (Just ph) = do mfo <- fa file case mfo of Nothing -> do - cleanup (Just ph) + liftIO $ cleanup (Just ph) return Nothing - Just fo -> Just <$> mkLockHandle ph fo + Just fo -> liftIO $ Just <$> mkLockHandle ph fo mkLockHandle :: P.LockHandle -> FileLockOps -> IO LockHandle mkLockHandle ph fo = do diff --git a/Utility/LockPool/PidLock.hs b/Utility/LockPool/PidLock.hs index 26ed96f3cf..02f079a030 100644 --- a/Utility/LockPool/PidLock.hs +++ b/Utility/LockPool/PidLock.hs @@ -1,6 +1,6 @@ {- Pid locks, using lock pools. - - - Copyright 2015 Joey Hess + - Copyright 2015-2020 Joey Hess - - License: BSD-2-clause -} @@ -27,16 +27,23 @@ import Utility.ThreadScheduler import System.IO import System.Posix import Data.Maybe +import Control.Monad.Catch +import Control.Monad.IO.Class import Control.Applicative import Prelude -- Takes a pid lock, blocking until the lock is available or the timeout. -waitLock :: Seconds -> LockFile -> IO LockHandle -waitLock timeout file = makeLockHandle P.lockPool file +waitLock + :: (MonadIO m, MonadMask m) + => Seconds + -> LockFile + -> (String -> m ()) + -> m LockHandle +waitLock timeout file displaymessage = makeLockHandle P.lockPool file -- LockShared for STM lock, because a pid lock can be the top-level -- lock with various other STM level locks gated behind it. (\p f -> P.waitTakeLock p f LockShared) - (\f -> mk <$> F.waitLock timeout f) + (\f -> mk <$> F.waitLock timeout f displaymessage) -- Tries to take a pid lock, but does not block. tryLock :: LockFile -> IO (Maybe LockHandle) diff --git a/doc/bugs/get_is_stuck_unless_a_clone_was_previously_explicitly___34__annex_init__34__ed/comment_7_21dbdbf7e4e889dc7c2475a0b9d4c5d7._comment b/doc/bugs/get_is_stuck_unless_a_clone_was_previously_explicitly___34__annex_init__34__ed/comment_7_21dbdbf7e4e889dc7c2475a0b9d4c5d7._comment new file mode 100644 index 0000000000..940137d96d --- /dev/null +++ b/doc/bugs/get_is_stuck_unless_a_clone_was_previously_explicitly___34__annex_init__34__ed/comment_7_21dbdbf7e4e889dc7c2475a0b9d4c5d7._comment @@ -0,0 +1,7 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 7""" + date="2020-08-26T17:02:26Z" + content=""" +Added that message after the first second waiting on a pid lock. +"""]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 752d36964a..175fe12d77 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -1186,14 +1186,15 @@ Like other git commands, git-annex is configured via `.git/config`. the other node is holding a pid lock. Caveat emptor. * `annex.pidlocktimeout` + + git-annex will wait up to this many seconds for the pid lock + file to go away, and will then abort if it cannot continue. Default: 300 When using pid lock files, it's possible for a stale lock file to get left behind by previous run of git-annex that crashed or was interrupted. This is mostly avoided, but can occur especially when using a network - file system. - - git-annex will wait up to this many seconds for the pid lock - file to go away, and will then abort if it cannot continue. Default: 300 + file system. This timeout prevents git-annex waiting forever in such a + situation. * `annex.cachecreds`