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,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Annex.Ingest ( module Annex.Ingest (
LockedDown(..), LockedDown(..),
LockDownConfig(..), LockDownConfig(..),
@ -46,6 +48,7 @@ import Utility.CopyFile
import Utility.Touch import Utility.Touch
import Utility.Metered import Utility.Metered
import Git.FilePath import Git.FilePath
import Git.Filename
import Annex.InodeSentinal import Annex.InodeSentinal
import Annex.AdjustedBranch import Annex.AdjustedBranch
import Annex.FileMatcher import Annex.FileMatcher
@ -133,16 +136,16 @@ lockDown' cfg file = tryNonAsync $ ifM crippledFileSystem
setperms = when (lockingFile cfg) $ do setperms = when (lockingFile cfg) $ do
freezeContent file' 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 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 _ -> Nothing
{- Ingests a locked down file into the annex. Updates the work tree and {- Ingests a locked down file into the annex. Updates the work tree and

View file

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

View file

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

View file

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

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Command.Reinject where module Command.Reinject where
import Command import Command
@ -15,6 +17,8 @@ import Types.KeySource
import Utility.Metered import Utility.Metered
import Annex.WorkTree import Annex.WorkTree
import qualified Git import qualified Git
import qualified Annex
import Git.Filename
cmd :: Command cmd :: Command
cmd = withAnnexOptions [backendOption] $ cmd = withAnnexOptions [backendOption] $
@ -48,13 +52,20 @@ startSrcDest ps@(src:dest:[])
| otherwise = notAnnexed src' $ | otherwise = notAnnexed src' $
lookupKey (toRawFilePath dest) >>= \case lookupKey (toRawFilePath dest) >>= \case
Just k -> go k 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 where
src' = toRawFilePath src src' = toRawFilePath src
go key = starting "reinject" ai si $ go key = starting "reinject" ai si $
ifM (verifyKeyContent key src') ifM (verifyKeyContent key src')
( perform src' key ( 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')) ai = ActionItemOther (Just (QuotedPath src'))
si = SeekInput ps si = SeekInput ps
@ -81,7 +92,11 @@ notAnnexed src a =
ifM (fromRepo Git.repoIsLocalBare) ifM (fromRepo Git.repoIsLocalBare)
( a ( a
, lookupKey src >>= \case , 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 Nothing -> a
) )

View file

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

View file

@ -12,6 +12,8 @@ import Git.DiffTree
import Git.FilePath import Git.FilePath
import Git.UpdateIndex import Git.UpdateIndex
import Git.Sha import Git.Sha
import Git.Filename
import qualified Annex
import qualified Git.LsFiles as LsFiles import qualified Git.LsFiles as LsFiles
import qualified Git.Command as Git import qualified Git.Command as Git
import qualified Git.Branch import qualified Git.Branch
@ -29,8 +31,11 @@ seek ps = do
-- Safety first; avoid any undo that would touch files that are not -- Safety first; avoid any undo that would touch files that are not
-- in the index. -- in the index.
(fs, cleanup) <- inRepo $ LsFiles.notInRepo [] False (map toRawFilePath ps) (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 void $ liftIO $ cleanup
-- Committing staged changes before undo allows later -- Committing staged changes before undo allows later

View file

@ -13,6 +13,7 @@ module Git.Filename (
quote, quote,
QuotePath(..), QuotePath(..),
StringContainingQuotedPath(..), StringContainingQuotedPath(..),
quotedPaths,
prop_quote_unquote_roundtrip, prop_quote_unquote_roundtrip,
) where ) where
@ -73,6 +74,12 @@ data StringContainingQuotedPath
| StringContainingQuotedPath :+: StringContainingQuotedPath | StringContainingQuotedPath :+: StringContainingQuotedPath
deriving (Show, Eq) 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 instance Quoteable StringContainingQuotedPath where
quote _ (UnquotedString s) = encodeBS s quote _ (UnquotedString s) = encodeBS s
quote qp (QuotedPath p) = quote qp p quote qp (QuotedPath p) = quote qp p