diff --git a/Git/Construct.hs b/Git/Construct.hs index bafb168748..f9f4b464a9 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -17,6 +17,7 @@ module Git.Construct ( fromRemotes, fromRemoteLocation, repoAbsPath, + newFrom, ) where import System.Posix.User @@ -31,17 +32,16 @@ import Utility.UserInfo {- Finds the git repository used for the cwd, which may be in a parent - directory. -} -fromCwd :: IO Repo -fromCwd = getCurrentDirectory >>= seekUp checkForRepo +fromCwd :: IO (Maybe Repo) +fromCwd = getCurrentDirectory >>= seekUp where - norepo = error "Not in a git repository." - seekUp check dir = do - r <- check dir + seekUp dir = do + r <- checkForRepo dir case r of Nothing -> case parentDir dir of - "" -> norepo - d -> seekUp check d - Just loc -> newFrom loc + "" -> return Nothing + d -> seekUp d + Just loc -> Just <$> newFrom loc {- Local Repo constructor, accepts a relative or absolute path. -} fromPath :: FilePath -> IO Repo diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs index e309bf2f62..482873960a 100644 --- a/Git/CurrentRepo.hs +++ b/Git/CurrentRepo.hs @@ -47,15 +47,15 @@ get = do unsetEnv s Just <$> absPath d Nothing -> return Nothing - configure Nothing r = Git.Config.read r - configure (Just d) r = do - r' <- Git.Config.read r - -- Let GIT_DIR override the default gitdir. + + configure Nothing (Just r) = Git.Config.read r + configure (Just d) _ = do absd <- absPath d - return $ changelocation r' $ Local - { gitdir = absd - , worktree = worktree (location r') - } + cwd <- getCurrentDirectory + r <- newFrom $ Local { gitdir = absd, worktree = Just cwd } + Git.Config.read r + configure Nothing Nothing = error "Not in a git repository." + addworktree w r = changelocation r $ Local { gitdir = gitdir (location r), worktree = w } changelocation r l = r { location = l } diff --git a/Locations.hs b/Locations.hs index fcf516bdcf..9f892a8f3c 100644 --- a/Locations.hs +++ b/Locations.hs @@ -236,11 +236,14 @@ gitAnnexRemotesDir r = addTrailingPathSeparator $ gitAnnexDir r "remotes" gitAnnexAssistantDefaultDir :: FilePath gitAnnexAssistantDefaultDir = "annex" -{- Checks a symlink target to see if it appears to point to annexed content. -} +{- Checks a symlink target to see if it appears to point to annexed content. + - + - We only look at paths inside the .git directory, and not at the .git + - directory itself, because GIT_DIR may cause a directory name other + - than .git to be used. + -} isLinkToAnnex :: FilePath -> Bool -isLinkToAnnex s = ('/':d) `isInfixOf` s || d `isPrefixOf` s - where - d = ".git" objectDir +isLinkToAnnex s = ('/':objectDir) `isInfixOf` s {- Converts a key into a filename fragment without any directory. - diff --git a/debian/changelog b/debian/changelog index 55460a99e0..d3e7a05441 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,7 @@ git-annex (3.20130217) UNRELEASED; urgency=low each time they are mounted. * Direct mode: Fix support for adding a modified file. * Avoid passing -p to rsync, to interoperate with crippled filesystems. + * Additional GIT_DIR support bugfixes. May actually work now. -- Joey Hess Sun, 17 Feb 2013 16:42:16 -0400