From eb594c710e162b47c72d80d5abff244084005b85 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Mar 2021 14:28:24 -0400 Subject: [PATCH] unregisterurl: New command Implemented by generalizing registerurl. Without the implicit batch mode of registerurl since that is only a backwards compatability thing (see commit 1d1054faa6989acb716d620266a0a0a8a2ec407e). --- CHANGELOG | 3 ++- CmdLine/GitAnnex.hs | 4 ++- Command/RegisterUrl.hs | 38 +++++++++++++------------- Command/UnregisterUrl.hs | 25 ++++++++++++++++++ doc/git-annex-registerurl.mdwn | 11 +++++--- doc/git-annex-unregisterurl.mdwn | 41 +++++++++++++++++++++++++++++ doc/git-annex.mdwn | 6 +++++ doc/todo/unregisterurl_KEY_URL.mdwn | 2 ++ git-annex.cabal | 1 + 9 files changed, 106 insertions(+), 25 deletions(-) create mode 100644 Command/UnregisterUrl.hs create mode 100644 doc/git-annex-unregisterurl.mdwn diff --git a/CHANGELOG b/CHANGELOG index a11e547350..c3debfd120 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,8 +1,9 @@ git-annex (8.20210224) UNRELEASED; urgency=medium + * unregisterurl: New command. + * registerurl: Allow it to be used in a bare repository. * Windows: Correct the path to the html help file for 64 bit build. * uninit: Fix a small bug that left a lock file in .git/annex - * registerurl: Allow it to be used in a bare repository. -- Joey Hess Wed, 24 Feb 2021 13:18:38 -0400 diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index ecf43678d5..ac2b9b8216 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -1,6 +1,6 @@ {- git-annex main program - - - Copyright 2010-2019 Joey Hess + - Copyright 2010-2021 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -33,6 +33,7 @@ import qualified Command.ExamineKey import qualified Command.MatchExpression import qualified Command.FromKey import qualified Command.RegisterUrl +import qualified Command.UnregisterUrl import qualified Command.SetKey import qualified Command.DropKey import qualified Command.Transferrer @@ -178,6 +179,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator = map addGitAnnexGlobalOption , Command.MatchExpression.cmd , Command.FromKey.cmd , Command.RegisterUrl.cmd + , Command.UnregisterUrl.cmd , Command.SetKey.cmd , Command.DropKey.cmd , Command.Transferrer.cmd diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs index 333c8d7522..583b170143 100644 --- a/Command/RegisterUrl.hs +++ b/Command/RegisterUrl.hs @@ -32,43 +32,43 @@ optParser desc = RegisterUrlOptions seek :: RegisterUrlOptions -> CommandSeek seek o = case (batchOption o, keyUrlPairs o) of - (Batch fmt, _) -> commandAction $ startMass fmt + (Batch fmt, _) -> commandAction $ startMass setUrlPresent fmt -- older way of enabling batch input, does not support BatchNull - (NoBatch, []) -> commandAction $ startMass BatchLine - (NoBatch, ps) -> withWords (commandAction . start) ps + (NoBatch, []) -> commandAction $ startMass setUrlPresent BatchLine + (NoBatch, ps) -> withWords (commandAction . start setUrlPresent) ps -start :: [String] -> CommandStart -start (keyname:url:[]) = +start :: (Key -> URLString -> Annex ()) -> [String] -> CommandStart +start a (keyname:url:[]) = starting "registerurl" ai si $ - perform (keyOpt keyname) url + perform a (keyOpt keyname) url where ai = ActionItemOther (Just url) si = SeekInput [keyname, url] -start _ = giveup "specify a key and an url" +start _ _ = giveup "specify a key and an url" -startMass :: BatchFormat -> CommandStart -startMass fmt = +startMass :: (Key -> URLString -> Annex ()) -> BatchFormat -> CommandStart +startMass a fmt = starting "registerurl" (ActionItemOther (Just "stdin")) (SeekInput []) $ - massAdd fmt + performMass a fmt -massAdd :: BatchFormat -> CommandPerform -massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt +performMass :: (Key -> URLString -> Annex ()) -> BatchFormat -> CommandPerform +performMass a 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 let key = keyOpt keyname - ok <- perform' key u + 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." -perform :: Key -> URLString -> CommandPerform -perform key url = do - ok <- perform' key 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 Bool -perform' key url = do +perform' :: (Key -> URLString -> Annex ()) -> Key -> URLString -> Annex Bool +perform' a key url = do r <- Remote.claimingUrl url - setUrlPresent key (setDownloader' url r) + a key (setDownloader' url r) return True diff --git a/Command/UnregisterUrl.hs b/Command/UnregisterUrl.hs new file mode 100644 index 0000000000..6a44248b2f --- /dev/null +++ b/Command/UnregisterUrl.hs @@ -0,0 +1,25 @@ +{- git-annex command + - + - Copyright 2015-2021 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE BangPatterns #-} + +module Command.UnregisterUrl where + +import Command +import Logs.Web +import Command.RegisterUrl (start, startMass, optParser, RegisterUrlOptions(..)) + +cmd :: Command +cmd = 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 fmt, _) -> commandAction $ startMass setUrlMissing fmt + (NoBatch, ps) -> withWords (commandAction . start setUrlMissing) ps diff --git a/doc/git-annex-registerurl.mdwn b/doc/git-annex-registerurl.mdwn index 0a2cf4e42c..703bf8f0e7 100644 --- a/doc/git-annex-registerurl.mdwn +++ b/doc/git-annex-registerurl.mdwn @@ -13,10 +13,6 @@ key can be downloaded from. No verification is performed of the url's contents. -If no key and url pair are specified on the command line, -batch input is used, the same as if the --batch option were -specified. - Normally the key is a git-annex formatted key. However, to make it easier to use this to add urls, if the key cannot be parsed as a key, and is a valid url, an URL key is constructed from the url. @@ -28,6 +24,11 @@ valid url, an URL key is constructed from the url. In batch input mode, lines are read from stdin, and each line should contain a key and url, separated by a single space. + For backwards compatability with old git-annex before this option + was added, when no key and url pair are specified on the command line, + batch input is used, the same as if the --batch option were + specified. It is however recommended to use --batch. + * `-z` When in batch mode, the input is delimited by nulls instead of the usual @@ -42,6 +43,8 @@ valid url, an URL key is constructed from the url. [[git-annex-addurl]](1) +[[git-annex-unregisterurl]](1) + # AUTHOR Joey Hess diff --git a/doc/git-annex-unregisterurl.mdwn b/doc/git-annex-unregisterurl.mdwn new file mode 100644 index 0000000000..bf582d645c --- /dev/null +++ b/doc/git-annex-unregisterurl.mdwn @@ -0,0 +1,41 @@ +# NAME + +git-annex unregisterurl - unregisters an url for a key + +# SYNOPSIS + +git annex unregisterurl `[key url]` + +# DESCRIPTION + +This plumbing-level command can be used to unregister urls when keys can +no longer be downloaded from them. + +Unregistering a key's last url will make git-annex no longer treat content +as being present in the web special remote. + +# OPTIONS + +* `--batch` + + In batch input mode, lines are read from stdin, and each line + should contain a key and url, separated by a single space. + +* `-z` + + When in batch mode, the input is delimited by nulls instead of the usual + newlines. + +# SEE ALSO + +[[git-annex]](1) + +[[git-annex-registerurl]](1) + +[[git-annex-rmurl]](1) + +# AUTHOR + +Joey Hess + +Warning: Automatically converted into a man page by mdwn2man. Edit with care. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 46d200e176..aca92e37b4 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -618,6 +618,12 @@ content from the key-value store. Registers an url for a key. See [[git-annex-registerurl]](1) for details. + +* `unregisterurl [key url]` + + Unregisters an url for a key. + + See [[git-annex-unregisterurl]](1) for details. * `setkey key file` diff --git a/doc/todo/unregisterurl_KEY_URL.mdwn b/doc/todo/unregisterurl_KEY_URL.mdwn index b4df00d78f..87c8da1bcd 100644 --- a/doc/todo/unregisterurl_KEY_URL.mdwn +++ b/doc/todo/unregisterurl_KEY_URL.mdwn @@ -15,3 +15,5 @@ edit 1: well, instead of adding `unregisterurl` could be done by adding `--key` [[!meta author=yoh]] [[!tag projects/dandi]] + +> unregisterurl [[done]] --[[Joey]] diff --git a/git-annex.cabal b/git-annex.cabal index 6675657a4d..243dee457b 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -808,6 +808,7 @@ Executable git-annex Command.Ungroup Command.Uninit Command.Unlock + Command.UnregisterUrl Command.Untrust Command.Unused Command.Upgrade