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

Remote/BitTorrent.hs

@@ -47,7 +47,7 @@ remote = RemoteType
 	, enumerate = list
 	, generate = gen
 	, configParser = mkRemoteConfigParser []
-	, setup = error "not supported"
+	, setup = giveup "not supported"
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	, thirdPartyPopulated = False

Remote/Ddar.hs

@@ -139,7 +139,7 @@ store ddarrepo = fileStorer $ \k src _p -> do
 
 {- Convert remote DdarRepo to host and path on remote end -}
 splitRemoteDdarRepo :: DdarRepo -> (SshHost, String)
-splitRemoteDdarRepo ddarrepo = (either error id $ mkSshHost host, ddarrepo')
+splitRemoteDdarRepo ddarrepo = (either giveup id $ mkSshHost host, ddarrepo')
   where
 	(host, remainder) = span (/= ':') (ddarRepoLocation ddarrepo)
 	ddarrepo' = drop 1 remainder
@@ -228,7 +228,7 @@ checkKey ddarrepo key = do
 	directoryExists <- ddarDirectoryExists ddarrepo
 	case directoryExists of
 		Left e -> error e
-		Right True -> either error return
+		Right True -> either giveup return
 			=<< inDdarManifest ddarrepo key
 		Right False -> return False
 

Remote/GCrypt.hs

@@ -197,7 +197,7 @@ rsyncTransport r gc
 		let rsyncpath = if "/~/" `isPrefixOf` path
 			then drop 3 path
 			else path
-		    sshhost = either error id (mkSshHost host)
+		    sshhost = either giveup id (mkSshHost host)
 		    mkopts = rsyncShell . (Param "ssh" :) 
 			<$> sshOptions ConsumeStdin (sshhost, Nothing) gc []
 		in (mkopts, fromSshHost sshhost ++ ":" ++ rsyncpath, AccessGitAnnexShell)
@@ -239,7 +239,7 @@ gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup gitRepoField c
 				]
 			(r:_)
 				| Git.repoLocation r == url -> noop
-				| otherwise -> error "Another remote with the same name already exists."		
+				| otherwise -> giveup "Another remote with the same name already exists."		
 
 		pc <- either giveup return . parseRemoteConfig c'
 			=<< configParser remote c'
@@ -505,7 +505,7 @@ getGCryptId fast r gc
 	| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
 		liftIO (catchMaybeIO $ Git.Config.read r)
 	| not fast = extract . liftM fst3 <$> getM (eitherToMaybe <$>)
-		[ Ssh.onRemote NoConsumeStdin r (\f p -> liftIO (Git.Config.fromPipe r f p Git.Config.ConfigList), return (Left $ error "configlist failed")) "configlist" [] []
+		[ Ssh.onRemote NoConsumeStdin r (\f p -> liftIO (Git.Config.fromPipe r f p Git.Config.ConfigList), return (Left $ giveup "configlist failed")) "configlist" [] []
 		, getConfigViaRsync r gc
 		]
 	| otherwise = return (Nothing, r)

Remote/Helper/Encryptable.hs

@@ -331,4 +331,4 @@ toB64bs = w82s . B.unpack . B64.encode . B.pack . s2w8
 fromB64bs :: String -> String
 fromB64bs s = either (const bad) (w82s . B.unpack) (B64.decode $ B.pack $ s2w8 s)
   where
-	bad = error "bad base64 encoded data"
+	bad = giveup "bad base64 encoded data"

Remote/Helper/Ssh.hs

@@ -32,7 +32,7 @@ toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> SshCommand -> Annex (Fi
 toRepo cs r gc remotecmd = do
 	let host = maybe
 		(giveup "bad ssh url")
-		(either error id . mkSshHost)
+		(either giveup id . mkSshHost)
 		(Git.Url.hostuser r)
 	sshCommand cs (host, Git.Url.port r) gc remotecmd
 

Remote/HttpAlso.hs

@@ -103,7 +103,7 @@ cannotModify = giveup "httpalso special remote is read only"
 
 httpAlsoSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 httpAlsoSetup _ Nothing _ _ _ =
-	error "Must use --sameas when initializing a httpalso remote."
+	giveup "Must use --sameas when initializing a httpalso remote."
 httpAlsoSetup _ (Just u) _ c gc = do
 	_url <- maybe (giveup "Specify url=")
 		(return . fromProposedAccepted)

Remote/P2P.hs

@@ -38,7 +38,7 @@ remote = RemoteType
 	, enumerate = const (return [])
 	, generate = \_ _ _ _ _ -> return Nothing
 	, configParser = mkRemoteConfigParser []
-	, setup = error "P2P remotes are set up using git-annex p2p"
+	, setup = giveup "P2P remotes are set up using git-annex p2p"
 	, exportSupported = exportUnsupported
 	, importSupported = importUnsupported
 	, thirdPartyPopulated = False

Remote/Rsync.hs

@@ -179,7 +179,7 @@ rsyncTransport gc url
 		case fromNull ["ssh"] (remoteAnnexRsyncTransport gc) of
 			"ssh":sshopts -> do
 				let (port, sshopts') = sshReadPort sshopts
-				    userhost = either error id $ mkSshHost $ 
+				    userhost = either giveup id $ mkSshHost $ 
 				    	takeWhile (/= ':') url
 				return $ (Param "ssh":) <$> sshOptions ConsumeStdin
 					(userhost, port) gc

Remote/WebDAV.hs

@@ -321,7 +321,7 @@ testDav url (Just (u, p)) = do
 
 	user = toDavUser u
 	pass = toDavPass p
-testDav _ Nothing = error "Need to configure webdav username and password."
+testDav _ Nothing = giveup "Need to configure webdav username and password."
 
 {- Tries to make all the parent directories in the WebDAV urls's path,
  - right down to the root.
@@ -407,7 +407,7 @@ choke :: IO (Either String a) -> IO a
 choke f = do
 	x <- f
 	case x of
-		Left e -> error e
+		Left e -> giveup e
 		Right r -> return r
 
 data DavHandle = DavHandle DAVContext DavUser DavPass URLString
@@ -491,11 +491,11 @@ retrieveLegacyChunked d k p dav = liftIO $
 				inLocation l $
 					snd <$> getContentM
   where
-	onerr = error "download failed"
+	onerr = giveup "download failed"
 
 checkKeyLegacyChunked :: DavHandle -> CheckPresent
 checkKeyLegacyChunked dav k = liftIO $
-	either error id <$> withStoredFilesLegacyChunked k dav onerr check
+	either giveup id <$> withStoredFilesLegacyChunked k dav onerr check
   where
 	check [] = return $ Right True
 	check (l:ls) = do