Added -z option to git-annex commands that use --batch, useful for
supporting filenames containing newlines.

It only controls input to --batch, the output will still be line delimited
unless --json or etc is used to get some other output. While git often
makes -z affect both input and output, I don't like trying them together,
and making it affect output would have been a significant complication,
and also git-annex output is generally not intended to be machine parsed,
unless using --json or a format option.

Commands that take pairs like "file key" still separate them with a space
in --batch mode. All such commands take care to support filenames with
spaces when parsing that, so there was no need to change it, and it would
have needed significant changes to the batch machinery to separate tose
with a null.

To make fromkey and registerurl support -z, I had to give them a --batch
option. The implicit batch mode they enter when not provided with input
parameters does not support -z as that would have complicated option
parsing. Seemed better to move these toward using the same --batch as
everything else, though the implicit batch mode can still be used.

This commit was sponsored by Ole-Morten Duesund on Patreon.
This commit is contained in:
Joey Hess 2018-09-20 16:09:21 -04:00
parent 2aae6e84af
commit 1d1054faa6
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
34 changed files with 209 additions and 67 deletions

View file

@ -59,10 +59,10 @@ seek o = allowConcurrentOutput $ do
)
)
case batchOption o of
Batch
Batch fmt
| updateOnly o ->
giveup "--update --batch is not supported"
| otherwise -> batchFilesMatching gofile
| otherwise -> batchFilesMatching fmt gofile
NoBatch -> do
l <- workTreeItems (addThese o)
let go a = a gofile l

View file

@ -97,7 +97,7 @@ seek :: AddUrlOptions -> CommandSeek
seek o = allowConcurrentOutput $ do
forM_ (addUrls o) (\u -> go (o, u))
case batchOption o of
Batch -> batchInput (parseBatchInput o) go
Batch fmt -> batchInput fmt (parseBatchInput o) go
NoBatch -> noop
where
go (o', u) = do

View file

@ -33,12 +33,12 @@ seek o = case batchOption o of
(ks:rn:[]) -> toRemote rn >>= (check ks . Just) >>= exitResult
(ks:[]) -> check ks Nothing >>= exitResult
_ -> wrongnumparams
Batch -> do
Batch fmt -> do
checker <- case params o of
(rn:[]) -> toRemote rn >>= \r -> return (flip check (Just r))
[] -> return (flip check Nothing)
_ -> wrongnumparams
batchInput Right $ checker >=> batchResult
batchInput fmt Right $ checker >=> batchResult
where
wrongnumparams = giveup "Wrong number of parameters"

View file

@ -47,7 +47,7 @@ seek :: CopyOptions -> CommandSeek
seek o = allowConcurrentOutput $ do
let go = whenAnnexed $ start o
case batchOption o of
Batch -> batchFilesMatching go
Batch fmt -> batchFilesMatching fmt go
NoBatch -> withKeyOptions
(keyOptions o) (autoMode o)
(Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)

View file

@ -54,7 +54,7 @@ parseDropFromOption = parseRemoteOption <$> strOption
seek :: DropOptions -> CommandSeek
seek o = allowConcurrentOutput $
case batchOption o of
Batch -> batchFilesMatching go
Batch fmt -> batchFilesMatching fmt go
NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
(startKeys o)
(withFilesInGit go)

View file

@ -35,7 +35,7 @@ seek o = do
giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
withKeys start (toDrop o)
case batchOption o of
Batch -> batchInput parsekey $ batchCommandAction . start
Batch fmt -> batchInput fmt parsekey $ batchCommandAction . start
NoBatch -> noop
where
parsekey = maybe (Left "bad key") Right . file2key

View file

@ -51,7 +51,7 @@ parseFormatOption =
seek :: FindOptions -> CommandSeek
seek o = case batchOption o of
NoBatch -> withFilesInGit go =<< workTreeItems (findThese o)
Batch -> batchFilesMatching go
Batch fmt -> batchFilesMatching fmt go
where
go = whenAnnexed $ start o

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2010, 2015 Joey Hess <id@joeyh.name>
- Copyright 2010-2018 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -21,13 +21,26 @@ cmd :: Command
cmd = notDirect $ notBareRepo $
command "fromkey" SectionPlumbing "adds a file using a specific key"
(paramRepeating (paramPair paramKey paramPath))
(withParams seek)
(seek <$$> optParser)
seek :: CmdParams -> CommandSeek
seek [] = withNothing startMass []
seek ps = do
force <- Annex.getState Annex.force
withPairs (start force) ps
data FromKeyOptions = FromKeyOptions
{ keyFilePairs :: CmdParams
, batchOption :: BatchMode
}
optParser :: CmdParamsDesc -> Parser FromKeyOptions
optParser desc = FromKeyOptions
<$> cmdParams desc
<*> parseBatchOption
seek :: FromKeyOptions -> CommandSeek
seek o = case (batchOption o, keyFilePairs o) of
(Batch fmt, _) -> withNothing (startMass fmt) []
-- older way of enabling batch input, does not support BatchNull
(NoBatch, []) -> withNothing (startMass BatchLine) []
(NoBatch, ps) -> do
force <- Annex.getState Annex.force
withPairs (start force) ps
start :: Bool -> (String, FilePath) -> CommandStart
start force (keyname, file) = do
@ -39,13 +52,13 @@ start force (keyname, file) = do
showStart "fromkey" file
next $ perform key file
startMass :: CommandStart
startMass = do
startMass :: BatchFormat -> CommandStart
startMass fmt = do
showStart' "fromkey" (Just "stdin")
next massAdd
next (massAdd fmt)
massAdd :: CommandPerform
massAdd = go True =<< map (separate (== ' ')) <$> batchLines
massAdd :: BatchFormat -> CommandPerform
massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt
where
go status [] = next $ return status
go status ((keyname,f):rest) | not (null keyname) && not (null f) = do

View file

@ -42,7 +42,7 @@ seek o = allowConcurrentOutput $ do
from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
let go = whenAnnexed $ start o from
case batchOption o of
Batch -> batchFilesMatching go
Batch fmt -> batchFilesMatching fmt go
NoBatch -> withKeyOptions (keyOptions o) (autoMode o)
(startKeys from)
(withFilesInGit go)

View file

@ -133,7 +133,7 @@ optParser desc = InfoOptions
seek :: InfoOptions -> CommandSeek
seek o = case batchOption o of
NoBatch -> withWords (start o) (infoFor o)
Batch -> batchInput Right (itemInfo o)
Batch fmt -> batchInput fmt Right (itemInfo o)
start :: InfoOptions -> [String] -> CommandStart
start o [] = do

View file

@ -83,10 +83,10 @@ seek o = case batchOption o of
(startKeys c o)
(seeker $ whenAnnexed $ start c o)
=<< workTreeItems (forFiles o)
Batch -> withMessageState $ \s -> case outputType s of
Batch fmt -> withMessageState $ \s -> case outputType s of
JSONOutput _ -> ifM limited
( giveup "combining --batch with file matching options is not currently supported"
, batchInput parseJSONInput $
, batchInput fmt parseJSONInput $
commandAction . startBatch
)
_ -> giveup "--batch is currently only supported in --json mode"

View file

@ -57,7 +57,7 @@ seek :: MoveOptions -> CommandSeek
seek o = allowConcurrentOutput $ do
let go = whenAnnexed $ start (fromToOptions o) (removeWhen o)
case batchOption o of
Batch -> batchFilesMatching go
Batch fmt -> batchFilesMatching fmt go
NoBatch -> withKeyOptions (keyOptions o) False
(startKey (fromToOptions o) (removeWhen o))
(withFilesInGit go)

View file

@ -49,7 +49,7 @@ batchParser s = case separate (== ' ') (reverse s) of
seek :: ReKeyOptions -> CommandSeek
seek o = case batchOption o of
Batch -> batchInput batchParser (batchCommandAction . start)
Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)
NoBatch -> withPairs (start . parsekey) (reKeyThese o)
where
parsekey (file, skey) =

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2015 Joey Hess <id@joeyh.name>
- Copyright 2015-2018 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -19,23 +19,39 @@ cmd = notDirect $ notBareRepo $
command "registerurl"
SectionPlumbing "registers an url for a key"
(paramPair paramKey paramUrl)
(withParams seek)
(seek <$$> optParser)
seek :: CmdParams -> CommandSeek
seek = withWords start
data RegisterUrlOptions = RegisterUrlOptions
{ keyUrlPairs :: CmdParams
, batchOption :: BatchMode
}
optParser :: CmdParamsDesc -> Parser RegisterUrlOptions
optParser desc = RegisterUrlOptions
<$> cmdParams desc
<*> parseBatchOption
seek :: RegisterUrlOptions -> CommandSeek
seek o = case (batchOption o, keyUrlPairs o) of
(Batch fmt, _) -> withNothing (startMass fmt) []
-- older way of enabling batch input, does not support BatchNull
(NoBatch, []) -> withNothing (startMass BatchLine) []
(NoBatch, ps) -> withWords start ps
start :: [String] -> CommandStart
start (keyname:url:[]) = do
let key = mkKey keyname
showStart' "registerurl" (Just url)
next $ perform key url
start [] = do
showStart' "registerurl" (Just "stdin")
next massAdd
start _ = giveup "specify a key and an url"
massAdd :: CommandPerform
massAdd = go True =<< map (separate (== ' ')) <$> batchLines
startMass :: BatchFormat -> CommandStart
startMass fmt = do
showStart' "registerurl" (Just "stdin")
next (massAdd fmt)
massAdd :: BatchFormat -> CommandPerform
massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt
where
go status [] = next $ return status
go status ((keyname,u):rest) | not (null keyname) && not (null u) = do

View file

@ -30,7 +30,7 @@ optParser desc = RmUrlOptions
seek :: RmUrlOptions -> CommandSeek
seek o = case batchOption o of
Batch -> batchInput batchParser (batchCommandAction . start)
Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)
NoBatch -> withPairs start (rmThese o)
-- Split on the last space, since a FilePath can contain whitespace,

View file

@ -30,7 +30,7 @@ optParser desc = SetPresentKeyOptions
seek :: SetPresentKeyOptions -> CommandSeek
seek o = case batchOption o of
Batch -> batchInput
Batch fmt -> batchInput fmt
(parseKeyStatus . words)
(batchCommandAction . start)
NoBatch -> either giveup (commandAction . start)

View file

@ -40,7 +40,7 @@ seek o = do
m <- remoteMap id
let go = whenAnnexed $ start m
case batchOption o of
Batch -> batchFilesMatching go
Batch fmt -> batchFilesMatching fmt go
NoBatch ->
withKeyOptions (keyOptions o) False
(startKeys m)