unregisterurl: New command

Implemented by generalizing registerurl. Without the implicit batch mode
of registerurl since that is only a backwards compatability thing
(see commit 1d1054faa6).

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 <id@joeyh.name>  Wed, 24 Feb 2021 13:18:38 -0400
 

CmdLine/GitAnnex.hs

@@ -1,6 +1,6 @@
 {- git-annex main program
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - 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

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, []) -> commandAction $ startMass setUrlPresent BatchLine
-	(NoBatch, ps) -> withWords (commandAction . start) ps
+	(NoBatch, ps) -> withWords (commandAction . start setUrlPresent) ps
 
-start :: [String] -> CommandStart
+start :: (Key -> URLString -> Annex ()) -> [String] -> CommandStart
-start (keyname:url:[]) = 
+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 :: (Key -> URLString -> Annex ()) -> BatchFormat -> CommandStart
-startMass fmt = 
+startMass a fmt = 
 	starting "registerurl" (ActionItemOther (Just "stdin")) (SeekInput []) $
-		massAdd fmt
+		performMass a fmt
 
-massAdd :: BatchFormat -> CommandPerform
+performMass :: (Key -> URLString -> Annex ()) -> BatchFormat -> CommandPerform
-massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt
+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 -> URLString -> Annex ()) -> Key -> URLString -> CommandPerform
-perform key url = do
+perform a key url = do
-	ok <- perform' key url
+	ok <- perform' a key url
 	next $ return ok
 
-perform' :: Key -> URLString -> Annex Bool
+perform' :: (Key -> URLString -> Annex ()) -> Key -> URLString -> Annex Bool
-perform' key url = do
+perform' a key url = do
 	r <- Remote.claimingUrl url
-	setUrlPresent key (setDownloader' url r)
+	a key (setDownloader' url r)
 	return True

Command/UnregisterUrl.hs

@@ -0,0 +1,25 @@
+{- git-annex command
+ -
+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>
+ -
+ - 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

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 <id@joeyh.name>

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 <id@joeyh.name>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.

doc/git-annex.mdwn

@@ -619,6 +619,12 @@ content from the key-value store.
   
   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`
 
   Moves a file into the annex as the content of a key.

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]]

git-annex.cabal

@@ -808,6 +808,7 @@ Executable git-annex
     Command.Ungroup
     Command.Uninit
     Command.Unlock
+    Command.UnregisterUrl
     Command.Untrust
     Command.Unused
     Command.Upgrade