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
This commit is contained in:
Joey Hess 2023-04-08 14:20:02 -04:00
parent 81bc57322f
commit d689a5b338
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
11 changed files with 78 additions and 45 deletions

View file

@ -15,6 +15,7 @@ import Logs.Transfer
import Utility.DirWatcher import Utility.DirWatcher
import Utility.DirWatcher.Types import Utility.DirWatcher.Types
import qualified Remote import qualified Remote
import qualified Annex
import Annex.Perms import Annex.Perms
import Control.Concurrent import Control.Concurrent
@ -62,7 +63,8 @@ onAdd file = case parseTransferFile file of
where where
go _ Nothing = noop -- transfer already finished go _ Nothing = noop -- transfer already finished
go t (Just info) = do 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 r <- liftAnnex $ Remote.remoteFromUUID $ transferUUID t
updateTransferInfo t info { transferRemote = r } updateTransferInfo t info { transferRemote = r }

View file

@ -31,6 +31,7 @@ import Logs.Transfer
import Types.Remote import Types.Remote
import qualified Remote import qualified Remote
import qualified Types.Remote as Remote import qualified Types.Remote as Remote
import qualified Annex
import Annex.Wanted import Annex.Wanted
import Utility.TList import Utility.TList
@ -139,7 +140,8 @@ enqueue reason schedule t info
| otherwise = go snocTList | otherwise = go snocTList
where where
go modlist = whenM (add modlist) $ do 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 notifyTransfer
add modlist = do add modlist = do
q <- getAssistant transferQueue q <- getAssistant transferQueue

View file

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

View file

@ -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 git-annex (10.20230407) upstream; urgency=medium
* Fix laziness bug introduced in last release that breaks use * Fix laziness bug introduced in last release that breaks use

View file

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

View file

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

View file

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

View file

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

View file

@ -1,6 +1,6 @@
{- git-annex output messages {- 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. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -62,7 +62,6 @@ import Types.Messages
import Types.ActionItem import Types.ActionItem
import Types.Concurrency import Types.Concurrency
import Types.Command (StartMessage(..), SeekInput) import Types.Command (StartMessage(..), SeekInput)
import Types.Transfer (transferKey)
import Messages.Internal import Messages.Internal
import Messages.Concurrent import Messages.Concurrent
import Annex.Debug import Annex.Debug
@ -76,11 +75,13 @@ showStart command file si = outputMessage json $
where where
json = JSON.start command (Just file) Nothing si json = JSON.start command (Just file) Nothing si
showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex () showStartActionItem :: String -> ActionItem -> SeekInput -> Annex ()
showStartKey command key ai si = outputMessage json $ showStartActionItem command ai si = do
encodeBS command <> " " <> actionItemDesc ai <> " " qp <- coreQuotePath <$> Annex.getGitConfig
outputMessage json $
encodeBS command <> " " <> actionItemDesc qp ai <> " "
where 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 :: String -> Maybe String -> SeekInput -> Annex ()
showStartOther command mdesc si = outputMessage json $ encodeBS $ showStartOther command mdesc si = outputMessage json $ encodeBS $
@ -90,11 +91,11 @@ showStartOther command mdesc si = outputMessage json $ encodeBS $
showStartMessage :: StartMessage -> Annex () showStartMessage :: StartMessage -> Annex ()
showStartMessage (StartMessage command ai si) = case ai of showStartMessage (StartMessage command ai si) = case ai of
ActionItemAssociatedFile _ k -> showStartKey command k ai si ActionItemAssociatedFile _ _ -> showStartActionItem command ai si
ActionItemKey k -> showStartKey command k ai si ActionItemKey _ -> showStartActionItem command ai si
ActionItemBranchFilePath _ k -> showStartKey command k ai si ActionItemBranchFilePath _ _ -> showStartActionItem command ai si
ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai si ActionItemFailedTransfer _ _ -> showStartActionItem command ai si
ActionItemTreeFile file -> showStart command file si ActionItemTreeFile _ -> showStartActionItem command ai si
ActionItemOther msg -> showStartOther command msg si ActionItemOther msg -> showStartOther command msg si
OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si) OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
showStartMessage (StartUsualMessages command ai si) = do 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 {- Performs an action that outputs nonstandard/customized output, and
- in JSON mode wraps its output in JSON.start and JSON.end, so it's - in JSON mode wraps its output in JSON.start and JSON.end, so it's
- a complete JSON document. - 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 :: String -> SeekInput -> Annex Bool -> Annex ()
showCustom command si a = do showCustom command si a = do

View file

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

View file

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