git style filename quoting for giveup

When the filenames are part of the git repository or other files that
might have attacker-controlled names, quote them in error messages.

This is fairly complete, although I didn't do the one in
Utility.DirWatcher.INotify.hs because that doesn't have access to
Git.Filename or Annex.

But it's also quite possible I missed some. And also while scanning for
these, I found giveup used with other things that could be attacker
controlled to contain control characters (eg Keys). So, I'm thinking
it would also be good for giveup to just filter out control characters.
This commit is then not the only line of defence, but just good
formatting when git-annex displays a filename in an error message.

Sponsored-by: Kevin Mueller on Patreon

Annex/Ingest.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Annex.Ingest (
 	LockedDown(..),
 	LockDownConfig(..),
@@ -46,6 +48,7 @@ import Utility.CopyFile
 import Utility.Touch
 import Utility.Metered
 import Git.FilePath
+import Git.Filename
 import Annex.InodeSentinal
 import Annex.AdjustedBranch
 import Annex.FileMatcher
@@ -133,16 +136,16 @@ lockDown' cfg file = tryNonAsync $ ifM crippledFileSystem
 		
 	setperms = when (lockingFile cfg) $ do
 		freezeContent file'
-		when (checkWritePerms cfg) $
+		when (checkWritePerms cfg) $ do
-			maybe noop giveup =<< checkLockedDownWritePerms file' file'
+			qp <- coreQuotePath <$> Annex.getGitConfig
+			maybe noop (giveup . decodeBS . quote qp)
+				=<< checkLockedDownWritePerms file' file'
 
-checkLockedDownWritePerms :: RawFilePath -> RawFilePath -> Annex (Maybe String)
+checkLockedDownWritePerms :: RawFilePath -> RawFilePath -> Annex (Maybe StringContainingQuotedPath)
 checkLockedDownWritePerms file displayfile = checkContentWritePerm file >>= return . \case
-	Just False -> Just $ unwords
+	Just False -> Just $ "Unable to remove all write permissions from "
-		[ "Unable to remove all write permissions from"
+		<> QuotedPath displayfile
-		, fromRawFilePath displayfile
+		<> " -- perhaps it has an xattr or ACL set."
-		, "-- perhaps it has an xattr or ACL set."
-		]
 	_ -> Nothing
 
 {- Ingests a locked down file into the annex. Updates the work tree and

Command/Add.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.Add where
 
 import Command
@@ -23,6 +25,7 @@ import Messages.Progress
 import Git.FilePath
 import Git.Types
 import Git.UpdateIndex
+import Git.Filename
 import Config.GitConfig
 import Utility.OptParse
 import Utility.InodeCache
@@ -160,7 +163,10 @@ addFile smallorlarge file s = do
 		then hashBlob =<< liftIO (R.readSymbolicLink file)
 		else if isRegularFile s
 			then hashFile file
-			else giveup $ fromRawFilePath file ++ " is not a regular file"
+			else do
+				qp <- coreQuotePath <$> Annex.getGitConfig
+				giveup $ decodeBS $ quote qp $
+					file <> " is not a regular file"
 	let treetype = if isSymbolicLink s
 		then TreeSymlink
 		else if intersectFileModes ownerExecuteMode (fileMode s) /= 0

Command/Import.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE ApplicativeDo, OverloadedStrings #-}
 
 module Command.Import where
 
@@ -31,6 +31,7 @@ import Annex.RemoteTrackingBranch
 import Utility.InodeCache
 import Logs.Location
 import Git.FilePath
+import Git.Filename
 import Git.Types
 import Types.Import
 import Utility.Metered
@@ -125,7 +126,10 @@ seek o@(LocalImportOptions {}) = startConcurrency commandStages $ do
 	inrepops <- liftIO $ filter (dirContains repopath)
 		<$> mapM (absPath . toRawFilePath) (importFiles o)
 	unless (null inrepops) $ do
-		giveup $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords (map fromRawFilePath inrepops)
+		qp <- coreQuotePath <$> Annex.getGitConfig
+		giveup $ decodeBS $ quote qp $ 
+			"cannot import files from inside the working tree (use git annex add instead): "
+				<> quotedPaths inrepops
 	largematcher <- largeFilesMatcher
 	addunlockedmatcher <- addUnlockedMatcher
 	(commandAction . startLocal o addunlockedmatcher largematcher (duplicateMode o))
@@ -221,7 +225,8 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
 			checkLockedDownWritePerms destfile srcfile >>= \case
 				Just err -> do
 					liftIO unwind
-					giveup err
+					qp <- coreQuotePath <$> Annex.getGitConfig
+					giveup (decodeBS $ quote qp err)
 				Nothing -> noop
 		-- Get the inode cache of the dest file. It should be
 		-- weakly the same as the originally locked down file's

Command/ReKey.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.ReKey where
 
 import Command
@@ -17,6 +19,7 @@ import Annex.ReplaceFile
 import Logs.Location
 import Annex.InodeSentinal
 import Annex.WorkTree
+import Git.Filename
 import Utility.InodeCache
 import qualified Utility.RawFilePath as R
 
@@ -80,8 +83,10 @@ perform file oldkey newkey = do
 	ifM (inAnnex oldkey) 
 		( unlessM (linkKey file oldkey newkey) $
 			giveup "failed creating link from old to new key"
-		, unlessM (Annex.getRead Annex.force) $
+		, unlessM (Annex.getRead Annex.force) $ do
-			giveup $ fromRawFilePath file ++ " is not available (use --force to override)"
+			qp <- coreQuotePath <$> Annex.getGitConfig
+			giveup $ decodeBS $ quote qp $ QuotedPath file
+				<> " is not available (use --force to override)"
 		)
 	next $ cleanup file newkey
 

Command/Reinject.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.Reinject where
 
 import Command
@@ -15,6 +17,8 @@ import Types.KeySource
 import Utility.Metered
 import Annex.WorkTree
 import qualified Git
+import qualified Annex
+import Git.Filename
 
 cmd :: Command
 cmd = withAnnexOptions [backendOption] $
@@ -48,13 +52,20 @@ startSrcDest ps@(src:dest:[])
 	| otherwise = notAnnexed src' $
 		lookupKey (toRawFilePath dest) >>= \case
 			Just k -> go k
-			Nothing -> giveup $ src ++ " is not an annexed file"
+			Nothing -> do
+				qp <- coreQuotePath <$> Annex.getGitConfig
+				giveup $ decodeBS $ quote qp $ QuotedPath src'
+					<> " is not an annexed file"
   where
 	src' = toRawFilePath src
 	go key = starting "reinject" ai si $
 		ifM (verifyKeyContent key src')
 			( perform src' key
-			, giveup $ src ++ " does not have expected content of " ++ dest
+			, do
+				qp <- coreQuotePath <$> Annex.getGitConfig
+				giveup $ decodeBS $ quote qp $ QuotedPath src'
+					<> " does not have expected content of "
+					<> QuotedPath (toRawFilePath dest)
 			)
 	ai = ActionItemOther (Just (QuotedPath src'))
 	si = SeekInput ps
@@ -81,7 +92,11 @@ notAnnexed src a =
 	ifM (fromRepo Git.repoIsLocalBare)
 		( a
 		, lookupKey src >>= \case
-			Just _ -> giveup $ "cannot used annexed file as src: " ++ fromRawFilePath src
+			Just _ -> do
+				qp <- coreQuotePath <$> Annex.getGitConfig
+				giveup $ decodeBS $ quote qp $ 
+					"cannot used annexed file as src: "
+						<> QuotedPath src
 			Nothing -> a
 		)
 

Command/TestRemote.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE RankNTypes, DeriveFunctor, PackageImports #-}
+{-# LANGUAGE RankNTypes, DeriveFunctor, PackageImports, OverloadedStrings #-}
 
 module Command.TestRemote where
 
@@ -32,6 +32,7 @@ import Annex.SpecialRemote.Config (exportTreeField)
 import Remote.Helper.Chunked
 import Remote.Helper.Encryptable (encryptionField, highRandomQualityField)
 import Git.Types
+import Git.Filename
 
 import Test.Tasty
 import Test.Tasty.Runners
@@ -84,7 +85,7 @@ start o = starting "testremote" (ActionItemOther (Just (UnquotedString (testRemo
 			else do
 				showAction "generating test keys"
 				mapM randKey (keySizes basesz fast)
-		fs -> mapM (getReadonlyKey r) fs
+		fs -> mapM (getReadonlyKey r . toRawFilePath) fs
 	let r' = if null (testReadonlyFile o)
 		then r
 		else r { Remote.readonly = True }
@@ -441,14 +442,16 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
 	_ <- moveAnnex k (AssociatedFile Nothing) (toRawFilePath f)
 	return k
 
-getReadonlyKey :: Remote -> FilePath -> Annex Key
+getReadonlyKey :: Remote -> RawFilePath -> Annex Key
-getReadonlyKey r f = lookupKey (toRawFilePath f) >>= \case
+getReadonlyKey r f = do
-	Nothing -> giveup $ f ++ " is not an annexed file"
+	qp <- coreQuotePath <$> Annex.getGitConfig
+	lookupKey f >>= \case
+		Nothing -> giveup $ decodeBS $ quote qp $ QuotedPath f <> " is not an annexed file"
 		Just k -> do
 			unlessM (inAnnex k) $
-			giveup $ f ++ " does not have its content locally present, cannot test it"
+				giveup $ decodeBS $ quote qp $ QuotedPath f <> " does not have its content locally present, cannot test it"
 			unlessM ((Remote.uuid r `elem`) <$> loggedLocations k) $
-			giveup $ f ++ " is not stored in the remote being tested, cannot test it"
+				giveup $ decodeBS $ quote qp $ QuotedPath f <> " is not stored in the remote being tested, cannot test it"
 			return k
 
 runBool :: Monad m => m () -> m Bool

Command/Undo.hs

@@ -12,6 +12,8 @@ import Git.DiffTree
 import Git.FilePath
 import Git.UpdateIndex
 import Git.Sha
+import Git.Filename
+import qualified Annex
 import qualified Git.LsFiles as LsFiles
 import qualified Git.Command as Git
 import qualified Git.Branch
@@ -29,8 +31,11 @@ seek ps = do
 	-- Safety first; avoid any undo that would touch files that are not
 	-- in the index.
 	(fs, cleanup) <- inRepo $ LsFiles.notInRepo [] False (map toRawFilePath ps)
-	unless (null fs) $
+	unless (null fs) $ do
-		giveup $ "Cannot undo changes to files that are not checked into git: " ++ unwords (map fromRawFilePath fs)
+		qp <- coreQuotePath <$> Annex.getGitConfig
+		giveup $ decodeBS $ quote qp $ 
+			"Cannot undo changes to files that are not checked into git: "
+				<> quotedPaths fs
 	void $ liftIO $ cleanup
 
 	-- Committing staged changes before undo allows later

Git/Filename.hs

@@ -13,6 +13,7 @@ module Git.Filename (
 	quote,
 	QuotePath(..),
 	StringContainingQuotedPath(..),
+	quotedPaths,
 	prop_quote_unquote_roundtrip,
 ) where
 
@@ -73,6 +74,12 @@ data StringContainingQuotedPath
 	| StringContainingQuotedPath :+: StringContainingQuotedPath
 	deriving (Show, Eq)
 
+quotedPaths :: [RawFilePath] -> StringContainingQuotedPath
+quotedPaths [] = mempty
+quotedPaths (p:ps) = QuotedPath p <> if null ps
+	then mempty
+	else " " <> quotedPaths ps
+
 instance Quoteable StringContainingQuotedPath where
 	quote _ (UnquotedString s) = encodeBS s
 	quote qp (QuotedPath p) = quote qp p