mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

deal with .git pointer file in Git.CurrentRepo

Browse source 
This fixes the bug.

Note, it's only done when GIT_DIR is set. When it's not set,
Git.Construct already handled it. This is why it was only noticed with this
git submodule command.

This commit was sponsored by Brett Eisenberg on Patreon.
This commit is contained in:
Joey Hess 2020-10-23 14:56:12 -04:00
parent 893d7b21e8
commit 681313dfd4
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 38 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

39
Git/Construct.hs
View file

@ -21,6 +21,7 @@ module Git.Construct (
repoAbsPath,
checkForRepo,
newFrom,
adjustGitDirFile,
) where
#ifndef mingw32_HOST_OS
@ -73,7 +74,7 @@ fromAbsPath dir
, ret (takeDirectory canondir)
)
| otherwise = ifM (doesDirectoryExist dir)
( gitDirFile dir >>= maybe (ret dir) (pure . newFrom)
( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom)
-- git falls back to dir.git when dir doesn't
-- exist, as long as dir didn't end with a
-- path separator
@ -198,7 +199,7 @@ expandTilde = expandt True
checkForRepo :: FilePath -> IO (Maybe RepoLocation)
checkForRepo dir =
check isRepo $
check (gitDirFile dir) $
check (checkGitDirFile dir) $
check isBareRepo $
return Nothing
where
@ -219,24 +220,36 @@ checkForRepo dir =
<&&> doesDirectoryExist (dir </> "objects")
gitSignature file = doesFileExist $ dir </> file
-- Check for a .git file.
checkGitDirFile :: FilePath -> IO (Maybe RepoLocation)
checkGitDirFile dir = adjustGitDirFile' $ Local
{ gitdir = toRawFilePath (dir </> ".git")
, worktree = Just (toRawFilePath dir)
}
-- git-submodule, git-worktree, and --separate-git-dir
-- make .git be a file pointing to the real git directory.
-- Detect that, and return a RepoLocation with gitdir pointing
-- to the real git directory.
gitDirFile :: FilePath -> IO (Maybe RepoLocation)
gitDirFile dir = do
c <- firstLine <$>
catchDefaultIO "" (readFile $ dir </> ".git")
return $ if gitdirprefix `isPrefixOf` c
then Just $ Local
{ gitdir = toRawFilePath $ absPathFrom dir $
drop (length gitdirprefix) c
, worktree = Just (toRawFilePath dir)
}
else Nothing
adjustGitDirFile :: RepoLocation -> IO RepoLocation
adjustGitDirFile loc = fromMaybe loc <$> adjustGitDirFile' loc
adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation)
adjustGitDirFile' loc = do
let gd = fromRawFilePath (gitdir loc)
c <- firstLine <$> catchDefaultIO "" (readFile gd)
if gitdirprefix `isPrefixOf` c
then do
top <- takeDirectory <$> absPath gd
return $ Just $ loc
{ gitdir = toRawFilePath $ absPathFrom top $
drop (length gitdirprefix) c
}
else return Nothing
where
gitdirprefix = "gitdir: "
newFrom :: RepoLocation -> Repo
newFrom l = Repo
{ location = l