Additional GIT_DIR support bugfixes. May actually work now.

Two fixes. First, and most importantly, relax the isLinkToAnnex check
to only look for /annex/objects/, not [^|/].git/annex/objects. If
GIT_DIR is used with a detached work tree, the git directory is
not necessarily named .git.

There are important caveats with doing that at all, since git-annex will
make symlinks that point at GIT_DIR, which means that the relative path
between GIT_DIR and GIT_WORK_TREE needs to remain stable across all clones
of the repository.

----

The other fix is just fixing crazy and wrong code that, when GIT_DIR is
set, expects to still find a git repository in the path below the work
tree, and uses some of its configuration, and some of GIT_DIR. What was I
thinking, and why can't I seem to get this code right?

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 :: IO (Maybe Repo)
-fromCwd = getCurrentDirectory >>= seekUp checkForRepo
+fromCwd = getCurrentDirectory >>= seekUp
   where
-	norepo = error "Not in a git repository."
+	seekUp dir = do
-	seekUp check dir = do
+		r <- checkForRepo dir
-		r <- check dir
 		case r of
 			Nothing -> case parentDir dir of
-				"" -> norepo
+				"" -> return Nothing
-				d -> seekUp check d
+				d -> seekUp d
-			Just loc -> newFrom loc
+			Just loc -> Just <$> newFrom loc
 
 {- Local Repo constructor, accepts a relative or absolute path. -}
 fromPath :: FilePath -> IO Repo

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
+	configure Nothing (Just r) = Git.Config.read r
-		r' <- Git.Config.read r
+	configure (Just d) _ = do
-		-- Let GIT_DIR override the default gitdir.
 		absd <- absPath d
-		return $ changelocation r' $ Local
+		cwd <- getCurrentDirectory
-			{ gitdir = absd
+		r <- newFrom $ Local { gitdir = absd, worktree = Just cwd }
-			, worktree = worktree (location r')
+		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 }

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
+isLinkToAnnex s = ('/':objectDir) `isInfixOf` s
-  where
-	d = ".git" </> objectDir
 
 {- Converts a key into a filename fragment without any directory.
  -

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 <joeyh@debian.org>  Sun, 17 Feb 2013 16:42:16 -0400