3a66cd715f
When a git remote is configured with an absolute path, use that path, rather than making it relative. If it's configured with a relative path, use that. Git.Construct.fromPath changed to preserve the path as-is, rather than making it absolute. And Annex.new changed to not convert the path to relative. Instead, Git.CurrentRepo.get generates a relative path. A few things that used fromAbsPath unncessarily were changed in passing to use fromPath instead. I'm seeing fromAbsPath as a security check, while before it was being used in some cases when the path was known absolute already. It may be that fromAbsPath is not really needed, but only git-annex-shell uses it now, and I'm not 100% sure that there's not some input that would cause a relative path to be used, opening a security hole, without the security check. So left it as-is. Test suite passes and strace shows the configured remote url is used unchanged in the path into it. I can't be 100% sure there's not some code somewhere that takes an absolute path to the repo and converts it to relative and uses it, but it seems pretty unlikely that the code paths used for a git remote would call such code. One place I know of is gitAnnexLink, but I'm pretty sure that git remotes never deal with annex symlinks. If that did get called, it generates a path relative to cwd, which would have been wrong before this change as well, when operating on a remote.
93 lines
2.6 KiB
Haskell
93 lines
2.6 KiB
Haskell
{- The current git repository.
|
|
-
|
|
- Copyright 2012-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Git.CurrentRepo where
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Types
|
|
import Git.Construct
|
|
import qualified Git.Config
|
|
import Utility.Env
|
|
import Utility.Env.Set
|
|
import qualified Utility.RawFilePath as R
|
|
|
|
import qualified Data.ByteString as B
|
|
import qualified System.FilePath.ByteString as P
|
|
|
|
{- Gets the current git repository.
|
|
-
|
|
- Honors GIT_DIR and GIT_WORK_TREE.
|
|
- Both environment variables are unset, to avoid confusing other git
|
|
- commands that also look at them. Instead, the Git module passes
|
|
- --work-tree and --git-dir to git commands it runs.
|
|
-
|
|
- When GIT_WORK_TREE or core.worktree are set, changes the working
|
|
- directory if necessary to ensure it is within the repository's work
|
|
- tree. While not needed for git commands, this is useful for anything
|
|
- else that looks for files in the worktree.
|
|
-
|
|
- Also works around a git bug when running some hooks. It
|
|
- runs the hooks in the top of the repository, but if GIT_WORK_TREE
|
|
- was relative (but not "."), it then points to the wrong directory.
|
|
- In this situation GIT_PREFIX contains the directory that
|
|
- GIT_WORK_TREE is relative to.
|
|
-}
|
|
get :: IO Repo
|
|
get = do
|
|
gd <- getpathenv "GIT_DIR"
|
|
r <- configure gd =<< fromCwd
|
|
prefix <- getpathenv "GIT_PREFIX"
|
|
wt <- maybe (worktree (location r)) Just
|
|
<$> getpathenvprefix "GIT_WORK_TREE" prefix
|
|
case wt of
|
|
Nothing -> relPath r
|
|
Just d -> do
|
|
curr <- R.getCurrentDirectory
|
|
unless (d `dirContains` curr) $
|
|
setCurrentDirectory (fromRawFilePath d)
|
|
relPath $ addworktree wt r
|
|
where
|
|
getpathenv s = do
|
|
v <- getEnv s
|
|
case v of
|
|
Just d -> do
|
|
unsetEnv s
|
|
return (Just (toRawFilePath d))
|
|
Nothing -> return Nothing
|
|
|
|
getpathenvprefix s (Just prefix) | not (B.null prefix) =
|
|
getpathenv s >>= \case
|
|
Nothing -> return Nothing
|
|
Just d
|
|
| d == "." -> return (Just d)
|
|
| otherwise -> Just
|
|
<$> absPath (prefix P.</> d)
|
|
getpathenvprefix s _ = getpathenv s
|
|
|
|
configure Nothing (Just r) = Git.Config.read r
|
|
configure (Just d) _ = do
|
|
absd <- absPath d
|
|
curr <- R.getCurrentDirectory
|
|
loc <- adjustGitDirFile $ Local
|
|
{ gitdir = absd
|
|
, worktree = Just curr
|
|
}
|
|
r <- Git.Config.read $ newFrom loc
|
|
return $ if Git.Config.isBare r
|
|
then r { location = (location r) { worktree = Nothing } }
|
|
else r
|
|
configure Nothing Nothing = giveup "Not in a git repository."
|
|
|
|
addworktree w r = changelocation r $ Local
|
|
{ gitdir = gitdir (location r)
|
|
, worktree = w
|
|
}
|
|
|
|
changelocation r l = r { location = l }
|