avoid making absolute git remote path relative

When a git remote is configured with an absolute path, use that path,
rather than making it relative. If it's configured with a relative path,
use that.

Git.Construct.fromPath changed to preserve the path as-is,
rather than making it absolute. And Annex.new changed to not
convert the path to relative. Instead, Git.CurrentRepo.get
generates a relative path.

A few things that used fromAbsPath unncessarily were changed in passing to
use fromPath instead. I'm seeing fromAbsPath as a security check,
while before it was being used in some cases when the path was
known absolute already. It may be that fromAbsPath is not really needed,
but only git-annex-shell uses it now, and I'm not 100% sure that there's
not some input that would cause a relative path to be used, opening a
security hole, without the security check. So left it as-is.

Test suite passes and strace shows the configured remote url is used
unchanged in the path into it. I can't be 100% sure there's not some code
somewhere that takes an absolute path to the repo and converts it to
relative and uses it, but it seems pretty unlikely that the code paths used
for a git remote would call such code. One place I know of is gitAnnexLink,
but I'm pretty sure that git remotes never deal with annex symlinks. If
that did get called, it generates a path relative to cwd, which would have
been wrong before this change as well, when operating on a remote.

Annex.hs

@@ -247,7 +247,7 @@ newState c r = do
  - any necessary git repo fixups. -}
 new :: Git.Repo -> IO AnnexState
 new r = do
-	r' <- Git.Config.read =<< Git.relPath r
+	r' <- Git.Config.read r
 	let c = extractGitConfig FromGitConfig r'
 	newState c =<< fixupRepo r' c
 

CHANGELOG

@@ -20,6 +20,8 @@ git-annex (8.20210128) UNRELEASED; urgency=medium
     transfer progress consistently enough.
   * When annex.stalldetection is not enabled and a likely stall is
     detected, display a suggestion to enable it.
+  * When a git remote is configured with an absolute path, use that
+    path, rather than making it relative.
 
  -- Joey Hess <id@joeyh.name>  Thu, 28 Jan 2021 12:34:32 -0400
 

Command/Map.hs

@@ -178,7 +178,7 @@ absRepo reference r
 	| Git.repoIsUrl reference = return $ Git.Construct.localToUrl reference r
 	| Git.repoIsUrl r = return r
 	| otherwise = liftIO $ do
-		r' <- Git.Construct.fromAbsPath =<< absPath (Git.repoPath r)
+		r' <- Git.Construct.fromPath =<< absPath (Git.repoPath r)
 		r'' <- safely $ flip Annex.eval Annex.gitRepo =<< Annex.new r'
 		return (fromMaybe r' r'')
 

Git/Construct.hs

@@ -57,35 +57,34 @@ fromCwd = getCurrentDirectory >>= seekUp
 
 {- Local Repo constructor, accepts a relative or absolute path. -}
 fromPath :: RawFilePath -> IO Repo
-fromPath dir = fromAbsPath =<< absPath dir
+fromPath dir
+	-- When dir == "foo/.git", git looks for "foo/.git/.git",
+	-- and failing that, uses "foo" as the repository.
+	| (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =
+		ifM (doesDirectoryExist $ fromRawFilePath dir </> ".git")
+			( ret dir
+			, ret (P.takeDirectory canondir)
+			)
+	| otherwise = ifM (doesDirectoryExist (fromRawFilePath dir))
+		( 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
+		, if dir == canondir
+			then ret (dir <> ".git")
+			else ret dir
+		)
+  where
+	ret = pure . newFrom . LocalUnknown
+	canondir = P.dropTrailingPathSeparator dir
 
 {- Local Repo constructor, requires an absolute path to the repo be
  - specified. -}
 fromAbsPath :: RawFilePath -> IO Repo
 fromAbsPath dir
-	| absoluteGitPath dir = hunt
+	| absoluteGitPath dir = fromPath dir
 	| otherwise =
 		error $ "internal error, " ++ show dir ++ " is not absolute"
-  where
-	ret = pure . newFrom . LocalUnknown
-	canondir = P.dropTrailingPathSeparator dir
-	{- When dir == "foo/.git", git looks for "foo/.git/.git",
-	 - and failing that, uses "foo" as the repository. -}
-	hunt
-		| (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =
-			ifM (doesDirectoryExist $ fromRawFilePath dir </> ".git")
-				( ret dir
-				, ret (P.takeDirectory canondir)
-				)
-		| otherwise = ifM (doesDirectoryExist (fromRawFilePath dir))
-			( 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
-			, if dir == canondir
-				then ret (dir <> ".git")
-				else ret dir
-			)
 
 {- Construct a Repo for a remote's url.
  -

Git/CurrentRepo.hs

@@ -10,6 +10,7 @@
 module Git.CurrentRepo where
 
 import Common
+import Git
 import Git.Types
 import Git.Construct
 import qualified Git.Config
@@ -46,12 +47,12 @@ get = do
 	wt <- maybe (worktree (location r)) Just
 		<$> getpathenvprefix "GIT_WORK_TREE" prefix
 	case wt of
-		Nothing -> return r
+		Nothing -> relPath r
 		Just d -> do
 			curr <- R.getCurrentDirectory
 			unless (d `dirContains` curr) $
 				setCurrentDirectory (fromRawFilePath d)
-			return $ addworktree wt r
+			relPath $ addworktree wt r
   where
 	getpathenv s = do
 		v <- getEnv s

Git/Repair.hs

@@ -105,7 +105,7 @@ retrieveMissingObjects missing referencerepo r
 	| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do
 		unlessM (boolSystem "git" [Param "init", File tmpdir]) $
 			error $ "failed to create temp repository in " ++ tmpdir
-		tmpr <- Config.read =<< Construct.fromAbsPath (toRawFilePath tmpdir)
+		tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)
 		rs <- Construct.fromRemotes r
 		stillmissing <- pullremotes tmpr rs fetchrefstags missing
 		if S.null (knownMissing stillmissing)

Remote/Bup.hs

@@ -287,11 +287,11 @@ bup2GitRemote :: BupRepo -> IO Git.Repo
 bup2GitRemote "" = do
 	-- bup -r "" operates on ~/.bup
 	h <- myHomeDir
-	Git.Construct.fromAbsPath $ toRawFilePath $ h </> ".bup"
+	Git.Construct.fromPath $ toRawFilePath $ h </> ".bup"
 bup2GitRemote r
 	| bupLocal r = 
 		if "/" `isPrefixOf` r
-			then Git.Construct.fromAbsPath (toRawFilePath r)
+			then Git.Construct.fromPath (toRawFilePath r)
 			else giveup "please specify an absolute path"
 	| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
   where

doc/bugs/git-annex_get__58___createDirectory__58___does_not_exist.mdwn

@@ -29,3 +29,7 @@ git-annex is critical infrastructure for me. There is no day without it. Thx muc
 
 
 [[!tag projects/datalad]]
+
+> So there's an OSX bug here, and git-annex has been made to use
+> an absolute path to a remote when it has one, which can be used to work
+> around the OSX bug. [[done]] --[[Joey]]

doc/bugs/git-annex_get__58___createDirectory__58___does_not_exist/comment_7_2899ef72aa2a5488eb945d14f7a2d76e._comment

@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2021-02-08T15:54:58Z"
+ content="""
+Agreed, what you show in the stackoverflow post can only be an OSX bug.
+
+Using a relative path for the current repository does avoid using long
+absolute paths, and also has a minor benefit of letting the repository be
+moved while git-annex is running and it still accessing the right files.
+
+Neither benefit applies to the paths to remotes. I think the only
+reason relative paths are being used for them is that the same code
+is used to operate on them as on the local repository.
+
+I've made some changes that will make it use absolute paths when the
+remote has an absolute path.
+"""]]