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:
parent
d689a5b338
commit
2ba1559a8e
41 changed files with 158 additions and 89 deletions
|
@ -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 $
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 []
|
||||
|
|
|
@ -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
|
||||
)
|
||||
)
|
||||
|
|
|
@ -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 []
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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) $
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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 (== ' ')
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
2
Test.hs
2
Test.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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?
|
||||
|
|
Loading…
Reference in a new issue