diff options
| -rw-r--r-- | Git.hs | 5 | ||||
| -rw-r--r-- | Git/Env.hs | 14 | ||||
| -rw-r--r-- | Remote/External.hs | 8 | ||||
| -rw-r--r-- | debian/changelog | 2 |
4 files changed, 25 insertions, 4 deletions
@@ -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 diff --git a/Git/Env.hs b/Git/Env.hs index b0070e9a1..f41f3ad0e 100644 --- a/Git/Env.hs +++ b/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 = diff --git a/Remote/External.hs b/Remote/External.hs index 69c47a6e4..54db82d1f 100644 --- a/Remote/External.hs +++ b/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.") diff --git a/debian/changelog b/debian/changelog index a00632ce0..2856be2be 100644 --- a/debian/changelog +++ b/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 |