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
This commit is contained in:
Joey Hess 2023-04-10 12:56:45 -04:00
parent da83652c76
commit 063c00e4f7
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 79 additions and 30 deletions

View file

@ -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,15 +442,17 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
_ <- moveAnnex k (AssociatedFile Nothing) (toRawFilePath f)
return k
getReadonlyKey :: Remote -> FilePath -> Annex Key
getReadonlyKey r f = lookupKey (toRawFilePath f) >>= \case
Nothing -> giveup $ f ++ " is not an annexed file"
Just k -> do
unlessM (inAnnex k) $
giveup $ 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"
return k
getReadonlyKey :: Remote -> RawFilePath -> Annex Key
getReadonlyKey r f = do
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 $ decodeBS $ quote qp $ QuotedPath f <> " does not have its content locally present, cannot test it"
unlessM ((Remote.uuid r `elem`) <$> loggedLocations k) $
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
runBool a = do