safe output to terminal for calckey inprogress and lookupkey

These are quite low-level, but still there is no point in displaying
escape sequences that have been embedded in a key to the terminal.

I think these are the only remaining commands that didn't use safe
output, except for cases where git-annex is speaking a protocol to
itself.

Sponsored-by: Kevin Mueller on Patreon
This commit is contained in:
Joey Hess 2023-04-12 14:03:44 -04:00
parent a576fc3b12
commit 3346aa9659
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 24 additions and 12 deletions

View file

@ -9,6 +9,8 @@ module Command.Inprogress where
import Command
import Annex.Transfer
import Utility.Terminal
import Utility.SafeOutput
import qualified Data.Set as S
@ -32,14 +34,14 @@ seek o = do
ts <- map (transferKey . fst) <$> getTransfers
case keyOptions o of
Just WantAllKeys ->
forM_ ts $ commandAction . start'
forM_ ts $ commandAction . (start' isterminal)
Just (WantSpecificKey k)
| k `elem` ts -> commandAction (start' k)
| k `elem` ts -> commandAction (start' isterminal k)
| otherwise -> commandAction stop
_ -> do
let s = S.fromList ts
let seeker = AnnexedFileSeeker
{ startAction = start s
{ startAction = start isterminal s
, checkContentPresent = Nothing
, usesLocationLog = False
}
@ -48,14 +50,14 @@ seek o = do
where
ww = WarnUnmatchLsFiles
start :: S.Set Key -> SeekInput -> RawFilePath -> Key -> CommandStart
start s _si _file k
| S.member k s = start' k
start :: IsTerminal -> S.Set Key -> SeekInput -> RawFilePath -> Key -> CommandStart
start isterminal s _si _file k
| S.member k s = start' isterminal k
| otherwise = stop
start' :: Key -> CommandStart
start' k = startingCustomOutput k $ do
start' :: IsTerminal -> Key -> CommandStart
start' (IsTerminal isterminal) k = startingCustomOutput k $ do
tmpf <- fromRawFilePath <$> fromRepo (gitAnnexTmpObjectLocation k)
whenM (liftIO $ doesFileExist tmpf) $
liftIO $ putStrLn tmpf
liftIO $ putStrLn (if isterminal then safeOutput tmpf else tmpf)
next $ return True