pass along -c options to child git-annex processes

This commit is contained in:
Joey Hess 2020-12-15 10:44:36 -04:00
parent 87de360e98
commit 00526a6739
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 27 additions and 16 deletions

View file

@ -32,6 +32,7 @@ module Annex (
changeGitRepo,
adjustGitRepo,
addGitConfigOverride,
getGitConfigOverrides,
getRemoteGitConfig,
withCurrentState,
changeDirectory,
@ -110,6 +111,7 @@ data AnnexState = AnnexState
, repoadjustment :: (Git.Repo -> IO Git.Repo)
, gitconfig :: GitConfig
, gitconfigadjustment :: (GitConfig -> GitConfig)
, gitconfigoverride :: [String]
, gitremotes :: Maybe [Git.Repo]
, backend :: Maybe (BackendA Annex)
, remotes :: [Types.Remote.RemoteA Annex]
@ -175,6 +177,7 @@ newState c r = do
, repoadjustment = return
, gitconfig = c
, gitconfigadjustment = id
, gitconfigoverride = []
, gitremotes = Nothing
, backend = Nothing
, remotes = []
@ -352,12 +355,14 @@ adjustGitRepo a = do
changeGitRepo =<< gitRepo
{- Adds git config setting, like "foo=bar". It will be passed with -c
- to git processes. The config setting is also recorded in the repo,
- to git processes. The config setting is also recorded in the Repo,
- and the GitConfig is updated. -}
addGitConfigOverride :: String -> Annex ()
addGitConfigOverride v = adjustGitRepo $ \r ->
Git.Config.store (encodeBS' v) Git.Config.ConfigList $
r { Git.gitGlobalOpts = go (Git.gitGlobalOpts r) }
addGitConfigOverride v = do
adjustGitRepo $ \r ->
Git.Config.store (encodeBS' v) Git.Config.ConfigList $
r { Git.gitGlobalOpts = go (Git.gitGlobalOpts r) }
changeState $ \s -> s { gitconfigoverride = v : gitconfigoverride s }
where
-- Remove any prior occurrance of the setting to avoid
-- building up many of them when the adjustment is run repeatedly,
@ -366,6 +371,10 @@ addGitConfigOverride v = adjustGitRepo $ \r ->
go (Param "-c": Param v':rest) | v' == v = go rest
go (c:rest) = c : go rest
{- Values that were passed to addGitConfigOverride. -}
getGitConfigOverrides :: Annex [String]
getGitConfigOverrides = reverse <$> getState gitconfigoverride
{- Changing the git Repo data also involves re-extracting its GitConfig. -}
changeGitRepo :: Git.Repo -> Annex ()
changeGitRepo r = do

View file

@ -383,10 +383,8 @@ fixupUnusualReposAfterInit = do
autoEnableSpecialRemotes :: Annex ()
autoEnableSpecialRemotes = do
rp <- fromRawFilePath <$> fromRepo Git.repoPath
withNullHandle $ \nullh -> gitAnnexChildProcess
[ "init"
, "--autoenable"
]
withNullHandle $ \nullh -> gitAnnexChildProcess "init"
[ "--autoenable" ]
(\p -> p
{ std_out = UseHandle nullh
, std_err = UseHandle nullh

View file

@ -11,6 +11,7 @@ import Annex.Common
import Config.Files
import Utility.Env
import Annex.PidLock
import qualified Annex
import System.Environment (getExecutablePath)
@ -55,10 +56,14 @@ cannotFindProgram = do
- to avoid it deadlocking.
-}
gitAnnexChildProcess
:: [String]
:: String
-> [String]
-> (CreateProcess -> CreateProcess)
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> Annex a
gitAnnexChildProcess ps f a = do
gitAnnexChildProcess subcmd ps f a = do
cmd <- liftIO programPath
pidLockChildProcess cmd ps f a
-- Pass along git config values that were set on command line
-- to the child process.
cps <- concatMap (\c -> ["-c", c]) <$> Annex.getGitConfigOverrides
pidLockChildProcess cmd (subcmd:cps++ps) f a

View file

@ -75,7 +75,7 @@ pidLockChildProcess cmd ps f a = do
-
- This is like pidLockChildProcess, but rather than running a process
- itself, it runs the action with a modified Annex state that passes the
- necessary env var.
- necessary env var when running git.
-}
runsGitAnnexChildProcessViaGit :: Annex a -> Annex a
#ifndef mingw32_HOST_OS

View file

@ -535,7 +535,7 @@ pushRemote o remote (Just branch, _) = do
postpushupdate repo = case Git.repoWorkTree repo of
Nothing -> return True
Just wt -> ifM needemulation
( gitAnnexChildProcess ["post-receive"]
( gitAnnexChildProcess "post-receive" []
(\cp -> cp { cwd = Just (fromRawFilePath wt) })
(\_ _ _ pid -> waitForProcess pid >>= return . \case
ExitSuccess -> True

View file

@ -103,9 +103,8 @@ upgrade automatic destversion = do
-- upgrading a git repo other than the current repo.
upgraderemote = do
rp <- fromRawFilePath <$> fromRepo Git.repoPath
gitAnnexChildProcess
[ "upgrade"
, "--quiet"
gitAnnexChildProcess "upgrade"
[ "--quiet"
, "--autoonly"
]
(\p -> p { cwd = Just rp })