From df6f9f1ee84db38b590d65306bdaa4cd94ebd3d2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 11 Apr 2023 14:27:22 -0400 Subject: [PATCH] filter out control characters and quote filenames Searched for uses of putStr and hPutStr and changed appropriate ones to filter out control characters and quote filenames. This notably does not make find and findkeys quote filenames in their default output. Because they should only do that when stdout is non a pipe. A few commands like calckey and lookupkey seem too low-level to make sense to filter output, so skipped those. Also when relaying output from other commands that is not progress output, have git-annex filter out control characters. Sponsored-by: k0ld on Patreon --- CHANGELOG | 5 ++++- Command/CheckPresentKey.hs | 3 ++- Command/Config.hs | 3 ++- Command/Group.hs | 3 ++- Command/List.hs | 15 ++++++++++---- Command/Log.hs | 13 +++++++++---- Command/MetaData.hs | 3 ++- Command/P2P.hs | 3 ++- Command/Schedule.hs | 3 ++- Command/Status.hs | 11 ++++++++--- Command/Wanted.hs | 3 ++- Command/WhereUsed.hs | 40 ++++++++++++++++++++++---------------- Command/Whereis.hs | 1 + Messages/Progress.hs | 5 +++-- Utility/Metered.hs | 3 ++- 15 files changed, 75 insertions(+), 39 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index b67340c3cf..b52231418b 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,9 +1,12 @@ git-annex (10.20230408) UNRELEASED; urgency=medium - * Many commands now display filenames that contain unusual characters the + * Many commands now quotes filenames that contain unusual characters the same way that git does, to avoid exposing control characters to the terminal. * Support core.quotePath, which can be set to false to display utf8 characters as-is in filenames. + * Control characters in information coming from the repository or other + possible untrusted sources are filtered out of the display of many + commands. * addurl --preserve-filename now rejects filenames that contain other control characters, besides the escape sequences it already rejected. diff --git a/Command/CheckPresentKey.hs b/Command/CheckPresentKey.hs index 46211523bf..f3b4ef921c 100644 --- a/Command/CheckPresentKey.hs +++ b/Command/CheckPresentKey.hs @@ -10,6 +10,7 @@ module Command.CheckPresentKey where import Command import qualified Remote import Remote.List +import Utility.SafeOutput cmd :: Command cmd = noCommit $ noMessages $ @@ -68,7 +69,7 @@ exitResult :: Result -> Annex a exitResult Present = liftIO exitSuccess exitResult NotPresent = liftIO exitFailure exitResult (CheckFailure msg) = liftIO $ do - hPutStrLn stderr msg + hPutStrLn stderr (safeOutput msg) exitWith $ ExitFailure 100 batchResult :: Result -> Annex () diff --git a/Command/Config.hs b/Command/Config.hs index b27a840412..779488236c 100644 --- a/Command/Config.hs +++ b/Command/Config.hs @@ -14,6 +14,7 @@ import Logs.Config import Config import Types.GitConfig (globalConfigs) import Git.Types (fromConfigValue) +import Utility.SafeOutput import qualified Data.ByteString.Char8 as S8 @@ -75,7 +76,7 @@ seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction seek (GetConfig ck) = checkIsGlobalConfig ck $ commandAction $ startingCustomOutput ai $ do getGlobalConfig ck >>= \case - Just (ConfigValue v) -> liftIO $ S8.putStrLn v + Just (ConfigValue v) -> liftIO $ S8.putStrLn $ safeOutput v Just NoConfigValue -> return () Nothing -> return () next $ return True diff --git a/Command/Group.hs b/Command/Group.hs index 6bfa024b46..41717961a5 100644 --- a/Command/Group.hs +++ b/Command/Group.hs @@ -11,6 +11,7 @@ import Command import qualified Remote import Logs.Group import Types.Group +import Utility.SafeOutput import qualified Data.Set as S @@ -32,7 +33,7 @@ start ps@(name:g:[]) = do start (name:[]) = do u <- Remote.nameToUUID name startingCustomOutput (ActionItemOther Nothing) $ do - liftIO . putStrLn . unwords . map fmt . S.toList + liftIO . putStrLn . safeOutput . unwords . map fmt . S.toList =<< lookupGroups u next $ return True where diff --git a/Command/List.hs b/Command/List.hs index 80b0e2db16..1de9d74983 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -6,20 +6,25 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.List where import qualified Data.Set as S import qualified Data.Map as M import Data.Function import Data.Ord +import qualified Data.ByteString.Char8 as B8 import Command import Remote +import qualified Annex import Logs.Trust import Logs.UUID import Annex.UUID import Git.Types (RemoteName) import Utility.Tuple +import Utility.SafeOutput cmd :: Command cmd = noCommit $ withAnnexOptions [annexedMatchingOptions] $ @@ -75,12 +80,14 @@ getList o filter (\t -> thd3 t /= DeadTrusted) rs3 printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex () -printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l +printHeader l = liftIO $ putStrLn $ safeOutput $ lheader $ map (\(_, n, t) -> (n, t)) l start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> RawFilePath -> Key -> CommandStart start l _si file key = do ls <- S.fromList <$> keyLocations key - liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file + qp <- coreQuotePath <$> Annex.getGitConfig + liftIO $ B8.putStrLn $ quote qp $ + format (map (\(u, _, t) -> (t, S.member u ls)) l) file stop type Present = Bool @@ -93,8 +100,8 @@ lheader remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length trust UnTrusted = " (untrusted)" trust _ = "" -format :: [(TrustLevel, Present)] -> RawFilePath -> String -format remotes file = thereMap ++ " " ++ fromRawFilePath file +format :: [(TrustLevel, Present)] -> RawFilePath -> StringContainingQuotedPath +format remotes file = UnquotedString (thereMap) <> " " <> QuotedPath file where thereMap = concatMap there remotes there (UnTrusted, True) = "x" diff --git a/Command/Log.hs b/Command/Log.hs index 2dcac21cc9..645e982675 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.Log where import qualified Data.Set as S @@ -12,6 +14,7 @@ import qualified Data.Map as M import Data.Char import Data.Time.Clock.POSIX import Data.Time +import qualified Data.ByteString.Char8 as B8 import qualified System.FilePath.ByteString as P import Command @@ -166,15 +169,17 @@ mkOutputter m zone o file lookupdescription u = maybe (fromUUID u) (fromUUIDDesc) (M.lookup u m) normalOutput :: (UUID -> String) -> FilePath -> (POSIXTime -> String) -> Outputter -normalOutput lookupdescription file formattime logchange ts us = - liftIO $ mapM_ (putStrLn . format) us +normalOutput lookupdescription file formattime logchange ts us = do + qp <- coreQuotePath <$> Annex.getGitConfig + liftIO $ mapM_ (B8.putStrLn . quote qp . format) us where time = formattime ts addel = case logchange of Added -> "+" Removed -> "-" - format u = unwords [ addel, time, file, "|", - fromUUID u ++ " -- " ++ lookupdescription u ] + format u = UnquotedString addel <> " " <> UnquotedString time <> " " + <> QuotedPath (toRawFilePath file) <> " | " <> UnquotedByteString (fromUUID u) + <> " -- " <> UnquotedString (lookupdescription u) gourceOutput :: (UUID -> String) -> FilePath -> Outputter gourceOutput lookupdescription file logchange ts us = diff --git a/Command/MetaData.hs b/Command/MetaData.hs index 2bb0bd6b11..b0bb982793 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -15,6 +15,7 @@ import Annex.WorkTree import Messages.JSON (JSONActionItem(..), AddJSONActionItemFields(..)) import Types.Messages import Utility.Aeson +import Utility.SafeOutput import Limit import qualified Data.Set as S @@ -109,7 +110,7 @@ startKeys c o (si, k, ai) = case getSet o of Get f -> startingCustomOutput k $ do l <- S.toList . currentMetaDataValues f <$> getCurrentMetaData k liftIO $ forM_ l $ - B8.putStrLn . fromMetaValue + B8.putStrLn . safeOutput . fromMetaValue next $ return True _ -> starting "metadata" ai si $ perform c o k diff --git a/Command/P2P.hs b/Command/P2P.hs index 16155168ed..e51a5e16e1 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -24,6 +24,7 @@ import Utility.AuthToken import Utility.Tmp.Dir import Utility.FileMode import Utility.ThreadScheduler +import Utility.SafeOutput import qualified Utility.RawFilePath as R import qualified Utility.MagicWormhole as Wormhole @@ -92,7 +93,7 @@ genAddresses addrs = do authtoken <- liftIO $ genAuthToken 128 storeP2PAuthToken authtoken earlyWarning "These addresses allow access to this git-annex repository. Only share them with people you trust with that access, using trusted communication channels!" - liftIO $ putStr $ unlines $ + liftIO $ putStr $ safeOutput $ unlines $ map formatP2PAddress $ map (`P2PAddressAuth` authtoken) addrs diff --git a/Command/Schedule.hs b/Command/Schedule.hs index ffdf16a43b..adb49ec942 100644 --- a/Command/Schedule.hs +++ b/Command/Schedule.hs @@ -11,6 +11,7 @@ import Command import qualified Remote import Logs.Schedule import Types.ScheduledActivity +import Utility.SafeOutput import qualified Data.Set as S @@ -40,7 +41,7 @@ start = parse performGet :: UUID -> CommandPerform performGet uuid = do s <- scheduleGet uuid - liftIO $ putStrLn $ intercalate "; " $ + liftIO $ putStrLn $ safeOutput $ intercalate "; " $ map fromScheduledActivity $ S.toList s next $ return True diff --git a/Command/Status.hs b/Command/Status.hs index 6007484606..d6b2358f66 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -8,9 +8,12 @@ module Command.Status where import Command +import qualified Annex import Git.Status import Git.FilePath +import Data.ByteString.Char8 as B8 + cmd :: Command cmd = notBareRepo $ noCommit $ noMessages $ withAnnexOptions [jsonOptions] $ @@ -61,6 +64,8 @@ displayStatus (Renamed _ _) = noop displayStatus s = do let c = statusChar s absf <- fromRepo $ fromTopFilePath (statusFile s) - f <- liftIO $ fromRawFilePath <$> relPathCwdToFile absf - unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", f)]) $ - liftIO $ putStrLn $ [c] ++ " " ++ f + f <- liftIO $ relPathCwdToFile absf + qp <- coreQuotePath <$> Annex.getGitConfig + unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", fromRawFilePath f)]) $ + liftIO $ B8.putStrLn $ quote qp $ + UnquotedString (c : " ") <> QuotedPath f diff --git a/Command/Wanted.hs b/Command/Wanted.hs index 4bf7b5dd69..589eab842c 100644 --- a/Command/Wanted.hs +++ b/Command/Wanted.hs @@ -11,6 +11,7 @@ import Command import qualified Remote import Logs.PreferredContent import Types.StandardGroups +import Utility.SafeOutput import qualified Data.Map as M @@ -47,7 +48,7 @@ cmd' name desc getter setter = noMessages $ performGet :: Ord a => Annex (M.Map a PreferredContentExpression) -> a -> CommandPerform performGet getter a = do m <- getter - liftIO $ putStrLn $ fromMaybe "" $ M.lookup a m + liftIO $ putStrLn $ safeOutput $ fromMaybe "" $ M.lookup a m next $ return True performSet :: (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform diff --git a/Command/WhereUsed.hs b/Command/WhereUsed.hs index 6b70fc54f9..a213ff8aae 100644 --- a/Command/WhereUsed.hs +++ b/Command/WhereUsed.hs @@ -5,13 +5,14 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.WhereUsed where import Command import Git import Git.Sha import Git.FilePath -import qualified Git.Ref import qualified Git.Command import qualified Git.DiffTree as DiffTree import qualified Annex @@ -21,6 +22,7 @@ import Database.Keys import Data.Char import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L cmd :: Command @@ -58,7 +60,7 @@ start o (_, key, _) = startingCustomOutput key $ do fs <- filterM stillassociated =<< mapM (fromRepo . fromTopFilePath) =<< getAssociatedFiles key - liftIO $ forM_ fs $ display key . fromRawFilePath + forM_ fs $ display key . QuotedPath when (historicalOption o && null fs) $ findHistorical key @@ -71,8 +73,11 @@ start o (_, key, _) = startingCustomOutput key $ do Just k | k == key -> return True _ -> return False -display :: Key -> String -> IO () -display key loc = putStrLn (serializeKey key ++ " " ++ loc) +display :: Key -> StringContainingQuotedPath -> Annex () +display key loc = do + qp <- coreQuotePath <$> Annex.getGitConfig + liftIO $ S8.putStrLn $ quote qp $ + UnquotedByteString (serializeKey' key) <> " " <> loc findHistorical :: Key -> Annex () findHistorical key = do @@ -89,15 +94,15 @@ findHistorical key = do , Param "--tags=*" -- Output the commit hash , Param "--pretty=%H" - ] $ \h fs repo -> do - commitsha <- getSha "log" (pure h) + ] $ \h fs -> do + commitsha <- liftIO $ getSha "log" (pure h) commitdesc <- S.takeWhile (/= fromIntegral (ord '\n')) - <$> Git.Command.pipeReadStrict + <$> inRepo (Git.Command.pipeReadStrict [ Param "describe" , Param "--contains" , Param "--all" , Param (fromRef commitsha) - ] repo + ]) if S.null commitdesc then return False else process fs $ @@ -108,27 +113,28 @@ findHistorical key = do [ Param "--walk-reflogs" -- Output the reflog selector , Param "--pretty=%gd" - ] $ \h fs _ -> process fs $ + ] $ \h fs -> process fs $ displayreffile (Ref h) where process fs a = or <$> forM fs a displayreffile r f = do - let fref = Git.Ref.branchFileRef r f - display key (fromRef fref) + let tf = asTopFilePath f + display key (descBranchFilePath (BranchFilePath r tf)) return True -searchLog :: Key -> [CommandParam] -> (S.ByteString -> [RawFilePath] -> Repo -> IO Bool) -> Annex Bool -searchLog key ps a = Annex.inRepo $ \repo -> do - (output, cleanup) <- Git.Command.pipeNullSplit ps' repo +searchLog :: Key -> [CommandParam] -> (S.ByteString -> [RawFilePath] -> Annex Bool) -> Annex Bool +searchLog key ps a = do + (output, cleanup) <- Annex.inRepo $ Git.Command.pipeNullSplit ps' found <- case output of (h:rest) -> do let diff = DiffTree.parseDiffRaw rest + repo <- Annex.gitRepo let fs = map (flip fromTopFilePath repo . DiffTree.file) diff - rfs <- mapM relPathCwdToFile fs - a (L.toStrict h) rfs repo + rfs <- liftIO $ mapM relPathCwdToFile fs + a (L.toStrict h) rfs _ -> return False - void cleanup + liftIO $ void cleanup return found where ps' = diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 9052147249..5f9c9b51db 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -17,6 +17,7 @@ import Remote.Web (getWebUrls) import Annex.UUID import qualified Utility.Format import qualified Command.Find +import Utility.SafeOutput import qualified Data.Map as M import qualified Data.Vector as V diff --git a/Messages/Progress.hs b/Messages/Progress.hs index d587b9208d..4327e1970f 100644 --- a/Messages/Progress.hs +++ b/Messages/Progress.hs @@ -23,6 +23,7 @@ import Utility.InodeCache import qualified Messages.JSON as JSON import Messages.Concurrent import Messages.Internal +import Utility.SafeOutput import qualified System.Console.Regions as Regions import qualified System.Console.Concurrent as Console @@ -220,5 +221,5 @@ mkStderrEmitter :: Annex (String -> IO ()) mkStderrEmitter = withMessageState go where go s - | concurrentOutputEnabled s = return Console.errorConcurrent - | otherwise = return (hPutStrLn stderr) + | concurrentOutputEnabled s = return (Console.errorConcurrent . safeOutput) + | otherwise = return (hPutStrLn stderr . safeOutput) diff --git a/Utility/Metered.hs b/Utility/Metered.hs index 0b9bb3486b..a8a71112a3 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -53,6 +53,7 @@ import Utility.DataUnits import Utility.HumanTime import Utility.SimpleProtocol as Proto import Utility.ThreadScheduler +import Utility.SafeOutput import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S @@ -321,7 +322,7 @@ demeterCommandEnv oh cmd params environ = do where stdouthandler l = unless (quietMode oh) $ - putStrLn l + putStrLn (safeOutput l) {- To suppress progress output, while displaying other messages, - filter out lines that contain \r (typically used to reset to the