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

diff --git a/CHANGELOG b/CHANGELOG
index b67340c3cfd41265ab4f446b3a55d7f5aa2f9617..b52231418be0de8c3954eaa34d078012c48b896e 100644 (file)
--- 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 46211523bf556e2e11bf48c5def28b18b0679604..f3b4ef921c04b6627e418c4bb4e4ac1578873fe7 100644 (file)
--- 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 b27a840412d9fc78298085337a37008dbdc52ed6..779488236c3bd5f3750f30961d5bcc2bf061ef3a 100644 (file)
--- 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 6bfa024b46988336e4d6a605bc90088f958c77b8..41717961a5fef9601a9d024c44c28752aa11a7a8 100644 (file)
--- 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 80b0e2db16339d1841a54764032748f0d640e52c..1de9d74983cdd93621e39072404cdad505f83cdc 100644 (file)
--- 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 2dcac21cc995b18d18cf2f0bf37a10d12859b3f4..645e982675bfbd10cca41ed46812f365be016d58 100644 (file)
--- 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 2bb0bd6b11d0939635c98bf9751202e618d229ca..b0bb982793cff5eaa383a64905276e7b5fdef2bc 100644 (file)
--- 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 16155168edd1f9bd37eac39ca2d04f106f75c0a7..e51a5e16e15a0ae9d4747b74b0fe4f6bff459b01 100644 (file)
--- 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 ffdf16a43b93f9b5998e963a4478a9b26f2324b9..adb49ec9423300d775dcd367edf1f213d8c4d7c4 100644 (file)
--- 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 60074846069e2a2f472e644784a01b95a4c22f3f..d6b2358f666d33d4024810c9ecc0ca1650d7243b 100644 (file)
--- 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 4bf7b5dd699f7480f783a9304540ebe4f2d5cb66..589eab842c187165a734e4517fe82c0cfd510039 100644 (file)
--- 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 6b70fc54f9bacd05af36b618953cd1a2027e1ecd..a213ff8aae1d37f571bddf6e0d2da9cb8bdb4c47 100644 (file)
--- 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 9052147249e965ed00491651dc17bf9614353549..5f9c9b51db3ca6a77e8637483beb1fc1cb9782e6 100644 (file)
--- 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 d587b9208df7b52323fd8152a85cde2cd03c6d4b..4327e1970fc6e8b9dc5cfd0c19609f0d5da7a0ea 100644 (file)
--- 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 0b9bb3486bff04683266677c959494f35b6590f7..a8a71112a39bd22a519a3aa5be1151a5df7ec4ef 100644 (file)
--- 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