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

View file

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

View file

@ -11,6 +11,7 @@ import Annex.Common
import Config.Files import Config.Files
import Utility.Env import Utility.Env
import Annex.PidLock import Annex.PidLock
import qualified Annex
import System.Environment (getExecutablePath) import System.Environment (getExecutablePath)
@ -55,10 +56,14 @@ cannotFindProgram = do
- to avoid it deadlocking. - to avoid it deadlocking.
-} -}
gitAnnexChildProcess gitAnnexChildProcess
:: [String] :: String
-> [String]
-> (CreateProcess -> CreateProcess) -> (CreateProcess -> CreateProcess)
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> Annex a -> Annex a
gitAnnexChildProcess ps f a = do gitAnnexChildProcess subcmd ps f a = do
cmd <- liftIO programPath 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 - This is like pidLockChildProcess, but rather than running a process
- itself, it runs the action with a modified Annex state that passes the - 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 runsGitAnnexChildProcessViaGit :: Annex a -> Annex a
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS

View file

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

View file

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