mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

filter out control characters and quote filenames

Browse source 
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
This commit is contained in:
Joey Hess 2023-04-11 14:27:22 -04:00
parent 11e89c5a29
commit df6f9f1ee8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
15 changed files with 75 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

40
Command/WhereUsed.hs
View file

@ -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' =