fileRef: make paths relative and simplified

Fix behavior of several commands, including reinject, addurl, and rmurl
when given an absolute path to an unlocked file, or a relative path that
leaves and re-enters the repository.

To avoid slowing down all the cases where the paths are already ok
with an unncessary call to getCurrentDirectory, put in an optimisation
in relPathCwdToFile. That will probably also speed up other parts of
git-annex by some small amount, but I have not benchmarked.

Note that I did not convert branchFileRef, because it seems likely that
it will be used with a file that is not provided by the user, so is already
in a sane format. This is certainly true for the way git-annex uses it,
though maybe arguable to the extent Git.Ref is a reusable library.

Annex/CatFile.hs

@@ -178,11 +178,11 @@ catSymLinkTarget sha = fromInternalGitPath . L.toStrict <$> get
 catKeyFile :: RawFilePath -> Annex (Maybe Key)
 catKeyFile f = ifM (Annex.getState Annex.daemon)
 	( catKeyFileHEAD f
-	, catKey $ Git.Ref.fileRef f
+	, catKey =<< liftIO (Git.Ref.fileRef f)
 	)
 
 catKeyFileHEAD :: RawFilePath -> Annex (Maybe Key)
-catKeyFileHEAD f = catKey $ Git.Ref.fileFromRef Git.Ref.headRef f
+catKeyFileHEAD f = catKey =<< liftIO (Git.Ref.fileFromRef Git.Ref.headRef f)
 
 {- Look in the original branch from whence an adjusted branch is based
  - to find the file. But only when the adjustment hides some files. -}
@@ -194,5 +194,6 @@ catObjectMetaDataHidden = hiddenCat catObjectMetaData
 
 hiddenCat :: (Ref -> Annex (Maybe a)) -> RawFilePath -> CurrBranch -> Annex (Maybe a)
 hiddenCat a f (Just origbranch, Just adj)
-	| adjustmentHidesFiles adj = a (Git.Ref.fileFromRef origbranch f)
+	| adjustmentHidesFiles adj = 
+		a =<< liftIO (Git.Ref.fileFromRef origbranch f)
 hiddenCat _ _ _ = return Nothing

CHANGELOG

@@ -5,6 +5,9 @@ git-annex (8.20210429) UNRELEASED; urgency=medium
   * smudge: Fix a case where an unlocked annexed file that annex.largefiles
     does not match could get its unchanged content checked into git,
     due to git running the smudge filter unecessarily.
+  * Fix behavior of several commands, including reinject, addurl, and rmurl
+    when given an absolute path to an unlocked file, or a relative path
+    that leaves and re-enters the repository.
 
  -- Joey Hess <id@joeyh.name>  Mon, 03 May 2021 10:33:10 -0400
 

Command/Smudge.hs

@@ -103,7 +103,7 @@ clean file = do
 				getMoveRaceRecovery k file
 				liftIO $ L.hPut stdout b
 		Nothing -> do
-			let fileref = Git.Ref.fileRef file
+			fileref <- liftIO $ Git.Ref.fileRef file
 			indexmeta <- catObjectMetaData fileref
 			oldkey <- case indexmeta of
 				Just (_, sz, _) -> catKey' fileref sz

Git/Ref.hs

@@ -64,12 +64,17 @@ branchRef = underBase "refs/heads"
 
 {- A Ref that can be used to refer to a file in the repository, as staged
  - in the index.
- -
- - Prefixing the file with ./ makes this work even if in a subdirectory
- - of a repo.
  -}
-fileRef :: RawFilePath -> Ref
-fileRef f = Ref $ ":./" <> toInternalGitPath f
+fileRef :: RawFilePath -> IO Ref
+fileRef f = do
+	-- The filename could be absolute, or contain eg "../repo/file",
+	-- neither of which work in a ref, so convert it to a minimal
+	-- relative path.
+	f' <- relPathCwdToFile f
+ 	-- Prefixing the file with ./ makes this work even when in a
+	-- subdirectory of a repo. Eg, ./foo in directory bar refers
+	-- to bar/foo, not to foo in the top of the repository.
+	return $ Ref $ ":./" <> toInternalGitPath f'
 
 {- A Ref that can be used to refer to a file in a particular branch. -}
 branchFileRef :: Branch -> RawFilePath -> Ref
@@ -81,8 +86,10 @@ dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS' d
 
 {- A Ref that can be used to refer to a file in the repository as it
  - appears in a given Ref. -}
-fileFromRef :: Ref -> RawFilePath -> Ref
-fileFromRef r f = let (Ref fr) = fileRef f in Ref (fromRef' r <> fr)
+fileFromRef :: Ref -> RawFilePath -> IO Ref
+fileFromRef r f = do
+	(Ref fr) <- fileRef f
+	return (Ref (fromRef' r <> fr))
 
 {- Checks if a ref exists. Note that it must be fully qualified,
  - eg refs/heads/master rather than master. -}

Utility/Path/AbsRel.hs

@@ -1,6 +1,6 @@
 {- absolute and relative path manipulation
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -19,6 +19,7 @@ module Utility.Path.AbsRel (
 ) where
 
 import System.FilePath.ByteString
+import qualified Data.ByteString as B
 #ifdef mingw32_HOST_OS
 import System.Directory (getCurrentDirectory)
 #else
@@ -72,13 +73,17 @@ absPath file
  -    relPathCwdToFile "../bar/baz" == "baz"
  -}
 relPathCwdToFile :: RawFilePath -> IO RawFilePath
-relPathCwdToFile f = do
+relPathCwdToFile f
+	-- Optimisation: Avoid doing any IO when the path is relative
+	-- and does not contain any ".." component.
+	| isRelative f && not (".." `B.isInfixOf` f) = return f
+	| otherwise = do
 #ifdef mingw32_HOST_OS
-	c <- toRawFilePath <$> getCurrentDirectory
+		c <- toRawFilePath <$> getCurrentDirectory
 #else
-	c <- getWorkingDirectory
+		c <- getWorkingDirectory
 #endif
-	relPathDirToFile c f
+		relPathDirToFile c f
 
 {- Constructs a minimal relative path from a directory to a file. -}
 relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath