registerurl,unregisterurl: rework output and support --json

* registerurl, unregisterurl: Improved output when reading from stdin
  to be more like other batch commands.
* registerurl, unregisterurl: Added --json and --json-error-messages options.

Note that this did change the --batch output in a way that could possibly
break something that expected the old output to never change. I think it's
acceptable to break that because there has never been a guarantee of
unchanging output format except with --batch for most commands. The old
output was just really weird too!

One possible wart is that "git-annex registerurl" with no options now
seems to just hang, since it's waiting for stdin input. Before, it said
"registerurl (stdin)" which was clearer about what's happenening. But this
is a deprecated mode anyway, --batch makes clear what's happening. If
anything, this problem would be a reason to eventually remove the support
for reading from stdin w/o --batch.

Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
Joey Hess 2022-02-14 13:29:20 -04:00
parent 291dc0d1a9
commit 0edf01d7d4
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 74 additions and 44 deletions

View file

@ -4,6 +4,9 @@ git-annex (10.20220128) UNRELEASED; urgency=medium
* Pass --no-textconv when running git diff internally.
* Fix git-annex forget propagation between repositories.
(reversion introduced in version 7.20190122)
* registerurl, unregisterurl: Improved output when reading from stdin
to be more like other batch commands.
* registerurl, unregisterurl: Added --json and --json-error-messages options.
-- Joey Hess <id@joeyh.name> Mon, 31 Jan 2022 13:14:42 -0400

View file

@ -86,12 +86,15 @@ start matcher force (si, (keyname, file)) = do
-- the uri scheme, to see if it looks like the prefix of a key. This relies
-- on key backend names never containing a ':'.
keyOpt :: String -> Key
keyOpt s = case parseURI s of
keyOpt = either giveup id . keyOpt'
keyOpt' :: String -> Either String Key
keyOpt' s = case parseURI s of
Just u | not (isKeyPrefix (uriScheme u)) ->
Backend.URL.fromUrl s Nothing
Right $ Backend.URL.fromUrl s Nothing
_ -> case deserializeKey s of
Just k -> k
Nothing -> giveup $ "bad key/url " ++ s
Just k -> Right k
Nothing -> Left $ "bad key/url " ++ s
perform :: AddUnlockedMatcher -> Key -> RawFilePath -> CommandPerform
perform matcher key file = lookupKeyNotHidden file >>= \case

View file

@ -1,21 +1,19 @@
{- git-annex command
-
- Copyright 2015-2018 Joey Hess <id@joeyh.name>
- Copyright 2015-2022 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE BangPatterns #-}
module Command.RegisterUrl where
import Command
import Logs.Web
import Command.FromKey (keyOpt)
import Command.FromKey (keyOpt, keyOpt')
import qualified Remote
cmd :: Command
cmd = command "registerurl"
cmd = withGlobalOptions [jsonOptions] $ command "registerurl"
SectionPlumbing "registers an url for a key"
(paramPair paramKey paramUrl)
(seek <$$> optParser)
@ -32,45 +30,39 @@ optParser desc = RegisterUrlOptions
seek :: RegisterUrlOptions -> CommandSeek
seek o = case (batchOption o, keyUrlPairs o) of
(Batch (BatchFormat sep _), _) -> batchOnly Nothing (keyUrlPairs o) $
commandAction $ startMass setUrlPresent sep
(Batch fmt, _) -> seekBatch setUrlPresent o fmt
-- older way of enabling batch input, does not support BatchNull
(NoBatch, []) -> commandAction $ startMass setUrlPresent BatchLine
(NoBatch, ps) -> withWords (commandAction . start setUrlPresent) ps
(NoBatch, []) -> seekBatch setUrlPresent o (BatchFormat BatchLine (BatchKeys False))
(NoBatch, ps) -> commandAction (start setUrlPresent ps)
seekBatch :: (Key -> URLString -> Annex ()) -> RegisterUrlOptions -> BatchFormat -> CommandSeek
seekBatch a o fmt = batchOnly Nothing (keyUrlPairs o) $
batchInput fmt (pure . parsebatch) $
batchCommandAction . start' a
where
parsebatch l =
let (keyname, u) = separate (== ' ') l
in if null u
then Left "no url provided"
else case keyOpt' keyname of
Left e -> Left e
Right k -> Right (k, u)
start :: (Key -> URLString -> Annex ()) -> [String] -> CommandStart
start a (keyname:url:[]) =
starting "registerurl" ai si $
perform a (keyOpt keyname) url
start a (keyname:url:[]) = start' a (si, (keyOpt keyname, url))
where
ai = ActionItemOther (Just url)
si = SeekInput [keyname, url]
start _ _ = giveup "specify a key and an url"
startMass :: (Key -> URLString -> Annex ()) -> BatchSeparator -> CommandStart
startMass a sep =
starting "registerurl" (ActionItemOther (Just "stdin")) (SeekInput []) $
performMass a sep
performMass :: (Key -> URLString -> Annex ()) -> BatchSeparator -> CommandPerform
performMass a sep = go True =<< map (separate (== ' ')) <$> batchLines fmt
start' :: (Key -> URLString -> Annex ()) -> (SeekInput, (Key, URLString)) -> CommandStart
start' a (si, (key, url)) =
starting "registerurl" ai si $
perform a key url
where
fmt = BatchFormat sep (BatchKeys False)
go status [] = next $ return status
go status ((keyname,u):rest) | not (null keyname) && not (null u) = do
let key = keyOpt keyname
ok <- perform' a key u
let !status' = status && ok
go status' rest
go _ _ = giveup "Expected pairs of key and url on stdin, but got something else."
ai = ActionItemOther (Just url)
perform :: (Key -> URLString -> Annex ()) -> Key -> URLString -> CommandPerform
perform a key url = do
ok <- perform' a key url
next $ return ok
perform' :: (Key -> URLString -> Annex ()) -> Key -> URLString -> Annex Bool
perform' a key url = do
r <- Remote.claimingUrl url
a key (setDownloader' url r)
return True
next $ return True

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2015-2021 Joey Hess <id@joeyh.name>
- Copyright 2015-2022 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -11,18 +11,18 @@ module Command.UnregisterUrl where
import Command
import Logs.Web
import Command.RegisterUrl (start, startMass, optParser, RegisterUrlOptions(..))
import Command.RegisterUrl (seekBatch, start, optParser, RegisterUrlOptions(..))
cmd :: Command
cmd = command "unregisterurl"
cmd = withGlobalOptions [jsonOptions] $ command "unregisterurl"
SectionPlumbing "unregisters an url for a key"
(paramPair paramKey paramUrl)
(seek <$$> optParser)
seek :: RegisterUrlOptions -> CommandSeek
seek o = case (batchOption o, keyUrlPairs o) of
(Batch (BatchFormat sep _), _) -> commandAction $ startMass unregisterUrl sep
(NoBatch, ps) -> withWords (commandAction . start unregisterUrl) ps
(Batch fmt, _) -> seekBatch unregisterUrl o fmt
(NoBatch, ps) -> commandAction (start unregisterUrl ps)
unregisterUrl :: Key -> String -> Annex ()
unregisterUrl key url = do

View file

@ -37,6 +37,16 @@ valid url, an URL key is constructed from the url.
(Note that for this to be used, you have to explicitly enable batch mode
with `--batch`)
* `--json`
Enable JSON output. This is intended to be parsed by programs that use
git-annex. Each line of output is a JSON object.
* `--json-error-messages`
Messages that would normally be output to standard error are included in
the json instead.
* Also the [[git-annex-common-options]](1) can be used.
# SEE ALSO

View file

@ -14,6 +14,9 @@ no longer be downloaded from them.
Unregistering a key's last web url will make git-annex no longer treat content
as being present in the web special remote.
Normally the key is a git-annex formatted key. However, if the key cannot be
parsed as a key, and is a valid url, an URL key is constructed from the url.
# OPTIONS
* `--batch`
@ -26,6 +29,16 @@ as being present in the web special remote.
When in batch mode, the input is delimited by nulls instead of the usual
newlines.
* `--json`
Enable JSON output. This is intended to be parsed by programs that use
git-annex. Each line of output is a JSON object.
* `--json-error-messages`
Messages that would normally be output to standard error are included in
the json instead.
* Also the [[git-annex-common-options]](1) can be used.
# SEE ALSO

View file

@ -4,3 +4,11 @@
[[!meta author=yoh]]
[[!tag projects/datalad]]
> Added --json and --json-error-messages. Note that this did change the
> --batch output in a way that could possibly break something that expected
> the old output to never change. I think it's acceptable to break that
> because there has never been a guarantee of unchanging output format
> except with --batch for most commands.
>
> [[done]] --[[Joey]]

View file

@ -14,7 +14,8 @@ a behavior change. Urk.
Aside from crashing if an invalid key is provided,
or perhaps some other exceptional error, there are no real ways it could
fail so --json-error-messages is unlikely to be useful.
fail so --json-error-messages is unlikely to be useful. But adding --json
always adds it anyway.
(unregisterurl has the same interface and mostly same implementation,
and so same problems as registerurl.)