git style filename quoting controlled by core.quotePath

This is by no means complete, but escaping filenames in actionItemDesc does
cover most commands.

Note that for ActionItemBranchFilePath, the value is branch:file, and I
choose to only quote the file part (if necessary). I considered quoting the
whole thing. But, branch names cannot contain control characters, and while
they can contain unicode, git coes not quote unicode when displaying branch
names. So, it would be surprising for git-annex to quote unicode in a
branch name.

The find command is the most obvious command that still needs to be
dealt with. There are probably other places that filenames also get
displayed, eg embedded in error messages.

Some other commands use ActionItemOther with a filename, I think that
ActionItemOther should either be pre-sanitized, or should explicitly not
be used for filenames, so that needs more work.

When --json is used, unicode does not get escaped, but control
characters were already escaped in json.

(Key escaping may turn out to be needed, but I'm ignoring that for now.)

Sponsored-by: unqueued on Patreon

Assistant/Threads/TransferWatcher.hs

@@ -15,6 +15,7 @@ import Logs.Transfer
 import Utility.DirWatcher
 import Utility.DirWatcher.Types
 import qualified Remote
+import qualified Annex
 import Annex.Perms
 
 import Control.Concurrent
@@ -62,7 +63,8 @@ onAdd file = case parseTransferFile file of
   where
 	go _ Nothing = noop -- transfer already finished
 	go t (Just info) = do
-		debug [ "transfer starting:", describeTransfer t info ]
+		qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
+		debug [ "transfer starting:", describeTransfer qp t info ]
 		r <- liftAnnex $ Remote.remoteFromUUID $ transferUUID t
 		updateTransferInfo t info { transferRemote = r }
 

Assistant/TransferQueue.hs

@@ -31,6 +31,7 @@ import Logs.Transfer
 import Types.Remote
 import qualified Remote
 import qualified Types.Remote as Remote
+import qualified Annex
 import Annex.Wanted
 import Utility.TList
 
@@ -139,7 +140,8 @@ enqueue reason schedule t info
 	| otherwise = go snocTList
   where
 	go modlist = whenM (add modlist) $ do
-		debug [ "queued", describeTransfer t info, ": " ++ reason ]
+		qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
+		debug [ "queued", describeTransfer qp t info, ": " ++ reason ]
 		notifyTransfer
 	add modlist = do
 		q <- getAssistant transferQueue

Assistant/TransferSlots.hs

@@ -123,14 +123,16 @@ genTransfer t info = case transferRemote info of
 			return Nothing
 		, ifM (liftAnnex $ shouldTransfer t info)
 			( do
-				debug [ "Transferring:" , describeTransfer t info ]
+				qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
+				debug [ "Transferring:" , describeTransfer qp t info ]
 				notifyTransfer
 				let sd = remoteAnnexStallDetection
 					(Remote.gitconfig remote)
 				return $ Just (t, info, go remote sd)
 			, do
+				qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
 				debug [ "Skipping unnecessary transfer:",
-					describeTransfer t info ]
+					describeTransfer qp t info ]
 				void $ removeTransfer t
 				finishedTransfer t (Just info)
 				return Nothing
@@ -241,9 +243,11 @@ finishedTransfer t (Just info)
 				Later (transferKey t) (associatedFile info) Upload
 	| otherwise = dodrops True
   where
-	dodrops fromhere = handleDrops
-		("drop wanted after " ++ describeTransfer t info)
-		fromhere (transferKey t) (associatedFile info) []
+	dodrops fromhere = do
+		qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
+		handleDrops
+			("drop wanted after " ++ describeTransfer qp t info)
+			fromhere (transferKey t) (associatedFile info) []
 finishedTransfer _ _ = noop
 
 {- Pause a running transfer. -}

CHANGELOG

@@ -1,3 +1,12 @@
+git-annex (10.20230408) UNRELEASED; urgency=medium
+
+  * Many commands now display filenames that contain unusual characters the
+    same way that git does, to avoid exposing control characters to the terminal.
+  * Support core.quotePath, which can be set to false to display utf8
+    characters as-is in filenames.
+
+ -- Joey Hess <id@joeyh.name>  Sat, 08 Apr 2023 13:57:18 -0400
+
 git-annex (10.20230407) upstream; urgency=medium
 
   * Fix laziness bug introduced in last release that breaks use

Command/Fsck.hs

@@ -167,7 +167,8 @@ performRemote key afile backend numcopies remote =
 			Nothing -> go True Nothing
 			Just (Right verification) -> go True (Just (tmpfile, verification))
 			Just (Left _) -> do
-				warning (decodeBS (actionItemDesc ai) ++ ": failed to download file from remote")
+				qp <- coreQuotePath <$> Annex.getGitConfig
+				warning (decodeBS (actionItemDesc qp ai) ++ ": failed to download file from remote")
 				void $ go True Nothing
 				return False
 	dispatch (Right False) = go False Nothing
@@ -350,9 +351,10 @@ verifyLocationLog' key ai present u updatestatus = do
 			return True
 		(False, True) -> do
 			fix InfoMissing
+			qp <- coreQuotePath <$> Annex.getGitConfig
 			warning $
 				"** Based on the location log, " ++
-				decodeBS (actionItemDesc ai) ++
+				decodeBS (actionItemDesc qp ai) ++
 				"\n** was expected to be present, " ++
 				"but its content is missing."
 			return False
@@ -389,10 +391,11 @@ verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = case afile of
 		if null missinglocs
 			then return True
 			else do
+				qp <- coreQuotePath <$> Annex.getGitConfig
 				missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs
 				warning $
 					"** Required content " ++
-					decodeBS (actionItemDesc ai) ++
+					decodeBS (actionItemDesc qp ai) ++
 					" is missing from these repositories:\n" ++
 					missingrequired
 				return False
@@ -465,8 +468,9 @@ checkKeySizeOr bad key file ai = case fromKey keySize key of
 		return same
 	badsize a b = do
 		msg <- bad key
+		qp <- coreQuotePath <$> Annex.getGitConfig
 		warning $ concat
-			[ decodeBS (actionItemDesc ai)
+			[ decodeBS (actionItemDesc qp ai)
 			, ": Bad file size ("
 			, compareSizes storageUnits True a b
 			, "); "
@@ -483,8 +487,9 @@ checkKeyUpgrade :: Backend -> Key -> ActionItem -> AssociatedFile -> Annex Bool
 checkKeyUpgrade backend key ai (AssociatedFile (Just file)) =
 	case Types.Backend.canUpgradeKey backend of
 		Just a | a key -> do
+			qp <- coreQuotePath <$> Annex.getGitConfig
 			warning $ concat
-				[ decodeBS (actionItemDesc ai)
+				[ decodeBS (actionItemDesc qp ai)
 				, ": Can be upgraded to an improved key format. "
 				, "You can do so by running: git annex migrate --backend="
 				, decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " "
@@ -534,8 +539,9 @@ checkBackendOr bad backend key file ai =
 			ok <- verifier key file
 			unless ok $ do
 				msg <- bad key
+				qp <- coreQuotePath <$> Annex.getGitConfig
 				warning $ concat
-					[ decodeBS (actionItemDesc ai)
+					[ decodeBS (actionItemDesc qp ai)
 					, ": Bad file content; "
 					, msg
 					]
@@ -562,8 +568,9 @@ checkInodeCache key content mic ai = case mic of
 				withTSDelta (liftIO . genInodeCache content) >>= \case
 					Nothing -> noop
 					Just ic' -> whenM (compareInodeCaches ic ic') $ do
+						qp <- coreQuotePath <$> Annex.getGitConfig
 						warning $ concat
-							[ decodeBS (actionItemDesc ai)
+							[ decodeBS (actionItemDesc qp ai)
 							, ": Stale or missing inode cache; updating."
 							]
 						Database.Keys.addInodeCaches key [ic]

Command/Info.hs

@@ -455,15 +455,16 @@ transfer_list = stat desc $ nojson $ lift $ do
 	uuidmap <- Remote.remoteMap id
 	ts <- getTransfers
 	maybeShowJSON $ JSONChunk [(desc, V.fromList $ map (uncurry jsonify) ts)]
+	qp <- coreQuotePath <$> Annex.getGitConfig
 	return $ if null ts
 		then "none"
 		else multiLine $
-			map (uncurry $ line uuidmap) $ sort ts
+			map (uncurry $ line qp uuidmap) $ sort ts
   where
 	desc = "transfers in progress"
-	line uuidmap t i = unwords
+	line qp uuidmap t i = unwords
 		[ fromRawFilePath (formatDirection (transferDirection t)) ++ "ing"
-		, fromRawFilePath $ actionItemDesc $ mkActionItem
+		, fromRawFilePath $ actionItemDesc qp $ mkActionItem
 			(transferKey t, associatedFile i)
 		, if transferDirection t == Upload then "to" else "from"
 		, maybe (fromUUID $ transferUUID t) Remote.name $

Git/FilePath.hs

@@ -30,6 +30,7 @@ module Git.FilePath (
 
 import Common
 import Git
+import qualified Git.Filename as Filename
 
 import qualified System.FilePath.ByteString as P
 import qualified System.FilePath.Posix.ByteString
@@ -48,9 +49,9 @@ data BranchFilePath = BranchFilePath Ref TopFilePath
 	deriving (Show, Eq, Ord)
 
 {- Git uses the branch:file form to refer to a BranchFilePath -}
-descBranchFilePath :: BranchFilePath -> S.ByteString
-descBranchFilePath (BranchFilePath b f) =
-	fromRef' b <> ":" <> getTopFilePath f
+descBranchFilePath :: Filename.QuotePath -> BranchFilePath -> S.ByteString
+descBranchFilePath qp (BranchFilePath b f) =
+	fromRef' b <> ":" <> Filename.encode qp (getTopFilePath f)
 
 {- Path to a TopFilePath, within the provided git repo. -}
 fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath

Logs/Transfer.hs

@@ -14,6 +14,7 @@ import Types.Transfer
 import Types.ActionItem
 import Annex.Common
 import qualified Git
+import qualified Git.Filename
 import Utility.Metered
 import Utility.Percentage
 import Utility.PID
@@ -31,11 +32,11 @@ import Control.Concurrent.STM
 import qualified Data.ByteString.Char8 as B8
 import qualified System.FilePath.ByteString as P
 
-describeTransfer :: Transfer -> TransferInfo -> String
-describeTransfer t info = unwords
+describeTransfer :: Git.Filename.QuotePath -> Transfer -> TransferInfo -> String
+describeTransfer qp t info = unwords
 	[ show $ transferDirection t
 	, show $ transferUUID t
-	, decodeBS $ actionItemDesc $ ActionItemAssociatedFile
+	, decodeBS $ actionItemDesc qp $ ActionItemAssociatedFile
 		(associatedFile info)
 		(transferKey t)
 	, show $ bytesComplete info

Messages.hs

@@ -1,6 +1,6 @@
 {- git-annex output messages
  -
- - Copyright 2010-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -62,7 +62,6 @@ import Types.Messages
 import Types.ActionItem
 import Types.Concurrency
 import Types.Command (StartMessage(..), SeekInput)
-import Types.Transfer (transferKey)
 import Messages.Internal
 import Messages.Concurrent
 import Annex.Debug
@@ -76,11 +75,13 @@ showStart command file si = outputMessage json $
   where
 	json = JSON.start command (Just file) Nothing si
 
-showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex ()
-showStartKey command key ai si = outputMessage json $
-	encodeBS command <> " " <> actionItemDesc ai <> " "
+showStartActionItem :: String -> ActionItem -> SeekInput -> Annex ()
+showStartActionItem command ai si = do
+	qp <- coreQuotePath <$> Annex.getGitConfig
+	outputMessage json $
+		encodeBS command <> " " <> actionItemDesc qp ai <> " "
   where
-	json = JSON.start command (actionItemFile ai) (Just key) si
+	json = JSON.start command (actionItemFile ai) (actionItemKey ai) si
 
 showStartOther :: String -> Maybe String -> SeekInput -> Annex ()
 showStartOther command mdesc si = outputMessage json $ encodeBS $
@@ -90,11 +91,11 @@ showStartOther command mdesc si = outputMessage json $ encodeBS $
 
 showStartMessage :: StartMessage -> Annex ()
 showStartMessage (StartMessage command ai si) = case ai of
-	ActionItemAssociatedFile _ k -> showStartKey command k ai si
-	ActionItemKey k -> showStartKey command k ai si
-	ActionItemBranchFilePath _ k -> showStartKey command k ai si
-	ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai si
-	ActionItemTreeFile file -> showStart command file si
+	ActionItemAssociatedFile _ _ -> showStartActionItem command ai si
+	ActionItemKey _ -> showStartActionItem command ai si
+	ActionItemBranchFilePath _ _ -> showStartActionItem command ai si
+	ActionItemFailedTransfer _ _ -> showStartActionItem command ai si
+	ActionItemTreeFile _ -> showStartActionItem command ai si
 	ActionItemOther msg -> showStartOther command msg si
 	OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
 showStartMessage (StartUsualMessages command ai si) = do
@@ -235,7 +236,7 @@ showFullJSON v = withMessageState $ bufferJSON (JSON.complete v)
 {- Performs an action that outputs nonstandard/customized output, and
  - in JSON mode wraps its output in JSON.start and JSON.end, so it's
  - a complete JSON document.
- - This is only needed when showStart and showEndOk is not used.
+ - This is only needed when showStart* and showEndOk is not used.
  -}
 showCustom :: String -> SeekInput -> Annex Bool -> Annex ()
 showCustom command si a = do

Types/ActionItem.hs

@@ -1,6 +1,6 @@
 {- items that a command can act on
  -
- - Copyright 2016-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -12,6 +12,7 @@ module Types.ActionItem where
 import Key
 import Types.Transfer
 import Git.FilePath
+import qualified Git.Filename
 import Utility.FileSystemEncoding
 
 import Data.Maybe
@@ -56,17 +57,18 @@ instance MkActionItem (BranchFilePath, Key) where
 instance MkActionItem (Transfer, TransferInfo) where
 	mkActionItem = uncurry ActionItemFailedTransfer
 
-actionItemDesc :: ActionItem -> S.ByteString
-actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f)) _) = f
-actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing) k) = 
+actionItemDesc :: Git.Filename.QuotePath -> ActionItem -> S.ByteString
+actionItemDesc qp (ActionItemAssociatedFile (AssociatedFile (Just f)) _) = 
+	Git.Filename.encode qp f
+actionItemDesc _ (ActionItemAssociatedFile (AssociatedFile Nothing) k) = 
 	serializeKey' k
-actionItemDesc (ActionItemKey k) = serializeKey' k
-actionItemDesc (ActionItemBranchFilePath bfp _) = descBranchFilePath bfp
-actionItemDesc (ActionItemFailedTransfer t i) = actionItemDesc $
+actionItemDesc _ (ActionItemKey k) = serializeKey' k
+actionItemDesc qp (ActionItemBranchFilePath bfp _) = descBranchFilePath qp bfp
+actionItemDesc qp (ActionItemFailedTransfer t i) = actionItemDesc qp $
 	ActionItemAssociatedFile (associatedFile i) (transferKey t)
-actionItemDesc (ActionItemTreeFile f) = f
-actionItemDesc (ActionItemOther s) = encodeBS (fromMaybe "" s)
-actionItemDesc (OnlyActionOn _ ai) = actionItemDesc ai
+actionItemDesc qp (ActionItemTreeFile f) = Git.Filename.encode qp f
+actionItemDesc _ (ActionItemOther s) = encodeBS (fromMaybe "" s)
+actionItemDesc qp (OnlyActionOn _ ai) = actionItemDesc qp ai
 
 actionItemKey :: ActionItem -> Maybe Key
 actionItemKey (ActionItemAssociatedFile _ k) = Just k

Types/GitConfig.hs

@@ -32,6 +32,7 @@ import Git.Types
 import Git.ConfigTypes
 import Git.Remote (isRemoteKey, remoteKeyToRemoteName)
 import Git.Branch (CommitMode(..))
+import Git.Filename (QuotePath(..))
 import Utility.DataUnits
 import Config.Cost
 import Types.UUID
@@ -140,6 +141,7 @@ data GitConfig = GitConfig
 	, annexSupportUnlocked :: Bool
 	, coreSymlinks :: Bool
 	, coreSharedRepository :: SharedRepository
+	, coreQuotePath :: QuotePath
 	, receiveDenyCurrentBranch :: DenyCurrentBranch
 	, gcryptId :: Maybe String
 	, gpgCmd :: GpgCmd
@@ -250,6 +252,7 @@ extractGitConfig configsource r = GitConfig
 	, annexSupportUnlocked = getbool (annexConfig "supportunlocked") True
 	, coreSymlinks = getbool "core.symlinks" True
 	, coreSharedRepository = getSharedRepository r
+	, coreQuotePath = QuotePath (getbool "core.quotepath" True)
 	, receiveDenyCurrentBranch = getDenyCurrentBranch r
 	, gcryptId = getmaybe "core.gcrypt-id"
 	, gpgCmd = mkGpgCmd (getmaybe "gpg.program")