fixup annex link target calculation when submodules are used in filesystems not supporting symlinks

Annex/Fixup.hs

@@ -60,12 +60,13 @@ fixupDirect r = return r
  - submodule is mounted.
  -
  - When the filesystem doesn't support symlinks, we cannot make .git
- - into a symlink. In this case, we merely adjust the Repo so that
+ - into a symlink. But we don't need too, since the repo will use direct
+ - mode, In this case, we merely adjust the Repo so that
  - symlinks to objects that get checked in will be in the right form.
  -}
 fixupSubmodule :: Repo -> GitConfig -> IO Repo
 fixupSubmodule r@(Repo { location = l@(Local { worktree = Just w, gitdir = d }) }) c
-	| (".git" </> "modules") `isInfixOf` d = do
+	| needsSubmoduleFixup r = do
 		when (coreSymlinks c) $
 			replacedotgit
 				`catchNonAsync` \_e -> hPutStrLn stderr
@@ -84,3 +85,8 @@ fixupSubmodule r@(Repo { location = l@(Local { worktree = Just w, gitdir = d })
 		maybe (error "unset core.worktree failed") (\_ -> return ())
 			=<< Git.Config.unset "core.worktree" r
 fixupSubmodule r _ = return r
+
+needsSubmoduleFixup :: Repo -> Bool
+needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) =
+	(".git" </> "modules") `isInfixOf` d
+needsSubmoduleFixup _ = False

Locations.hs

@@ -79,6 +79,7 @@ import Types.Difference
 import qualified Git
 import Git.FilePath
 import Annex.DirHashes
+import Annex.Fixup
 
 {- Conventions:
  -
@@ -126,9 +127,9 @@ annexLocation config key hasher = objectDir </> keyPath key (hasher $ objectHash
  - the actual location of the file's content.
  -}
 gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO FilePath
-gitAnnexLocation key r config = gitAnnexLocation' key r config (annexCrippledFileSystem config) doesFileExist
-gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> (FilePath -> IO Bool) -> IO FilePath
-gitAnnexLocation' key r config crippled checker
+gitAnnexLocation key r config = gitAnnexLocation' key r config (annexCrippledFileSystem config) doesFileExist (Git.localGitDir r)
+gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> (FilePath -> IO Bool) -> FilePath -> IO FilePath
+gitAnnexLocation' key r config crippled checker gitdir
 	{- Bare repositories default to hashDirLower for new
 	 - content, as it's more portable.
 	 -
@@ -147,18 +148,27 @@ gitAnnexLocation' key r config crippled checker
 	 - present. -}
 	| otherwise = return $ inrepo $ annexLocation config key hashDirMixed
   where
-	inrepo d = Git.localGitDir r </> d
+	inrepo d = gitdir </> d
 	check locs@(l:_) = fromMaybe l <$> firstM checker locs
 	check [] = error "internal"
 
-{- Calculates a symlink to link a file to an annexed object. -}
+{- Calculates a symlink target to link a file to an annexed object. -}
 gitAnnexLink :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath
 gitAnnexLink file key r config = do
 	currdir <- getCurrentDirectory
 	let absfile = fromMaybe whoops $ absNormPathUnix currdir file
-	loc <- gitAnnexLocation' key r config False (\_ -> return True)
+	let gitdir = getgitdir currdir
+	loc <- gitAnnexLocation' key r config False (\_ -> return True) gitdir
 	toInternalGitPath <$> relPathDirToFile (parentDir absfile) loc
   where
+	getgitdir currdir
+		{- This special case is for git submodules on filesystems not
+		 - supporting symlinks; generate link target that will
+		 - work portably. -}
+		| coreSymlinks config == False && needsSubmoduleFixup r =
+			fromMaybe whoops $ absNormPathUnix currdir $
+				Git.repoPath r </> ".git"
+		| otherwise = Git.localGitDir r
 	whoops = error $ "unable to normalize " ++ file
 
 {- File used to lock a key's content. -}

doc/submodules.mdwn

@@ -5,7 +5,9 @@ Git normally makes a `.git` **file** in a
 submodule, that points to the real git repository under `.git/modules/`.
 This presents problems for git-annex. So, when used in a submodule,
 git-annex will automatically replace the `.git` file with a symlink
-pointing at the git repository.
+pointing at the git repository. (When the filesystem doesn't support
+symlinks, direct mode is used, and submodules are supported in that
+setup too.)
 
 With that taken care of, git-annex should work ok in submodules. Although
 this is a new and somewhat experimental feature.
@@ -18,4 +20,3 @@ Known problems:
   will refuse to delete it, complaining that the
   submodule "uses a .git directory". Workaround: Use `rm -rf`
   to delete the tree, and then `git commit`.
-* This won't work on filesystems not supporting symlinks.