filter out control characters in error messages

giveup changed to filter out control characters. (It is too low level to
make it use StringContainingQuotedPath.)

error still does not, but it should only be used for internal errors,
where the message is not attacker-controlled.

Changed a lot of existing error to giveup when it is not strictly an
internal error.

Of course, other exceptions can still be thrown, either by code in
git-annex, or a library, that include some attacker-controlled value.
This does not guard against those.

Sponsored-by: Noam Kremen on Patreon

Command/AddUrl.hs

@@ -148,7 +148,7 @@ checkUrl addunlockedmatcher r o si u = do
 	pathmax <- liftIO $ fileNameLengthLimit "."
 	let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption (downloadOptions o))
 	go deffile =<< maybe
-		(error $ "unable to checkUrl of " ++ Remote.name r)
+		(giveup $ "unable to checkUrl of " ++ Remote.name r)
 		(tryNonAsync . flip id u)
 		(Remote.checkUrl r)
   where

Command/Fix.hs

@@ -76,7 +76,7 @@ breakHardLink file key obj = do
 		let tmp' = toRawFilePath tmp
 		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
 		unlessM (checkedCopyFile key obj tmp' mode) $
-			error "unable to break hard link"
+			giveup "unable to break hard link"
 		thawContent tmp'
 		Database.Keys.storeInodeCaches key [tmp']
 		modifyContentDir obj $ freezeContent obj
@@ -87,7 +87,7 @@ makeHardLink file key = do
 	replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
 		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
 		linkFromAnnex' key (toRawFilePath tmp) mode >>= \case
-			LinkAnnexFailed -> error "unable to make hard link"
+			LinkAnnexFailed -> giveup "unable to make hard link"
 			_ -> noop
 	next $ return True
 

Command/ImportFeed.hs

@@ -232,7 +232,7 @@ performDownload' started addunlockedmatcher opts cache todownload = case locatio
 								return (Just [])
 				else do
 					res <- tryNonAsync $ maybe
-						(error $ "unable to checkUrl of " ++ Remote.name r)
+						(giveup $ "unable to checkUrl of " ++ Remote.name r)
 						(flip id url)
 						(Remote.checkUrl r)
 					case res of

Command/Log.hs

@@ -281,7 +281,7 @@ parseRawChangeLine = go . words
 	go _ = Nothing
 
 parseTimeStamp :: String -> POSIXTime
-parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (error "bad timestamp") .
+parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (giveup "bad timestamp") .
 	parseTimeM True defaultTimeLocale "%s"
 
 showTimeStamp :: TimeZone -> POSIXTime -> String

Command/ReKey.hs

@@ -113,7 +113,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
 				replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
 					let tmp' = toRawFilePath tmp
 					unlessM (checkedCopyFile oldkey oldobj tmp' Nothing) $
-						error "can't lock old key"
+						giveup "can't lock old key"
 					thawContent tmp'
 		ic <- withTSDelta (liftIO . genInodeCache file)
 		case v of

Command/Reinject.hs

@@ -103,7 +103,7 @@ notAnnexed src a =
 perform :: RawFilePath -> Key -> CommandPerform
 perform src key = ifM move
 	( next $ cleanup key
-	, error "failed"
+	, giveup "failed"
 	)
   where
 	move = checkDiskSpaceToGet key False $

Command/RemoteDaemon.hs

@@ -24,7 +24,7 @@ cmd = noCommit $
 
 run :: DaemonOptions -> CommandSeek
 run o
-	| stopDaemonOption o = error "--stop not implemented for remotedaemon"
+	| stopDaemonOption o = giveup "--stop not implemented for remotedaemon"
 	| foregroundDaemonOption o = liftIO runInteractive
 	| otherwise = do
 #ifndef mingw32_HOST_OS

Command/ResolveMerge.hs

@@ -28,7 +28,7 @@ start = starting "resolvemerge" (ActionItemOther Nothing) (SeekInput []) $ do
 	us <- fromMaybe nobranch <$> inRepo Git.Branch.current
 	d <- fromRawFilePath <$> fromRepo Git.localGitDir
 	let merge_head = d </> "MERGE_HEAD"
-	them <- fromMaybe (error nomergehead) . extractSha
+	them <- fromMaybe (giveup nomergehead) . extractSha
 		<$> liftIO (S.readFile merge_head)
 	ifM (resolveMerge (Just us) them False)
 		( do

Command/SetKey.hs

@@ -44,7 +44,7 @@ perform file key = do
 		else return True
 	if ok
 		then next $ cleanup key
-		else error "mv failed!"
+		else giveup "move failed!"
 
 cleanup :: Key -> CommandCleanup
 cleanup key = do

Command/Smudge.hs

@@ -191,7 +191,7 @@ clean' file mk passthrough discardreststdin emitpointer =
 	postingest (Just k, _) = do
 		logStatus k InfoPresent
 		return k
-	postingest _ = error "could not add file to the annex"
+	postingest _ = giveup "could not add file to the annex"
 
 	cfg = LockDownConfig
 		{ lockingFile = False

Command/TestRemote.hs

@@ -152,7 +152,7 @@ encryptionVariants cache dr = [noenc, sharedenc]
 
 -- Variant of a remote with exporttree disabled.
 disableExportTree :: RemoteVariantCache -> Remote -> Annex Remote
-disableExportTree cache r = maybe (error "failed disabling exportree") return 
+disableExportTree cache r = maybe (giveup "failed disabling exportree") return 
 		=<< adjustRemoteConfig cache r (M.delete exportTreeField)
 
 -- Variant of a remote with exporttree enabled.

Command/TransferKeys.hs

@@ -83,7 +83,7 @@ runRequests readh writeh a = do
 		go rest
 	go [] = noop
 	go [""] = noop
-	go v = error $ "transferkeys protocol error: " ++ show v
+	go v = giveup $ "transferkeys protocol error: " ++ show v
 
 	readrequests = liftIO $ split fieldSep <$> hGetContents readh
 	sendresult b = liftIO $ do

Command/Undo.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.Undo where
 
 import Command

Command/Unlock.hs

@@ -58,7 +58,7 @@ perform dest key = do
 				case r of
 					LinkAnnexOk -> return ()
 					LinkAnnexNoop -> return ()
-					LinkAnnexFailed -> error "unlock failed"
+					LinkAnnexFailed -> giveup "unlock failed"
 			, liftIO $ writePointerFile (toRawFilePath tmp) key destmode
 			)
 		withTSDelta (liftIO . genInodeCache (toRawFilePath tmp))

Command/Whereis.hs

@@ -17,7 +17,6 @@ import Remote.Web (getWebUrls)
 import Annex.UUID
 import qualified Utility.Format
 import qualified Command.Find
-import Types.ActionItem
 
 import qualified Data.Map as M
 import qualified Data.Vector as V