git style quoting for ActionItemOther

Added StringContainingQuotedPath, which is used for ActionItemOther.

In the process, checked every ActionItemOther for those containing
filenames, and made them use quoting.

Sponsored-by: Graham Spencer on Patreon

Annex/Import.hs

@@ -503,7 +503,7 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
 			in return $ Left $ Just (loc, v)
 		[] -> do
 			job <- liftIO $ newEmptyTMVarIO
-			let ai = ActionItemOther (Just (fromRawFilePath (fromImportLocation loc)))
+			let ai = ActionItemOther (Just (QuotedPath (fromImportLocation loc)))
 			let si = SeekInput []
 			let importaction = starting ("import " ++ Remote.name remote) ai si $ do
 				when oldversion $

Command.hs

@@ -25,7 +25,7 @@ import qualified Git
 import Annex.Init
 import Utility.Daemon
 import Types.Transfer
-import Types.ActionItem
+import Types.ActionItem as ReExported
 import Types.WorkerPool as ReExported
 import Remote.List
 

Command/AddUrl.hs

@@ -402,7 +402,7 @@ startingAddUrl si url o p = starting "addurl" ai si $ do
 	-- available and get added to it. That's ok, this is only
 	-- used to prevent two threads running concurrently when that would
 	-- likely fail.
-	ai = OnlyActionOn urlkey (ActionItemOther (Just url))
+	ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url)))
 	urlkey = Backend.URL.fromUrl url Nothing
 
 showDestinationFile :: FilePath -> Annex ()

Command/Config.hs

@@ -61,7 +61,7 @@ seek (SetConfig ck@(ConfigKey name) val) = checkIsGlobalConfig ck $ commandActio
 			setConfig ck (fromConfigValue val)
 		next $ return True
   where
-	ai = ActionItemOther (Just (fromConfigValue val))
+	ai = ActionItemOther (Just (UnquotedString (fromConfigValue val)))
 	si = SeekInput [decodeBS name]
 seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $
 	startingUsualMessages (decodeBS name) ai si $ do

Command/Describe.hs

@@ -26,7 +26,7 @@ start (name:description) | not (null description) = do
 	starting "describe" ai si $
 		perform u $ unwords description
   where
-	ai = ActionItemOther (Just name)
+	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput [name]
 start _ = giveup "Specify a repository and a description."	
 

Command/EnableRemote.hs

@@ -71,7 +71,7 @@ startNormalRemote name restparams r
 	| otherwise = giveup $
 		"That is a normal git remote; passing these parameters does not make sense: " ++ unwords restparams
   where
-	ai = ActionItemOther (Just name)
+	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput [name]
 
 startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart
@@ -92,7 +92,7 @@ startSpecialRemote name config ((u, c, mcu):[]) =
 			=<< Remote.byUUID u
 		performSpecialRemote t u c fullconfig gc mcu
   where
-	ai = ActionItemOther (Just name)
+	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput [name]
 startSpecialRemote _ _ _ =
 	giveup "Multiple remotes have that name. Either use git-annex renameremote to rename them, or specify the uuid of the remote to enable."

Command/Expire.hs

@@ -79,7 +79,7 @@ start (Expire expire) noact actlog descs u =
 			return $ "last active: " ++ fromDuration d ++ " ago"
 		_  -> return "no activity"
 	desc = fromUUID u ++ " " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs))
-	ai = ActionItemOther (Just desc)
+	ai = ActionItemOther (Just (UnquotedString desc))
 	si = SeekInput []
 	notexpired ent = case ent of
 		Unknown -> False

Command/Export.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2017-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2017-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -413,13 +413,15 @@ startMoveToTempName r db f ek =
 	loc = mkExportLocation f'
 	f' = getTopFilePath f
 	tmploc = exportTempName ek
-	ai = ActionItemOther $ Just $ fromRawFilePath f' ++ " -> " ++ fromRawFilePath (fromExportLocation tmploc)
+	ai = ActionItemOther $ Just $ 
+		QuotedPath f' <> " -> " <> QuotedPath (fromExportLocation tmploc)
 	si = SeekInput []
 
 startMoveFromTempName :: Remote -> ExportHandle -> Key -> TopFilePath -> CommandStart
 startMoveFromTempName r db ek f = do
 	let tmploc = exportTempName ek
-	let ai = ActionItemOther (Just (fromRawFilePath (fromExportLocation tmploc) ++ " -> " ++ fromRawFilePath f'))
+	let ai = ActionItemOther $ Just $
+		QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f'
 	stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $
 		starting ("rename " ++ name r) ai si $
 			performRename r db ek tmploc loc

Command/Forget.hs

@@ -42,7 +42,7 @@ start o = starting "forget" ai si $ do
 		else basets
 	perform ts =<< Annex.getRead Annex.force
   where
-	ai = ActionItemOther (Just (fromRef Branch.name))
+	ai = ActionItemOther (Just (UnquotedString (fromRef Branch.name)))
 	si = SeekInput []
 
 perform :: Transitions -> Bool -> CommandPerform

Command/Fsck.hs

@@ -42,7 +42,6 @@ import qualified Database.Keys
 import qualified Database.Fsck as FsckDb
 import Types.CleanupActions
 import Types.Key
-import Types.ActionItem
 import qualified Utility.RawFilePath as R
 
 import Data.Time.Clock.POSIX

Command/Group.hs

@@ -27,7 +27,7 @@ start ps@(name:g:[]) = do
 	startingUsualMessages "group" ai si $
 		setGroup u (toGroup g)
   where
-	ai = ActionItemOther (Just name)
+	ai = ActionItemOther (Just (UnquotedString name))
 	si = SeekInput ps
 start (name:[]) = do
 	u <- Remote.nameToUUID name

Command/GroupWanted.hs

@@ -27,6 +27,6 @@ start (g:[]) = startingCustomOutput (ActionItemOther Nothing) $
 start ps@(g:expr:[]) = startingUsualMessages "groupwanted" ai si $
 	performSet groupPreferredContentSet expr (toGroup g)
   where
-	ai = ActionItemOther (Just g)
+	ai = ActionItemOther (Just (UnquotedString g))
 	si = SeekInput ps
 start _ = giveup "Specify a group."

Command/Import.hs

@@ -351,7 +351,7 @@ listContents remote importtreeconfig ci tvar = starting "list" ai si $
 		liftIO $ atomically $ writeTVar tvar importable
 		next $ return True
   where
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 
 listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, Remote.ByteSize)) -> Annex a) -> Annex a
@@ -373,7 +373,7 @@ commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig
 		importcommit <- buildImportCommit remote importtreeconfig importcommitconfig importable
 		next $ updateremotetrackingbranch importcommit
   where
-	ai = ActionItemOther (Just $ fromRef $ fromRemoteTrackingBranch tb)
+	ai = ActionItemOther (Just $ UnquotedString $ fromRef $ fromRemoteTrackingBranch tb)
 	si = SeekInput []
 	-- Update the tracking branch. Done even when there
 	-- is nothing new to import, to make sure it exists.

Command/Info.hs

@@ -43,7 +43,6 @@ import Logs.Transfer
 import Types.Key
 import Types.TrustLevel
 import Types.FileMatcher
-import Types.ActionItem
 import qualified Limit
 import Messages.JSON (DualDisp(..), ObjectMap(..))
 import Annex.BloomFilter

Command/Init.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.Init where
 
 import Command
@@ -62,7 +64,7 @@ start os
 		starting "init" (ActionItemOther (Just "autoenable")) si $
 			performAutoEnableOnly
 	| otherwise = 
-		starting "init" (ActionItemOther (Just $ initDesc os)) si $
+		starting "init" (ActionItemOther (Just $ UnquotedString $ initDesc os)) si $
 			perform os
   where
 	si = SeekInput []

Command/InitRemote.hs

@@ -81,7 +81,7 @@ start o (name:ws) = ifM (not . null <$> findExisting name)
 			if whatElse o
 				then startingCustomOutput (ActionItemOther Nothing) $
 					describeOtherParamsFor c t
-				else starting "initremote" (ActionItemOther (Just name)) si $
+				else starting "initremote" (ActionItemOther (Just (UnquotedString name))) si $
 					perform t name c o
 		)
 	)

Command/Merge.hs

@@ -48,7 +48,7 @@ mergeAnnexBranch = starting "merge" ai si $ do
 	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	next $ return True
   where
-	ai = ActionItemOther (Just (fromRef Annex.Branch.name))
+	ai = ActionItemOther (Just (UnquotedString (fromRef Annex.Branch.name)))
 	si = SeekInput []
 
 mergeSyncedBranch :: MergeOptions -> CommandStart
@@ -63,5 +63,5 @@ mergeBranch o r = starting "merge" ai si $ do
 	let so = def { notOnlyAnnexOption = True }
 	next $ merge currbranch mc so Git.Branch.ManualCommit r
   where
-	ai = ActionItemOther (Just (Git.fromRef r))
+	ai = ActionItemOther (Just (UnquotedString (Git.fromRef r)))
 	si = SeekInput []

Command/MinCopies.hs

@@ -35,5 +35,5 @@ startSet n = startingUsualMessages "mincopies" ai si $ do
 	setGlobalMinCopies $ configuredMinCopies n
 	next $ return True
   where
-	ai = ActionItemOther (Just $ show n)
+	ai = ActionItemOther (Just $ UnquotedString $ show n)
 	si = SeekInput [show n]

Command/NumCopies.hs

@@ -49,5 +49,5 @@ startSet n = startingUsualMessages "numcopies" ai si $ do
 	setGlobalNumCopies $ configuredNumCopies n
 	next $ return True
   where
-	ai = ActionItemOther (Just $ show n)
+	ai = ActionItemOther (Just $ UnquotedString $ show n)
 	si = SeekInput [show n]

Command/P2P.hs

@@ -101,7 +101,7 @@ linkRemote :: RemoteName -> CommandStart
 linkRemote remotename = starting "p2p link" ai si $
 	next promptaddr
   where
-	ai = ActionItemOther (Just remotename)
+	ai = ActionItemOther (Just (UnquotedString remotename))
 	si = SeekInput []
 	promptaddr = do
 		liftIO $ putStrLn ""
@@ -131,7 +131,7 @@ startPairing remotename addrs = ifM (liftIO Wormhole.isInstalled)
 	, giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/"
 	)
   where
-	ai = ActionItemOther (Just remotename)
+	ai = ActionItemOther (Just (UnquotedString remotename))
 	si = SeekInput []
 
 performPairing :: RemoteName -> [P2PAddress] -> CommandPerform

Command/RegisterUrl.hs

@@ -63,7 +63,7 @@ start' a o (si, (key, url)) =
 	starting "registerurl" ai si $
 		perform a o key url
   where
-	ai = ActionItemOther (Just url)
+	ai = ActionItemOther (Just (UnquotedString url))
 
 perform :: (Remote -> Key -> URLString -> Annex ()) -> RegisterUrlOptions -> Key -> URLString -> CommandPerform
 perform a o key url = do

Command/Reinit.hs

@@ -24,9 +24,10 @@ seek :: CmdParams -> CommandSeek
 seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
-start ws = starting "reinit" (ActionItemOther (Just s)) (SeekInput ws) $
+start ws = starting "reinit" ai (SeekInput ws) $
 	perform s
   where
+	ai = ActionItemOther (Just (UnquotedString s))
 	s = unwords ws
 
 perform :: String -> CommandPerform

Command/Reinject.hs

@@ -56,7 +56,7 @@ startSrcDest ps@(src:dest:[])
 			( perform src' key
 			, giveup $ src ++ " does not have expected content of " ++ dest
 			)
-	ai = ActionItemOther (Just src)
+	ai = ActionItemOther (Just (QuotedPath src'))
 	si = SeekInput ps
 startSrcDest _ = giveup "specify a src file and a dest file"
 
@@ -73,7 +73,7 @@ startKnown src = notAnnexed src' $
   where
 	src' = toRawFilePath src
 	ks = KeySource src' src' Nothing
-	ai = ActionItemOther (Just src)
+	ai = ActionItemOther (Just (QuotedPath src'))
 	si = SeekInput [src]
 
 notAnnexed :: RawFilePath -> CommandStart -> CommandStart

Command/Schedule.hs

@@ -31,7 +31,7 @@ start = parse
 			performGet u
 	parse ps@(name:expr:[]) = do
 		u <- Remote.nameToUUID name
-		let ai = ActionItemOther (Just name)
+		let ai = ActionItemOther (Just (UnquotedString name))
 		let si = SeekInput ps
 		startingUsualMessages "schedule" ai si $
 			performSet expr u

Command/SetKey.hs

@@ -21,10 +21,11 @@ seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
 start ps@(keyname:file:[]) = starting "setkey" ai si $
-	perform (toRawFilePath file) (keyOpt keyname)
+	perform file' (keyOpt keyname)
   where
-	ai = ActionItemOther (Just file)
+	ai = ActionItemOther (Just (QuotedPath file'))
 	si = SeekInput ps
+	file' = toRawFilePath file
 start _ = giveup "specify a key and a content file"
 
 keyOpt :: String -> Key

Command/Sync.hs

@@ -392,7 +392,7 @@ mergeLocal' mergeconfig o currbranch@(Just branch, _) =
 	needMerge currbranch branch >>= \case
 		Nothing -> stop
 		Just syncbranch -> do
-			let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
+			let ai = ActionItemOther (Just $ UnquotedString $ Git.Ref.describe syncbranch)
 			let si = SeekInput []
 			starting "merge" ai si $
 				next $ merge currbranch mergeconfig o Git.Branch.ManualCommit syncbranch
@@ -400,7 +400,7 @@ mergeLocal' _ _ currbranch@(Nothing, _) = inRepo Git.Branch.currentUnsafe >>= \c
 	Just branch -> needMerge currbranch branch >>= \case
 		Nothing -> stop
 		Just syncbranch -> do
-			let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
+			let ai = ActionItemOther (Just $ UnquotedString $ Git.Ref.describe syncbranch)
 			let si = SeekInput []
 			starting "merge" ai si $ do
 				warning $ "There are no commits yet to branch " ++ Git.fromRef branch ++ ", so cannot merge " ++ Git.fromRef syncbranch ++ " into it."
@@ -513,7 +513,7 @@ pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && want
 				, Just $ Param $ Remote.name remote
 				] ++ map Param bs
 	wantpull = remoteAnnexPull (Remote.gitconfig remote)
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 
 importRemote :: Bool -> SyncOptions -> Remote -> CurrBranch -> CommandSeek
@@ -559,7 +559,7 @@ pullThirdPartyPopulated o remote
 		Nothing -> next $ return False
 	go Nothing = next $ return True -- unchanged from before
 
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 	
 	wantpull = remoteAnnexPull (Remote.gitconfig remote)
@@ -607,7 +607,7 @@ pushRemote o remote (Just branch, _) = do
 					warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
 					return ok
   where
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 	gc = Remote.gitconfig remote
 	needpush mainbranch
@@ -1003,7 +1003,7 @@ cleanupRemote remote (Just b, _) =
 				Git.Ref.base $ Annex.Branch.name
 			]
   where
-	ai = ActionItemOther (Just (Remote.name remote))
+	ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
 	si = SeekInput []
 
 shouldSyncContent :: SyncOptions -> Annex Bool

Command/TestRemote.hs

@@ -73,7 +73,7 @@ seek :: TestRemoteOptions -> CommandSeek
 seek = commandAction . start 
 
 start :: TestRemoteOptions -> CommandStart
-start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do
+start o = starting "testremote" (ActionItemOther (Just (UnquotedString (testRemote o)))) si $ do
 	fast <- Annex.getRead Annex.fast
 	cache <- liftIO newRemoteVariantCache
 	r <- either giveup (disableExportTree cache)

Command/Trust.hs

@@ -30,7 +30,7 @@ trustCommand c level ps = withStrings (commandAction . start) ps
 	start name = do
 		u <- Remote.nameToUUID name
 		let si = SeekInput [name]
-		starting c (ActionItemOther (Just name)) si (perform name u)
+		starting c (ActionItemOther (Just (UnquotedString name))) si (perform name u)
 	perform name uuid = do
 		when (level >= Trusted) $
 			unlessM (Annex.getRead Annex.force) $

Command/Undo.hs

@@ -45,7 +45,7 @@ start :: FilePath -> CommandStart
 start p = starting "undo" ai si $
 	perform p
   where
-	ai = ActionItemOther (Just p)
+	ai = ActionItemOther (Just (QuotedPath (toRawFilePath p)))
 	si = SeekInput [p]
 
 perform :: FilePath -> CommandPerform

Command/Ungroup.hs

@@ -24,8 +24,9 @@ seek = withWords (commandAction . start)
 start :: [String] -> CommandStart
 start (name:g:[]) = do
 	u <- Remote.nameToUUID name
-	starting "ungroup" (ActionItemOther (Just name)) (SeekInput [name, g]) $
+	starting "ungroup" (ActionItemOther (Just (UnquotedString name))) 
-		perform u (toGroup g)
+		(SeekInput [name, g]) $
+			perform u (toGroup g)
 start _ = giveup "Specify a repository and a group."
 
 perform :: UUID -> Group -> CommandPerform

Command/Unused.hs

@@ -73,7 +73,7 @@ start o = do
 		Just "." -> (".", checkUnused refspec)
 		Just "here" -> (".", checkUnused refspec)
 		Just n -> (n, checkRemoteUnused n refspec)
-	starting "unused" (ActionItemOther (Just name)) (SeekInput []) perform
+	starting "unused" (ActionItemOther (Just (UnquotedString name))) (SeekInput []) perform
 
 checkUnused :: RefSpec -> CommandPerform
 checkUnused refspec = chain 0
@@ -337,6 +337,6 @@ startUnused message unused badunused tmpunused maps n = search
 		case M.lookup n m of
 			Nothing -> search rest
 			Just key -> starting message
-				(ActionItemOther $ Just $ show n)
+				(ActionItemOther $ Just $ UnquotedString $ show n)
 				(SeekInput [])
 				(a key)

Command/VPop.hs

@@ -48,6 +48,6 @@ start ps = go =<< currentView
 
 	num = fromMaybe 1 $ readish =<< headMaybe ps 
 	
-	ai = ActionItemOther (Just $ show num)
+	ai = ActionItemOther (Just $ UnquotedString $ show num)
 	
 	si = SeekInput ps

Command/Wanted.hs

@@ -39,7 +39,7 @@ cmd' name desc getter setter = noMessages $
 	start ps@(rname:expr:[]) = do
 		u <- Remote.nameToUUID rname
 		let si = SeekInput ps
-		let ai = ActionItemOther (Just rname)
+		let ai = ActionItemOther (Just (UnquotedString rname))
 		startingUsualMessages name ai si $
 			performSet setter expr u
 	start _ = giveup "Specify a repository."

Git/DiffTree.hs

@@ -133,6 +133,6 @@ parserDiffRaw f = DiffTreeItem
 	<*> (maybe (fail "bad dstsha") return . extractSha =<< nextword)
 	<* A8.char ' '
 	<*> A.takeByteString
-	<*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f)
+	<*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.unquote f)
   where
 	nextword = A8.takeTill (== ' ')

Git/FilePath.hs

@@ -5,7 +5,7 @@
  - top of the repository even when run in a subdirectory. Adding some
  - types helps keep that straight.
  -
- - Copyright 2012-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -51,7 +51,7 @@ data BranchFilePath = BranchFilePath Ref TopFilePath
 {- Git uses the branch:file form to refer to a BranchFilePath -}
 descBranchFilePath :: Filename.QuotePath -> BranchFilePath -> S.ByteString
 descBranchFilePath qp (BranchFilePath b f) =
-	fromRef' b <> ":" <> Filename.encode qp (getTopFilePath f)
+	fromRef' b <> ":" <> Filename.quote qp (getTopFilePath f)
 
 {- Path to a TopFilePath, within the provided git repo. -}
 fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath

Git/Filename.hs

@@ -1,4 +1,4 @@
-{- Some git commands output encoded filenames, in a rather annoyingly complex
+{- Some git commands output quoted filenames, in a rather annoyingly complex
  - C-style encoding.
  -
  - Copyright 2010-2023 Joey Hess <id@joeyh.name>
@@ -6,9 +6,15 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}
 
-module Git.Filename where
+module Git.Filename (
+	unquote,
+	quote,
+	QuotePath(..),
+	StringContainingQuotedPath(..),
+	prop_quote_unquote_roundtrip,
+) where
 
 import Common
 import Utility.Format (decode_c, encode_c, encode_c', isUtf8Byte)
@@ -16,11 +22,13 @@ import Utility.QuickCheck
 
 import Data.Char
 import Data.Word
+import Data.String
 import qualified Data.ByteString as S
+import qualified Data.Semigroup as Sem
+import Prelude
 
--- encoded filenames will be inside double quotes
+unquote :: S.ByteString -> RawFilePath
-decode :: S.ByteString -> RawFilePath
+unquote b = case S.uncons b of
-decode b = case S.uncons b of
 	Nothing -> b
 	Just (h, t)
 		| h /= q -> b
@@ -34,24 +42,51 @@ decode b = case S.uncons b of
 	q = fromIntegral (ord '"')
 
 -- always encodes and double quotes, even in cases that git does not
-encodeAlways :: RawFilePath -> S.ByteString
+quoteAlways :: RawFilePath -> S.ByteString
-encodeAlways s = "\"" <> encode_c needencode s <> "\""
+quoteAlways s = "\"" <> encode_c needencode s <> "\""
   where
 	needencode c = isUtf8Byte c || c == fromIntegral (ord '"')
 
 -- git config core.quotePath controls whether to quote unicode characters
 newtype QuotePath = QuotePath Bool
 
--- encodes and double quotes when git would
+class Quoteable t where
-encode :: QuotePath -> RawFilePath -> S.ByteString
+	-- double quotes and encodes when git would
-encode (QuotePath qp) s = case encode_c' needencode s of
+	quote :: QuotePath -> t -> S.ByteString
-	Nothing -> s
+
-	Just s' -> "\"" <> s' <> "\""
+instance Quoteable RawFilePath where
-  where
+	quote (QuotePath qp) s = case encode_c' needencode s of
-	needencode c
+		Nothing -> s
-		| c == fromIntegral (ord '"') = True
+		Just s' -> "\"" <> s' <> "\""
-		| qp = isUtf8Byte c
+	  where
-		| otherwise = False
+		needencode c
+			| c == fromIntegral (ord '"') = True
+			| qp = isUtf8Byte c
+			| otherwise = False
+
+-- Allows building up a string that contains paths, which will get quoted.
+-- With OverloadedStrings, strings are passed through without quoting.
+-- Eg: QuotedPath f <> ": not found"
+data StringContainingQuotedPath
+	= UnquotedString String 
+	| QuotedPath RawFilePath
+	| StringContainingQuotedPathMulti [StringContainingQuotedPath]
+	deriving (Show, Eq)
+
+instance Quoteable StringContainingQuotedPath where
+	quote _ (UnquotedString s) = encodeBS s
+	quote qp (QuotedPath p) = quote qp p
+	quote qp (StringContainingQuotedPathMulti l) = S.concat (map (quote qp) l)
+
+instance IsString StringContainingQuotedPath where
+	fromString = UnquotedString
+
+instance Sem.Semigroup StringContainingQuotedPath where
+	UnquotedString a <> UnquotedString b = UnquotedString (a <> b)
+	a <> b = StringContainingQuotedPathMulti [a, b]
+
+instance Monoid StringContainingQuotedPath where
+	mempty = UnquotedString mempty
 
 -- Encoding and then decoding roundtrips only when the string does not
 -- contain high unicode, because eg, both "\12345" and "\227\128\185"
@@ -59,8 +94,8 @@ encode (QuotePath qp) s = case encode_c' needencode s of
 --
 -- That is not a real-world problem, and using TestableFilePath
 -- limits what's tested to ascii, so avoids running into it.
-prop_encode_decode_roundtrip :: TestableFilePath -> Bool
+prop_quote_unquote_roundtrip :: TestableFilePath -> Bool
-prop_encode_decode_roundtrip ts = 
+prop_quote_unquote_roundtrip ts = 
-	s == fromRawFilePath (decode (encodeAlways (toRawFilePath s)))
+	s == fromRawFilePath (unquote (quoteAlways (toRawFilePath s)))
   where
 	s = fromTestableFilePath ts

Git/LsTree.hs

@@ -137,7 +137,7 @@ parserLsTree long = case long of
 		-- sha
 		<*> (Ref <$> A8.takeTill A8.isSpace)
 
-	fileparser = asTopFilePath . Git.Filename.decode <$> A.takeByteString
+	fileparser = asTopFilePath . Git.Filename.unquote <$> A.takeByteString
 
 	sizeparser = fmap Just A8.decimal
 

Messages.hs

@@ -89,6 +89,12 @@ showStartOther command mdesc si = outputMessage json $ encodeBS $
   where
 	json = JSON.start command Nothing Nothing si
 
+showStartNothing :: String -> SeekInput -> Annex ()
+showStartNothing command si = outputMessage json $ encodeBS $
+	command ++ " "
+  where
+	json = JSON.start command Nothing Nothing si
+
 showStartMessage :: StartMessage -> Annex ()
 showStartMessage (StartMessage command ai si) = case ai of
 	ActionItemAssociatedFile _ _ -> showStartActionItem command ai si
@@ -96,7 +102,8 @@ showStartMessage (StartMessage command ai si) = case ai of
 	ActionItemBranchFilePath _ _ -> showStartActionItem command ai si
 	ActionItemFailedTransfer _ _ -> showStartActionItem command ai si
 	ActionItemTreeFile _ -> showStartActionItem command ai si
-	ActionItemOther msg -> showStartOther command msg si
+	ActionItemOther Nothing -> showStartNothing command si
+	ActionItemOther _ -> showStartActionItem command ai si
 	OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
 showStartMessage (StartUsualMessages command ai si) = do
 	outputType <$> Annex.getState Annex.output >>= \case

Test.hs

@@ -151,7 +151,7 @@ tests n crippledfilesystem adjustedbranchok opts =
 
 properties :: TestTree
 properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $
-	[ testProperty "prop_encode_decode_roundtrip" Git.Filename.prop_encode_decode_roundtrip
+	[ testProperty "prop_quote_unquote_roundtrip" Git.Filename.prop_quote_unquote_roundtrip
 	, testProperty "prop_encode_c_decode_c_roundtrip" Utility.Format.prop_encode_c_decode_c_roundtrip
 	, testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode
 	, testProperty "prop_isomorphic_shellEscape" Utility.ShellEscape.prop_isomorphic_shellEscape

Types/ActionItem.hs

@@ -7,7 +7,10 @@
 
 {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 
-module Types.ActionItem where
+module Types.ActionItem (
+	module Types.ActionItem,
+	Git.Filename.StringContainingQuotedPath(..),
+) where
 
 import Key
 import Types.Transfer
@@ -15,7 +18,6 @@ import Git.FilePath
 import qualified Git.Filename
 import Utility.FileSystemEncoding
 
-import Data.Maybe
 import qualified Data.ByteString as S
 
 data ActionItem 
@@ -24,7 +26,7 @@ data ActionItem
 	| ActionItemBranchFilePath BranchFilePath Key
 	| ActionItemFailedTransfer Transfer TransferInfo
 	| ActionItemTreeFile RawFilePath
-	| ActionItemOther (Maybe String)
+	| ActionItemOther (Maybe Git.Filename.StringContainingQuotedPath)
 	-- Use to avoid more than one thread concurrently processing the
 	-- same Key.
 	| OnlyActionOn Key ActionItem
@@ -59,15 +61,16 @@ instance MkActionItem (Transfer, TransferInfo) where
 
 actionItemDesc :: Git.Filename.QuotePath -> ActionItem -> S.ByteString
 actionItemDesc qp (ActionItemAssociatedFile (AssociatedFile (Just f)) _) = 
-	Git.Filename.encode qp f
+	Git.Filename.quote qp f
 actionItemDesc _ (ActionItemAssociatedFile (AssociatedFile Nothing) k) = 
 	serializeKey' k
 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 qp (ActionItemTreeFile f) = Git.Filename.encode qp f
+actionItemDesc qp (ActionItemTreeFile f) = Git.Filename.quote qp f
-actionItemDesc _ (ActionItemOther s) = encodeBS (fromMaybe "" s)
+actionItemDesc _ (ActionItemOther Nothing) = mempty
+actionItemDesc qp (ActionItemOther (Just v)) = Git.Filename.quote qp v
 actionItemDesc qp (OnlyActionOn _ ai) = actionItemDesc qp ai
 
 actionItemKey :: ActionItem -> Maybe Key

doc/todo/terminal_escapes_in_filenames.mdwn

@@ -12,14 +12,6 @@ working on or in messages.
 pipeable, and so should have raw filenames. Note that `find` actually
 escapes such filenames when outputting to a terminal, but not a pipe.
 
-It's possible that keys can also contain an escape sequence, eg in the
-extension of a SHA-E key. So commands like `git-annex lookupkey` 
-and `git-annex find` that output keys might need to handle
-that, when outputting to a terminal?
-
-`git-annex metadata` could also contain an escape sequence. So could 
-`git-annex config --get`.
-
 git porcelain also accepts the escaped form of files as input, necessary for
 round-tripping though. git-annex currently does not. (git plumbing doesn't
 either)
@@ -40,3 +32,30 @@ behave more like git.
 > Note that core.quotePath controls whether git quotes unicode characters
 > (by default it does), so once this gets implemented, some users may want
 > to set that config to false. --[[Joey]]
+
+> Update: Most git-annex commands now quote filenames, due to work on
+> ActionItem display. `git-annex find`, `git-annex info $file`,
+> and everywhere filenames get
+> embedded in error messages, warnings, info messages, still need to be done.
+
+----
+
+Also: 
+It's possible that keys can also contain an escape sequence, eg in the
+extension of a SHA-E key. So commands like `git-annex lookupkey` 
+and `git-annex find` that output keys might need to handle
+that, when outputting to a terminal?
+
+Also:
+`git-annex metadata` could also contain an escape sequence. So could
+`git-annex config --get` and `git-annex schedule` and `git-annex wanted`
+and `git-annex required` and `git-annex group`. And so could the
+description of a repository. It seems that git-annex could just filter out
+control characters from all of these, since they are not filenames, and
+any control characters in them are surely malicious.
+
+Also: git-annex importfeed displays urls from the feed, and should filter
+out control characters. If such an url even can be parsed?
+
+Also: git-annex initremote with autoenable may be able to cause a remote
+with a malicious name to be set up?