add gitAnnexChildProcess and use instead of incorrect use of runsGitAnnexChildProcess
Fixes reversion in 8.20200617 that made annex.pidlock being enabled result in some commands stalling, particularly those needing to autoinit. Renamed runsGitAnnexChildProcess to make clearer where it should be used. Arguably, it would be better to have a way to make any process git-annex runs have the env var set. But then it would need to take the pid lock when running any and all processes, and that would be a problem when git-annex runs two processes concurrently. So, I'm left doing it ad-hoc in places where git-annex really does run a child process, directly or indirectly via a particular git command.
This commit is contained in:
parent
6b0532e532
commit
7bdb0cdc0d
9 changed files with 97 additions and 33 deletions
|
@ -1,4 +1,4 @@
|
|||
{- Temporarily changing the files git uses.
|
||||
{- Temporarily changing how git-annex runs git commands.
|
||||
-
|
||||
- Copyright 2014-2020 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
|
@ -135,7 +135,8 @@ withAltRepo modrepo unmodrepo a = do
|
|||
}
|
||||
either E.throw return v
|
||||
|
||||
{- Wrap around actions that may run a git-annex child process.
|
||||
{- Wrap around actions that may run a git-annex child process via a git
|
||||
- command.
|
||||
-
|
||||
- When pid locking is in use, this tries to take the pid lock, and if
|
||||
- successful, holds it while running the child process. The action
|
||||
|
@ -147,10 +148,13 @@ withAltRepo modrepo unmodrepo a = do
|
|||
- the child. The child is assumed to not do any locking that conflicts
|
||||
- with the parent, but if it did happen to do that, it would be noticed
|
||||
- when git-annex is used without pid locking.
|
||||
-
|
||||
- When git-annex runs its child process directly, gitAnnexChildProcess is
|
||||
- used instead of this.
|
||||
-}
|
||||
runsGitAnnexChildProcess :: Annex a -> Annex a
|
||||
runsGitAnnexChildProcessViaGit :: Annex a -> Annex a
|
||||
#ifndef mingw32_HOST_OS
|
||||
runsGitAnnexChildProcess a = pidLockFile >>= \case
|
||||
runsGitAnnexChildProcessViaGit a = pidLockFile >>= \case
|
||||
Nothing -> a
|
||||
Just pidlock -> bracket (setup pidlock) cleanup (go pidlock)
|
||||
where
|
||||
|
@ -163,7 +167,7 @@ runsGitAnnexChildProcess a = pidLockFile >>= \case
|
|||
go pidlock (Just _h) = do
|
||||
v <- liftIO $ PidF.pidLockEnv pidlock
|
||||
let addenv g = do
|
||||
g' <- liftIO $ addGitEnv g v "1"
|
||||
g' <- liftIO $ addGitEnv g v PidF.pidLockEnvValue
|
||||
return (g', ())
|
||||
let rmenv oldg g
|
||||
| any (\(k, _) -> k == v) (fromMaybe [] (Git.gitEnv oldg)) = g
|
||||
|
@ -174,12 +178,12 @@ runsGitAnnexChildProcess a = pidLockFile >>= \case
|
|||
in g { Git.gitEnv = e' }
|
||||
withAltRepo addenv rmenv (const a)
|
||||
#else
|
||||
runsGitAnnexChildProcess a = a
|
||||
runsGitAnnexChildProcessViaGit a = a
|
||||
#endif
|
||||
|
||||
runsGitAnnexChildProcess' :: Git.Repo -> (Git.Repo -> IO a) -> Annex a
|
||||
runsGitAnnexChildProcessViaGit' :: Git.Repo -> (Git.Repo -> IO a) -> Annex a
|
||||
#ifndef mingw32_HOST_OS
|
||||
runsGitAnnexChildProcess' r a = pidLockFile >>= \case
|
||||
runsGitAnnexChildProcessViaGit' r a = pidLockFile >>= \case
|
||||
Nothing -> liftIO $ a r
|
||||
Just pidlock -> liftIO $ bracket (setup pidlock) cleanup (go pidlock)
|
||||
where
|
||||
|
@ -191,8 +195,8 @@ runsGitAnnexChildProcess' r a = pidLockFile >>= \case
|
|||
go _ Nothing = a r
|
||||
go pidlock (Just _h) = do
|
||||
v <- PidF.pidLockEnv pidlock
|
||||
r' <- addGitEnv r v "1"
|
||||
r' <- addGitEnv r v PidF.pidLockEnvValue
|
||||
a r'
|
||||
#else
|
||||
runsGitAnnexChildProcess' r a = liftIO $ a r
|
||||
runsGitAnnexChildProcessViaGit' r a = liftIO $ a r
|
||||
#endif
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue