Propigate GIT_DIR and GIT_WORK_TREE environment to external special remotes.

Since git-annex unsets these when started, they have to be explicitly
propigated. Also, this makes --git-dir and --work-tree settings be
reflected in the environment.

The need for this came up in
https://github.com/DanielDent/git-annex-remote-rclone/issues/3

Git.hs

@@ -26,6 +26,7 @@ module Git (
 	repoDescribe,
 	repoLocation,
 	repoPath,
+	repoWorkTree,
 	localGitDir,
 	attributes,
 	attributesLocal,
@@ -73,6 +74,10 @@ repoPath Repo { location = Local { gitdir = d } } = d
 repoPath Repo { location = LocalUnknown dir } = dir
 repoPath Repo { location = Unknown } = error "unknown repoPath"
 
+repoWorkTree :: Repo -> Maybe FilePath
+repoWorkTree Repo { location = Local { worktree = Just d } } = Just d
+repoWorkTree _ = Nothing
+
 {- Path to a local repository's .git directory. -}
 localGitDir :: Repo -> FilePath
 localGitDir Repo { location = Local { gitdir = d } } = d

Git/Env.hs

@@ -9,12 +9,10 @@
 
 module Git.Env where
 
+import Common
 import Git
 import Git.Types
 import Utility.Env
-#ifdef __ANDROID__
-import Common
-#endif
 
 {- Adjusts the gitEnv of a Repo. Copies the system environment if the repo
  - does not have any gitEnv yet. -}
@@ -41,6 +39,16 @@ adjustGitEnv g adj = do
 addGitEnv :: Repo -> String -> String -> IO Repo
 addGitEnv g var val = adjustGitEnv g (addEntry var val)
 
+{- Environment variables to use when running a command.
+ - Includes GIT_DIR pointing at the repo, and GIT_WORK_TREE when the repo
+ - is not bare. Also includes anything added to the Repo's gitEnv,
+ - and a copy of the rest of the system environment. -}
+propGitEnv :: Repo -> IO [(String, String)]
+propGitEnv g = do
+	g' <- addGitEnv g "GIT_DIR" (localGitDir g)
+	g'' <- maybe (pure g') (addGitEnv g' "GIT_WORK_TREE") (repoWorkTree g)
+	return $ fromMaybe [] (gitEnv g'')
+
 {- Use with any action that makes a commit to set metadata. -}
 commitWithMetaData :: CommitMetaData -> CommitMetaData -> (Repo -> IO a) -> Repo -> IO a
 commitWithMetaData authormetadata committermetadata a g =

Remote/External.hs

@@ -16,6 +16,7 @@ import Types.UrlContents
 import qualified Git
 import Config
 import Git.Config (isTrue, boolConfig)
+import Git.Env
 import Remote.Helper.Special
 import Remote.Helper.ReadOnly
 import Remote.Helper.Messages
@@ -369,7 +370,9 @@ fromExternal lck external extractor a =
 startExternal :: ExternalType -> Annex ExternalState
 startExternal externaltype = do
 	errrelayer <- mkStderrRelayer
+	g <- Annex.gitRepo
 	liftIO $ do
+		p <- propgit g cmdp
 		(Just hin, Just hout, Just herr, pid) <- 
 			createProcess p `catchIO` runerr
 		fileEncoding hin
@@ -387,11 +390,14 @@ startExternal externaltype = do
 			}
   where
 	cmd = externalRemoteProgram externaltype
-	p = (proc cmd [])
+	cmdp = (proc cmd [])
 		{ std_in = CreatePipe
 		, std_out = CreatePipe
 		, std_err = CreatePipe
 		}
+	propgit g p = do
+		environ <- propGitEnv g
+		return $ p { env = Just environ }
 
 	runerr _ = error ("Cannot run " ++ cmd ++ " -- Make sure it's in your PATH and is executable.")
 

debian/changelog

@@ -17,6 +17,8 @@ git-annex (6.20160420) UNRELEASED; urgency=medium
   * map: Changed colors; red is used for untrusted repositories and grey
     for dead.
   * version: Display OS version and architecture too.
+  * Propigate GIT_DIR and GIT_WORK_TREE environment to external special
+    remotes.
 
  -- Joey Hess <id@joeyh.name>  Thu, 28 Apr 2016 13:17:04 -0400