pass along -c options to child git-annex processes
authorJoey Hess <joeyh@joeyh.name>
Tue, 15 Dec 2020 14:44:36 +0000 (10:44 -0400)
committerJoey Hess <joeyh@joeyh.name>
Tue, 15 Dec 2020 14:49:29 +0000 (10:49 -0400)
Annex.hs
Annex/Init.hs
Annex/Path.hs
Annex/PidLock.hs
Command/Sync.hs
Upgrade.hs

index b38468ebd027a5a9a917041e8911d68ca783049e..32686cf27461851790ce6143194827f66e7fe6b5 100644 (file)
--- a/Annex.hs
+++ b/Annex.hs
@@ -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
index 3078a6213fcdefb680b169fda53051f19cc71b20..18ff042464784d7d66ae0987370421f6b99182ce 100644 (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
index 8708467ffc48d2f1c9cfc34a6e01a15101bc380e..f9bce267f899ae79a2f170fbe1a3c59b0b9e8080 100644 (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
index 43c43cc92be2611cd0f61a72d36a55ce2671329e..a7267f8182d234f416f1f1fceac2a56ac1700937 100644 (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
index fb37a087e5d9250da0913a23f3e3d54d7e1d0d20..1f1afc9c13a471713b59a8ccfc70e070dab41f2b 100644 (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
index 5f447fe85da6ad29dc5af034796ec5abc68a29d0..f497217ebf7e4945a8d97c6fb28e592673175a7c 100644 (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 })