git style quoting for ActionItemOther

Added StringContainingQuotedPath, which is used for ActionItemOther.

In the process, checked every ActionItemOther for those containing
filenames, and made them use quoting.

Sponsored-by: Graham Spencer on Patreon
This commit is contained in:
Joey Hess 2023-04-08 15:48:32 -04:00
parent d689a5b338
commit 2ba1559a8e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
41 changed files with 158 additions and 89 deletions

View file

@ -503,7 +503,7 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
in return $ Left $ Just (loc, v)
[] -> do
job <- liftIO $ newEmptyTMVarIO
let ai = ActionItemOther (Just (fromRawFilePath (fromImportLocation loc)))
let ai = ActionItemOther (Just (QuotedPath (fromImportLocation loc)))
let si = SeekInput []
let importaction = starting ("import " ++ Remote.name remote) ai si $ do
when oldversion $

View file

@ -25,7 +25,7 @@ import qualified Git
import Annex.Init
import Utility.Daemon
import Types.Transfer
import Types.ActionItem
import Types.ActionItem as ReExported
import Types.WorkerPool as ReExported
import Remote.List

View file

@ -402,7 +402,7 @@ startingAddUrl si url o p = starting "addurl" ai si $ do
-- available and get added to it. That's ok, this is only
-- used to prevent two threads running concurrently when that would
-- likely fail.
ai = OnlyActionOn urlkey (ActionItemOther (Just url))
ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url)))
urlkey = Backend.URL.fromUrl url Nothing
showDestinationFile :: FilePath -> Annex ()

View file

@ -61,7 +61,7 @@ seek (SetConfig ck@(ConfigKey name) val) = checkIsGlobalConfig ck $ commandActio
setConfig ck (fromConfigValue val)
next $ return True
where
ai = ActionItemOther (Just (fromConfigValue val))
ai = ActionItemOther (Just (UnquotedString (fromConfigValue val)))
si = SeekInput [decodeBS name]
seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $
startingUsualMessages (decodeBS name) ai si $ do

View file

@ -26,7 +26,7 @@ start (name:description) | not (null description) = do
starting "describe" ai si $
perform u $ unwords description
where
ai = ActionItemOther (Just name)
ai = ActionItemOther (Just (UnquotedString name))
si = SeekInput [name]
start _ = giveup "Specify a repository and a description."

View file

@ -71,7 +71,7 @@ startNormalRemote name restparams r
| otherwise = giveup $
"That is a normal git remote; passing these parameters does not make sense: " ++ unwords restparams
where
ai = ActionItemOther (Just name)
ai = ActionItemOther (Just (UnquotedString name))
si = SeekInput [name]
startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart
@ -92,7 +92,7 @@ startSpecialRemote name config ((u, c, mcu):[]) =
=<< Remote.byUUID u
performSpecialRemote t u c fullconfig gc mcu
where
ai = ActionItemOther (Just name)
ai = ActionItemOther (Just (UnquotedString name))
si = SeekInput [name]
startSpecialRemote _ _ _ =
giveup "Multiple remotes have that name. Either use git-annex renameremote to rename them, or specify the uuid of the remote to enable."

View file

@ -79,7 +79,7 @@ start (Expire expire) noact actlog descs u =
return $ "last active: " ++ fromDuration d ++ " ago"
_ -> return "no activity"
desc = fromUUID u ++ " " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs))
ai = ActionItemOther (Just desc)
ai = ActionItemOther (Just (UnquotedString desc))
si = SeekInput []
notexpired ent = case ent of
Unknown -> False

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2017-2019 Joey Hess <id@joeyh.name>
- Copyright 2017-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -413,13 +413,15 @@ startMoveToTempName r db f ek =
loc = mkExportLocation f'
f' = getTopFilePath f
tmploc = exportTempName ek
ai = ActionItemOther $ Just $ fromRawFilePath f' ++ " -> " ++ fromRawFilePath (fromExportLocation tmploc)
ai = ActionItemOther $ Just $
QuotedPath f' <> " -> " <> QuotedPath (fromExportLocation tmploc)
si = SeekInput []
startMoveFromTempName :: Remote -> ExportHandle -> Key -> TopFilePath -> CommandStart
startMoveFromTempName r db ek f = do
let tmploc = exportTempName ek
let ai = ActionItemOther (Just (fromRawFilePath (fromExportLocation tmploc) ++ " -> " ++ fromRawFilePath f'))
let ai = ActionItemOther $ Just $
QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f'
stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $
starting ("rename " ++ name r) ai si $
performRename r db ek tmploc loc

View file

@ -42,7 +42,7 @@ start o = starting "forget" ai si $ do
else basets
perform ts =<< Annex.getRead Annex.force
where
ai = ActionItemOther (Just (fromRef Branch.name))
ai = ActionItemOther (Just (UnquotedString (fromRef Branch.name)))
si = SeekInput []
perform :: Transitions -> Bool -> CommandPerform

View file

@ -42,7 +42,6 @@ import qualified Database.Keys
import qualified Database.Fsck as FsckDb
import Types.CleanupActions
import Types.Key
import Types.ActionItem
import qualified Utility.RawFilePath as R
import Data.Time.Clock.POSIX

View file

@ -27,7 +27,7 @@ start ps@(name:g:[]) = do
startingUsualMessages "group" ai si $
setGroup u (toGroup g)
where
ai = ActionItemOther (Just name)
ai = ActionItemOther (Just (UnquotedString name))
si = SeekInput ps
start (name:[]) = do
u <- Remote.nameToUUID name

View file

@ -27,6 +27,6 @@ start (g:[]) = startingCustomOutput (ActionItemOther Nothing) $
start ps@(g:expr:[]) = startingUsualMessages "groupwanted" ai si $
performSet groupPreferredContentSet expr (toGroup g)
where
ai = ActionItemOther (Just g)
ai = ActionItemOther (Just (UnquotedString g))
si = SeekInput ps
start _ = giveup "Specify a group."

View file

@ -351,7 +351,7 @@ listContents remote importtreeconfig ci tvar = starting "list" ai si $
liftIO $ atomically $ writeTVar tvar importable
next $ return True
where
ai = ActionItemOther (Just (Remote.name remote))
ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
si = SeekInput []
listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, Remote.ByteSize)) -> Annex a) -> Annex a
@ -373,7 +373,7 @@ commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig
importcommit <- buildImportCommit remote importtreeconfig importcommitconfig importable
next $ updateremotetrackingbranch importcommit
where
ai = ActionItemOther (Just $ fromRef $ fromRemoteTrackingBranch tb)
ai = ActionItemOther (Just $ UnquotedString $ fromRef $ fromRemoteTrackingBranch tb)
si = SeekInput []
-- Update the tracking branch. Done even when there
-- is nothing new to import, to make sure it exists.

View file

@ -43,7 +43,6 @@ import Logs.Transfer
import Types.Key
import Types.TrustLevel
import Types.FileMatcher
import Types.ActionItem
import qualified Limit
import Messages.JSON (DualDisp(..), ObjectMap(..))
import Annex.BloomFilter

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.Init where
import Command
@ -62,7 +64,7 @@ start os
starting "init" (ActionItemOther (Just "autoenable")) si $
performAutoEnableOnly
| otherwise =
starting "init" (ActionItemOther (Just $ initDesc os)) si $
starting "init" (ActionItemOther (Just $ UnquotedString $ initDesc os)) si $
perform os
where
si = SeekInput []

View file

@ -81,7 +81,7 @@ start o (name:ws) = ifM (not . null <$> findExisting name)
if whatElse o
then startingCustomOutput (ActionItemOther Nothing) $
describeOtherParamsFor c t
else starting "initremote" (ActionItemOther (Just name)) si $
else starting "initremote" (ActionItemOther (Just (UnquotedString name))) si $
perform t name c o
)
)

View file

@ -48,7 +48,7 @@ mergeAnnexBranch = starting "merge" ai si $ do
Annex.Branch.commit =<< Annex.Branch.commitMessage
next $ return True
where
ai = ActionItemOther (Just (fromRef Annex.Branch.name))
ai = ActionItemOther (Just (UnquotedString (fromRef Annex.Branch.name)))
si = SeekInput []
mergeSyncedBranch :: MergeOptions -> CommandStart
@ -63,5 +63,5 @@ mergeBranch o r = starting "merge" ai si $ do
let so = def { notOnlyAnnexOption = True }
next $ merge currbranch mc so Git.Branch.ManualCommit r
where
ai = ActionItemOther (Just (Git.fromRef r))
ai = ActionItemOther (Just (UnquotedString (Git.fromRef r)))
si = SeekInput []

View file

@ -35,5 +35,5 @@ startSet n = startingUsualMessages "mincopies" ai si $ do
setGlobalMinCopies $ configuredMinCopies n
next $ return True
where
ai = ActionItemOther (Just $ show n)
ai = ActionItemOther (Just $ UnquotedString $ show n)
si = SeekInput [show n]

View file

@ -49,5 +49,5 @@ startSet n = startingUsualMessages "numcopies" ai si $ do
setGlobalNumCopies $ configuredNumCopies n
next $ return True
where
ai = ActionItemOther (Just $ show n)
ai = ActionItemOther (Just $ UnquotedString $ show n)
si = SeekInput [show n]

View file

@ -101,7 +101,7 @@ linkRemote :: RemoteName -> CommandStart
linkRemote remotename = starting "p2p link" ai si $
next promptaddr
where
ai = ActionItemOther (Just remotename)
ai = ActionItemOther (Just (UnquotedString remotename))
si = SeekInput []
promptaddr = do
liftIO $ putStrLn ""
@ -131,7 +131,7 @@ startPairing remotename addrs = ifM (liftIO Wormhole.isInstalled)
, giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/"
)
where
ai = ActionItemOther (Just remotename)
ai = ActionItemOther (Just (UnquotedString remotename))
si = SeekInput []
performPairing :: RemoteName -> [P2PAddress] -> CommandPerform

View file

@ -63,7 +63,7 @@ start' a o (si, (key, url)) =
starting "registerurl" ai si $
perform a o key url
where
ai = ActionItemOther (Just url)
ai = ActionItemOther (Just (UnquotedString url))
perform :: (Remote -> Key -> URLString -> Annex ()) -> RegisterUrlOptions -> Key -> URLString -> CommandPerform
perform a o key url = do

View file

@ -24,9 +24,10 @@ seek :: CmdParams -> CommandSeek
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start ws = starting "reinit" (ActionItemOther (Just s)) (SeekInput ws) $
start ws = starting "reinit" ai (SeekInput ws) $
perform s
where
ai = ActionItemOther (Just (UnquotedString s))
s = unwords ws
perform :: String -> CommandPerform

View file

@ -56,7 +56,7 @@ startSrcDest ps@(src:dest:[])
( perform src' key
, giveup $ src ++ " does not have expected content of " ++ dest
)
ai = ActionItemOther (Just src)
ai = ActionItemOther (Just (QuotedPath src'))
si = SeekInput ps
startSrcDest _ = giveup "specify a src file and a dest file"
@ -73,7 +73,7 @@ startKnown src = notAnnexed src' $
where
src' = toRawFilePath src
ks = KeySource src' src' Nothing
ai = ActionItemOther (Just src)
ai = ActionItemOther (Just (QuotedPath src'))
si = SeekInput [src]
notAnnexed :: RawFilePath -> CommandStart -> CommandStart

View file

@ -31,7 +31,7 @@ start = parse
performGet u
parse ps@(name:expr:[]) = do
u <- Remote.nameToUUID name
let ai = ActionItemOther (Just name)
let ai = ActionItemOther (Just (UnquotedString name))
let si = SeekInput ps
startingUsualMessages "schedule" ai si $
performSet expr u

View file

@ -21,10 +21,11 @@ seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start ps@(keyname:file:[]) = starting "setkey" ai si $
perform (toRawFilePath file) (keyOpt keyname)
perform file' (keyOpt keyname)
where
ai = ActionItemOther (Just file)
ai = ActionItemOther (Just (QuotedPath file'))
si = SeekInput ps
file' = toRawFilePath file
start _ = giveup "specify a key and a content file"
keyOpt :: String -> Key

View file

@ -392,7 +392,7 @@ mergeLocal' mergeconfig o currbranch@(Just branch, _) =
needMerge currbranch branch >>= \case
Nothing -> stop
Just syncbranch -> do
let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
let ai = ActionItemOther (Just $ UnquotedString $ Git.Ref.describe syncbranch)
let si = SeekInput []
starting "merge" ai si $
next $ merge currbranch mergeconfig o Git.Branch.ManualCommit syncbranch
@ -400,7 +400,7 @@ mergeLocal' _ _ currbranch@(Nothing, _) = inRepo Git.Branch.currentUnsafe >>= \c
Just branch -> needMerge currbranch branch >>= \case
Nothing -> stop
Just syncbranch -> do
let ai = ActionItemOther (Just $ Git.Ref.describe syncbranch)
let ai = ActionItemOther (Just $ UnquotedString $ Git.Ref.describe syncbranch)
let si = SeekInput []
starting "merge" ai si $ do
warning $ "There are no commits yet to branch " ++ Git.fromRef branch ++ ", so cannot merge " ++ Git.fromRef syncbranch ++ " into it."
@ -513,7 +513,7 @@ pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && want
, Just $ Param $ Remote.name remote
] ++ map Param bs
wantpull = remoteAnnexPull (Remote.gitconfig remote)
ai = ActionItemOther (Just (Remote.name remote))
ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
si = SeekInput []
importRemote :: Bool -> SyncOptions -> Remote -> CurrBranch -> CommandSeek
@ -559,7 +559,7 @@ pullThirdPartyPopulated o remote
Nothing -> next $ return False
go Nothing = next $ return True -- unchanged from before
ai = ActionItemOther (Just (Remote.name remote))
ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
si = SeekInput []
wantpull = remoteAnnexPull (Remote.gitconfig remote)
@ -607,7 +607,7 @@ pushRemote o remote (Just branch, _) = do
warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
return ok
where
ai = ActionItemOther (Just (Remote.name remote))
ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
si = SeekInput []
gc = Remote.gitconfig remote
needpush mainbranch
@ -1003,7 +1003,7 @@ cleanupRemote remote (Just b, _) =
Git.Ref.base $ Annex.Branch.name
]
where
ai = ActionItemOther (Just (Remote.name remote))
ai = ActionItemOther (Just (UnquotedString (Remote.name remote)))
si = SeekInput []
shouldSyncContent :: SyncOptions -> Annex Bool

View file

@ -73,7 +73,7 @@ seek :: TestRemoteOptions -> CommandSeek
seek = commandAction . start
start :: TestRemoteOptions -> CommandStart
start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do
start o = starting "testremote" (ActionItemOther (Just (UnquotedString (testRemote o)))) si $ do
fast <- Annex.getRead Annex.fast
cache <- liftIO newRemoteVariantCache
r <- either giveup (disableExportTree cache)

View file

@ -30,7 +30,7 @@ trustCommand c level ps = withStrings (commandAction . start) ps
start name = do
u <- Remote.nameToUUID name
let si = SeekInput [name]
starting c (ActionItemOther (Just name)) si (perform name u)
starting c (ActionItemOther (Just (UnquotedString name))) si (perform name u)
perform name uuid = do
when (level >= Trusted) $
unlessM (Annex.getRead Annex.force) $

View file

@ -45,7 +45,7 @@ start :: FilePath -> CommandStart
start p = starting "undo" ai si $
perform p
where
ai = ActionItemOther (Just p)
ai = ActionItemOther (Just (QuotedPath (toRawFilePath p)))
si = SeekInput [p]
perform :: FilePath -> CommandPerform

View file

@ -24,8 +24,9 @@ seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start (name:g:[]) = do
u <- Remote.nameToUUID name
starting "ungroup" (ActionItemOther (Just name)) (SeekInput [name, g]) $
perform u (toGroup g)
starting "ungroup" (ActionItemOther (Just (UnquotedString name)))
(SeekInput [name, g]) $
perform u (toGroup g)
start _ = giveup "Specify a repository and a group."
perform :: UUID -> Group -> CommandPerform

View file

@ -73,7 +73,7 @@ start o = do
Just "." -> (".", checkUnused refspec)
Just "here" -> (".", checkUnused refspec)
Just n -> (n, checkRemoteUnused n refspec)
starting "unused" (ActionItemOther (Just name)) (SeekInput []) perform
starting "unused" (ActionItemOther (Just (UnquotedString name))) (SeekInput []) perform
checkUnused :: RefSpec -> CommandPerform
checkUnused refspec = chain 0
@ -337,6 +337,6 @@ startUnused message unused badunused tmpunused maps n = search
case M.lookup n m of
Nothing -> search rest
Just key -> starting message
(ActionItemOther $ Just $ show n)
(ActionItemOther $ Just $ UnquotedString $ show n)
(SeekInput [])
(a key)

View file

@ -48,6 +48,6 @@ start ps = go =<< currentView
num = fromMaybe 1 $ readish =<< headMaybe ps
ai = ActionItemOther (Just $ show num)
ai = ActionItemOther (Just $ UnquotedString $ show num)
si = SeekInput ps

View file

@ -39,7 +39,7 @@ cmd' name desc getter setter = noMessages $
start ps@(rname:expr:[]) = do
u <- Remote.nameToUUID rname
let si = SeekInput ps
let ai = ActionItemOther (Just rname)
let ai = ActionItemOther (Just (UnquotedString rname))
startingUsualMessages name ai si $
performSet setter expr u
start _ = giveup "Specify a repository."

View file

@ -133,6 +133,6 @@ parserDiffRaw f = DiffTreeItem
<*> (maybe (fail "bad dstsha") return . extractSha =<< nextword)
<* A8.char ' '
<*> A.takeByteString
<*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f)
<*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.unquote f)
where
nextword = A8.takeTill (== ' ')

View file

@ -5,7 +5,7 @@
- top of the repository even when run in a subdirectory. Adding some
- types helps keep that straight.
-
- Copyright 2012-2019 Joey Hess <id@joeyh.name>
- Copyright 2012-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -51,7 +51,7 @@ data BranchFilePath = BranchFilePath Ref TopFilePath
{- Git uses the branch:file form to refer to a BranchFilePath -}
descBranchFilePath :: Filename.QuotePath -> BranchFilePath -> S.ByteString
descBranchFilePath qp (BranchFilePath b f) =
fromRef' b <> ":" <> Filename.encode qp (getTopFilePath f)
fromRef' b <> ":" <> Filename.quote qp (getTopFilePath f)
{- Path to a TopFilePath, within the provided git repo. -}
fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath

View file

@ -1,4 +1,4 @@
{- Some git commands output encoded filenames, in a rather annoyingly complex
{- Some git commands output quoted filenames, in a rather annoyingly complex
- C-style encoding.
-
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
@ -6,9 +6,15 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}
module Git.Filename where
module Git.Filename (
unquote,
quote,
QuotePath(..),
StringContainingQuotedPath(..),
prop_quote_unquote_roundtrip,
) where
import Common
import Utility.Format (decode_c, encode_c, encode_c', isUtf8Byte)
@ -16,11 +22,13 @@ import Utility.QuickCheck
import Data.Char
import Data.Word
import Data.String
import qualified Data.ByteString as S
import qualified Data.Semigroup as Sem
import Prelude
-- encoded filenames will be inside double quotes
decode :: S.ByteString -> RawFilePath
decode b = case S.uncons b of
unquote :: S.ByteString -> RawFilePath
unquote b = case S.uncons b of
Nothing -> b
Just (h, t)
| h /= q -> b
@ -34,24 +42,51 @@ decode b = case S.uncons b of
q = fromIntegral (ord '"')
-- always encodes and double quotes, even in cases that git does not
encodeAlways :: RawFilePath -> S.ByteString
encodeAlways s = "\"" <> encode_c needencode s <> "\""
quoteAlways :: RawFilePath -> S.ByteString
quoteAlways s = "\"" <> encode_c needencode s <> "\""
where
needencode c = isUtf8Byte c || c == fromIntegral (ord '"')
-- git config core.quotePath controls whether to quote unicode characters
newtype QuotePath = QuotePath Bool
-- encodes and double quotes when git would
encode :: QuotePath -> RawFilePath -> S.ByteString
encode (QuotePath qp) s = case encode_c' needencode s of
Nothing -> s
Just s' -> "\"" <> s' <> "\""
where
needencode c
| c == fromIntegral (ord '"') = True
| qp = isUtf8Byte c
| otherwise = False
class Quoteable t where
-- double quotes and encodes when git would
quote :: QuotePath -> t -> S.ByteString
instance Quoteable RawFilePath where
quote (QuotePath qp) s = case encode_c' needencode s of
Nothing -> s
Just s' -> "\"" <> s' <> "\""
where
needencode c
| c == fromIntegral (ord '"') = True
| qp = isUtf8Byte c
| otherwise = False
-- Allows building up a string that contains paths, which will get quoted.
-- With OverloadedStrings, strings are passed through without quoting.
-- Eg: QuotedPath f <> ": not found"
data StringContainingQuotedPath
= UnquotedString String
| QuotedPath RawFilePath
| StringContainingQuotedPathMulti [StringContainingQuotedPath]
deriving (Show, Eq)
instance Quoteable StringContainingQuotedPath where
quote _ (UnquotedString s) = encodeBS s
quote qp (QuotedPath p) = quote qp p
quote qp (StringContainingQuotedPathMulti l) = S.concat (map (quote qp) l)
instance IsString StringContainingQuotedPath where
fromString = UnquotedString
instance Sem.Semigroup StringContainingQuotedPath where
UnquotedString a <> UnquotedString b = UnquotedString (a <> b)
a <> b = StringContainingQuotedPathMulti [a, b]
instance Monoid StringContainingQuotedPath where
mempty = UnquotedString mempty
-- Encoding and then decoding roundtrips only when the string does not
-- contain high unicode, because eg, both "\12345" and "\227\128\185"
@ -59,8 +94,8 @@ encode (QuotePath qp) s = case encode_c' needencode s of
--
-- That is not a real-world problem, and using TestableFilePath
-- limits what's tested to ascii, so avoids running into it.
prop_encode_decode_roundtrip :: TestableFilePath -> Bool
prop_encode_decode_roundtrip ts =
s == fromRawFilePath (decode (encodeAlways (toRawFilePath s)))
prop_quote_unquote_roundtrip :: TestableFilePath -> Bool
prop_quote_unquote_roundtrip ts =
s == fromRawFilePath (unquote (quoteAlways (toRawFilePath s)))
where
s = fromTestableFilePath ts

View file

@ -137,7 +137,7 @@ parserLsTree long = case long of
-- sha
<*> (Ref <$> A8.takeTill A8.isSpace)
fileparser = asTopFilePath . Git.Filename.decode <$> A.takeByteString
fileparser = asTopFilePath . Git.Filename.unquote <$> A.takeByteString
sizeparser = fmap Just A8.decimal

View file

@ -89,6 +89,12 @@ showStartOther command mdesc si = outputMessage json $ encodeBS $
where
json = JSON.start command Nothing Nothing si
showStartNothing :: String -> SeekInput -> Annex ()
showStartNothing command si = outputMessage json $ encodeBS $
command ++ " "
where
json = JSON.start command Nothing Nothing si
showStartMessage :: StartMessage -> Annex ()
showStartMessage (StartMessage command ai si) = case ai of
ActionItemAssociatedFile _ _ -> showStartActionItem command ai si
@ -96,7 +102,8 @@ showStartMessage (StartMessage command ai si) = case ai of
ActionItemBranchFilePath _ _ -> showStartActionItem command ai si
ActionItemFailedTransfer _ _ -> showStartActionItem command ai si
ActionItemTreeFile _ -> showStartActionItem command ai si
ActionItemOther msg -> showStartOther command msg si
ActionItemOther Nothing -> showStartNothing command si
ActionItemOther _ -> showStartActionItem command ai si
OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
showStartMessage (StartUsualMessages command ai si) = do
outputType <$> Annex.getState Annex.output >>= \case

View file

@ -151,7 +151,7 @@ tests n crippledfilesystem adjustedbranchok opts =
properties :: TestTree
properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $
[ testProperty "prop_encode_decode_roundtrip" Git.Filename.prop_encode_decode_roundtrip
[ testProperty "prop_quote_unquote_roundtrip" Git.Filename.prop_quote_unquote_roundtrip
, testProperty "prop_encode_c_decode_c_roundtrip" Utility.Format.prop_encode_c_decode_c_roundtrip
, testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode
, testProperty "prop_isomorphic_shellEscape" Utility.ShellEscape.prop_isomorphic_shellEscape

View file

@ -7,7 +7,10 @@
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Types.ActionItem where
module Types.ActionItem (
module Types.ActionItem,
Git.Filename.StringContainingQuotedPath(..),
) where
import Key
import Types.Transfer
@ -15,7 +18,6 @@ import Git.FilePath
import qualified Git.Filename
import Utility.FileSystemEncoding
import Data.Maybe
import qualified Data.ByteString as S
data ActionItem
@ -24,7 +26,7 @@ data ActionItem
| ActionItemBranchFilePath BranchFilePath Key
| ActionItemFailedTransfer Transfer TransferInfo
| ActionItemTreeFile RawFilePath
| ActionItemOther (Maybe String)
| ActionItemOther (Maybe Git.Filename.StringContainingQuotedPath)
-- Use to avoid more than one thread concurrently processing the
-- same Key.
| OnlyActionOn Key ActionItem
@ -59,15 +61,16 @@ instance MkActionItem (Transfer, TransferInfo) where
actionItemDesc :: Git.Filename.QuotePath -> ActionItem -> S.ByteString
actionItemDesc qp (ActionItemAssociatedFile (AssociatedFile (Just f)) _) =
Git.Filename.encode qp f
Git.Filename.quote qp f
actionItemDesc _ (ActionItemAssociatedFile (AssociatedFile Nothing) k) =
serializeKey' k
actionItemDesc _ (ActionItemKey k) = serializeKey' k
actionItemDesc qp (ActionItemBranchFilePath bfp _) = descBranchFilePath qp bfp
actionItemDesc qp (ActionItemFailedTransfer t i) = actionItemDesc qp $
ActionItemAssociatedFile (associatedFile i) (transferKey t)
actionItemDesc qp (ActionItemTreeFile f) = Git.Filename.encode qp f
actionItemDesc _ (ActionItemOther s) = encodeBS (fromMaybe "" s)
actionItemDesc qp (ActionItemTreeFile f) = Git.Filename.quote qp f
actionItemDesc _ (ActionItemOther Nothing) = mempty
actionItemDesc qp (ActionItemOther (Just v)) = Git.Filename.quote qp v
actionItemDesc qp (OnlyActionOn _ ai) = actionItemDesc qp ai
actionItemKey :: ActionItem -> Maybe Key

View file

@ -12,14 +12,6 @@ working on or in messages.
pipeable, and so should have raw filenames. Note that `find` actually
escapes such filenames when outputting to a terminal, but not a pipe.
It's possible that keys can also contain an escape sequence, eg in the
extension of a SHA-E key. So commands like `git-annex lookupkey`
and `git-annex find` that output keys might need to handle
that, when outputting to a terminal?
`git-annex metadata` could also contain an escape sequence. So could
`git-annex config --get`.
git porcelain also accepts the escaped form of files as input, necessary for
round-tripping though. git-annex currently does not. (git plumbing doesn't
either)
@ -40,3 +32,30 @@ behave more like git.
> Note that core.quotePath controls whether git quotes unicode characters
> (by default it does), so once this gets implemented, some users may want
> to set that config to false. --[[Joey]]
> Update: Most git-annex commands now quote filenames, due to work on
> ActionItem display. `git-annex find`, `git-annex info $file`,
> and everywhere filenames get
> embedded in error messages, warnings, info messages, still need to be done.
----
Also:
It's possible that keys can also contain an escape sequence, eg in the
extension of a SHA-E key. So commands like `git-annex lookupkey`
and `git-annex find` that output keys might need to handle
that, when outputting to a terminal?
Also:
`git-annex metadata` could also contain an escape sequence. So could
`git-annex config --get` and `git-annex schedule` and `git-annex wanted`
and `git-annex required` and `git-annex group`. And so could the
description of a repository. It seems that git-annex could just filter out
control characters from all of these, since they are not filenames, and
any control characters in them are surely malicious.
Also: git-annex importfeed displays urls from the feed, and should filter
out control characters. If such an url even can be parsed?
Also: git-annex initremote with autoenable may be able to cause a remote
with a malicious name to be set up?