43f19ef00a
Eg: git clone url --bare r git --git-dir r annex init This resulted in worktree = Just "." and so several things that check worktree to determine when the repo is bare ran code paths intended for non-bare. One such code path[1] ran git checkout with --worktree=. which actually makes it ignore core.bare config, and so the current directory got populated with a checkout of the master branch in this example. There was probably also other breakage. The fix is a bit complicated because whether the repo is bare is not known until after Git.Config reads the config, but Git.Config handles setting the RepoLocations's worktree when core.worktree is set. So have to assume the worktree is the cwd, let core.worktree override that, and then if the repo turns out to be bare, it's set back to Nothing. (And then GIT_WORK_TREE can still override all of that.) [1] switchHEADBack, which runs even when the clone is not from a bare repo.
80 lines
2.3 KiB
Haskell
80 lines
2.3 KiB
Haskell
{- The current git repository.
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Git.CurrentRepo where
|
|
|
|
import Common
|
|
import Git.Types
|
|
import Git.Construct
|
|
import qualified Git.Config
|
|
import Utility.Env
|
|
import Utility.Env.Set
|
|
|
|
{- 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 -> return r
|
|
Just d -> do
|
|
curr <- getCurrentDirectory
|
|
unless (d `dirContains` curr) $
|
|
setCurrentDirectory d
|
|
return $ addworktree wt r
|
|
where
|
|
getpathenv s = do
|
|
v <- getEnv s
|
|
case v of
|
|
Just d -> do
|
|
unsetEnv s
|
|
return (Just d)
|
|
Nothing -> return Nothing
|
|
|
|
getpathenvprefix s (Just prefix) | not (null prefix) =
|
|
getpathenv s >>= \case
|
|
Nothing -> return Nothing
|
|
Just d
|
|
| d == "." -> return (Just d)
|
|
| otherwise -> Just <$> absPath (prefix </> d)
|
|
getpathenvprefix s _ = getpathenv s
|
|
|
|
configure Nothing (Just r) = Git.Config.read r
|
|
configure (Just d) _ = do
|
|
absd <- absPath d
|
|
curr <- getCurrentDirectory
|
|
r <- Git.Config.read $ newFrom $
|
|
Local { gitdir = absd, worktree = Just curr }
|
|
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 }
|