registerurl, unregisterurl: Added --remote option

This serves two purposes. --remote=web bypasses other special remotes that
claim the url, same as addurl --raw. And, specifying some other remote
allows making sure that an url is claimed by the remote you expect,
which makes then using setpresentkey not be fragile.

Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project

diff --git a/CHANGELOG b/CHANGELOG
index 1ca2a8c51265e3065ac144079887e673917df50a..f3a5daf159d3778e4057fdbc18f0dd998e55f91e 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -6,6 +6,7 @@ git-annex (10.20230330) UNRELEASED; urgency=medium
   * Fix laziness bug introduced in last release that breaks use
     of --unlock-present and --hide-missing adjusted branches.
   * Support user.useConfigOnly git config.
+  * registerurl, unregisterurl: Added --remote option.
 
  -- Joey Hess <id@joeyh.name>  Fri, 31 Mar 2023 12:48:54 -0400
 

diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 36434aad143f062059c817640d62bd389b93c9e0..9e6cd50c39fbd2d885822e5f542d5519e1a899f7 100644 (file)
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -119,8 +119,8 @@ parseAutoOption = switch
        <> help "automatic mode"
        )
 
-parseRemoteOption :: RemoteName -> DeferredParse Remote
-parseRemoteOption = DeferredParse 
+mkParseRemoteOption :: RemoteName -> DeferredParse Remote
+mkParseRemoteOption = DeferredParse 
        . (fromJust <$$> Remote.byNameWithUUID)
        . Just
 
@@ -145,8 +145,8 @@ instance DeferredParseClass FromToOptions where
 
 parseFromToOptions :: Parser FromToOptions
 parseFromToOptions = 
-       (FromRemote . parseRemoteOption <$> parseFromOption) 
-       <|> (ToRemote . parseRemoteOption <$> parseToOption)
+       (FromRemote . mkParseRemoteOption <$> parseFromOption) 
+       <|> (ToRemote . mkParseRemoteOption <$> parseToOption)
 
 parseFromOption :: Parser RemoteName
 parseFromOption = strOption
@@ -162,6 +162,12 @@ parseToOption = strOption
        <> completeRemotes
        )
 
+parseRemoteOption :: Parser RemoteName
+parseRemoteOption = strOption
+       ( long "remote" <> metavar paramRemote
+       <> completeRemotes
+       )
+
 -- | From or to a remote, or both, or a special --to=here
 data FromToHereOptions 
        = FromOrToRemote FromToOptions
@@ -174,14 +180,14 @@ parseFromToHereOptions = go
        <*> optional parseToOption
   where
        go (Just from) (Just to) = Just $ FromRemoteToRemote
-               (parseRemoteOption from)
-               (parseRemoteOption to)
+               (mkParseRemoteOption from)
+               (mkParseRemoteOption to)
        go (Just from) Nothing = Just $ FromOrToRemote
-               (FromRemote $ parseRemoteOption from)
+               (FromRemote $ mkParseRemoteOption from)
        go Nothing (Just to) = Just $ case to of
                "here" -> ToHere
                "." -> ToHere
-               _ -> FromOrToRemote $ ToRemote $ parseRemoteOption to
+               _ -> FromOrToRemote $ ToRemote $ mkParseRemoteOption to
        go Nothing Nothing = Nothing
 
 instance DeferredParseClass FromToHereOptions where

diff --git a/Command/Drop.hs b/Command/Drop.hs
index 9222ab5a823764195e34ecc45120382bb3099000..8c4f34f8123fd5b48a72826439d099833cd82fa8 100644 (file)
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -44,7 +44,7 @@ optParser desc = DropOptions
        <*> parseBatchOption True
 
 parseDropFromOption :: Parser (DeferredParse Remote)
-parseDropFromOption = parseRemoteOption <$> strOption
+parseDropFromOption = mkParseRemoteOption <$> strOption
        ( long "from" <> short 'f' <> metavar paramRemote
        <> help "drop content from a remote"
        <> completeRemotes

diff --git a/Command/Export.hs b/Command/Export.hs
index 7a08cf68ffeb414bbddc1924282602fa5c0ac2be..f2427917c225937a099821873292bee3cf0f4c0f 100644 (file)
--- a/Command/Export.hs
+++ b/Command/Export.hs
@@ -59,7 +59,7 @@ data ExportOptions = ExportOptions
 optParser :: CmdParamsDesc -> Parser ExportOptions
 optParser _ = ExportOptions
        <$> (Git.Ref <$> parsetreeish)
-       <*> (parseRemoteOption <$> parseToOption)
+       <*> (mkParseRemoteOption <$> parseToOption)
        <*> parsetracking
   where
        parsetreeish = argument str

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 910dc5686e834995986441f120cd9b17472f6a55..b30b88052253a958d333e74f05a16867ae9dd44c 100644 (file)
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -74,7 +74,7 @@ data IncrementalOpt
 optParser :: CmdParamsDesc -> Parser FsckOptions
 optParser desc = FsckOptions
        <$> cmdParams desc
-       <*> optional (parseRemoteOption <$> strOption 
+       <*> optional (mkParseRemoteOption <$> strOption 
                ( long "from" <> short 'f' <> metavar paramRemote 
                <> help "check remote"
                <> completeRemotes

diff --git a/Command/Get.hs b/Command/Get.hs
index be1e9ab41be97b2e5b02c35b171afb94bd6f1aad..f19f7daf016bb8bac3c241e5282b9f4643c542f6 100644 (file)
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -32,7 +32,7 @@ data GetOptions = GetOptions
 optParser :: CmdParamsDesc -> Parser GetOptions
 optParser desc = GetOptions
        <$> cmdParams desc
-       <*> optional (parseRemoteOption <$> parseFromOption)
+       <*> optional (mkParseRemoteOption <$> parseFromOption)
        <*> parseAutoOption
        <*> optional (parseIncompleteOption <|> parseKeyOptions <|> parseFailedTransfersOption)
        <*> parseBatchOption True

diff --git a/Command/Import.hs b/Command/Import.hs
index 634365c69fabd164438cb695d7613271f6c2c2c3..bf5505ca4c3493f30a04be0bac45fedf437e6c01 100644 (file)
--- a/Command/Import.hs
+++ b/Command/Import.hs
@@ -75,7 +75,7 @@ data ImportOptions
 optParser :: CmdParamsDesc -> Parser ImportOptions
 optParser desc = do
        ps <- cmdParams desc
-       mfromremote <- optional $ parseRemoteOption <$> parseFromOption
+       mfromremote <- optional $ mkParseRemoteOption <$> parseFromOption
        content <- invertableSwitch "content" True
                ( help "do not get contents of imported files"
                )

diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs
index d82b94cb6ded160ae6bbed318122fc60c6ff8071..1f851605e49b1835696b94a119284f0f92932d46 100644 (file)
--- a/Command/RegisterUrl.hs
+++ b/Command/RegisterUrl.hs
@@ -11,6 +11,7 @@ import Command
 import Logs.Web
 import Command.FromKey (keyOpt, keyOpt')
 import qualified Remote
+import Annex.UUID
 
 cmd :: Command
 cmd = withAnnexOptions [jsonOptions] $ command "registerurl"
@@ -21,24 +22,26 @@ cmd = withAnnexOptions [jsonOptions] $ command "registerurl"
 data RegisterUrlOptions = RegisterUrlOptions
        { keyUrlPairs :: CmdParams
        , batchOption :: BatchMode
+       , remoteOption :: Maybe (DeferredParse Remote)
        }
 
 optParser :: CmdParamsDesc -> Parser RegisterUrlOptions
 optParser desc = RegisterUrlOptions
        <$> cmdParams desc
        <*> parseBatchOption False
+       <*> optional (mkParseRemoteOption <$> parseRemoteOption)
 
 seek :: RegisterUrlOptions -> CommandSeek
 seek o = case (batchOption o, keyUrlPairs o) of
        (Batch fmt, _) -> seekBatch setUrlPresent o fmt
        -- older way of enabling batch input, does not support BatchNull
        (NoBatch, []) -> seekBatch setUrlPresent o (BatchFormat BatchLine (BatchKeys False))
-       (NoBatch, ps) -> commandAction (start setUrlPresent ps)
+       (NoBatch, ps) -> commandAction (start setUrlPresent o ps)
 
 seekBatch :: (Key -> URLString -> Annex ()) -> RegisterUrlOptions -> BatchFormat -> CommandSeek
 seekBatch a o fmt = batchOnly Nothing (keyUrlPairs o) $
        batchInput fmt (pure . parsebatch) $
-               batchCommandAction . start' a
+               batchCommandAction . start' a o
   where
        parsebatch l = 
                let (keyname, u) = separate (== ' ') l
@@ -48,21 +51,29 @@ seekBatch a o fmt = batchOnly Nothing (keyUrlPairs o) $
                                Left e -> Left e
                                Right k -> Right (k, u)
 
-start :: (Key -> URLString -> Annex ()) -> [String] -> CommandStart
-start a (keyname:url:[]) = start' a (si, (keyOpt keyname, url))
+start :: (Key -> URLString -> Annex ()) -> RegisterUrlOptions -> [String] -> CommandStart
+start a o (keyname:url:[]) = start' a o (si, (keyOpt keyname, url))
   where
        si = SeekInput [keyname, url]
-start _ _ = giveup "specify a key and an url"
+start _ _ _ = giveup "specify a key and an url"
 
-start' :: (Key -> URLString -> Annex ()) -> (SeekInput, (Key, URLString)) -> CommandStart
-start' a (si, (key, url)) =
+start' :: (Key -> URLString -> Annex ()) -> RegisterUrlOptions -> (SeekInput, (Key, URLString)) -> CommandStart
+start' a o (si, (key, url)) =
        starting "registerurl" ai si $
-               perform a key url
+               perform a o key url
   where
        ai = ActionItemOther (Just url)
 
-perform :: (Key -> URLString -> Annex ()) -> Key -> URLString -> CommandPerform
-perform a key url = do
-       r <- Remote.claimingUrl url
-       a key (setDownloader' url r)
-       next $ return True
+perform :: (Key -> URLString -> Annex ()) -> RegisterUrlOptions -> Key -> URLString -> CommandPerform
+perform a o key url = do
+       needremote <- maybe (pure Nothing) (Just <$$> getParsed) (remoteOption o)
+       r <- case needremote of
+               Just nr | Remote.uuid nr == webUUID -> pure nr
+               _ -> Remote.claimingUrl url
+       case needremote of
+               Just nr | nr /= r -> do
+                       showNote $ "The url " ++ url ++ " is claimed by remote " ++ Remote.name r
+                       next $ return False
+               _ -> do
+                       a key (setDownloader' url r)
+                       next $ return True

diff --git a/Command/UnregisterUrl.hs b/Command/UnregisterUrl.hs
index 19750c9cc50aa60f96438ba8acf501f357d85bcb..a26cdf56f3cd23ee642de93f168df608b7c4b806 100644 (file)
--- a/Command/UnregisterUrl.hs
+++ b/Command/UnregisterUrl.hs
@@ -22,7 +22,7 @@ cmd = withAnnexOptions [jsonOptions] $ command "unregisterurl"
 seek :: RegisterUrlOptions -> CommandSeek
 seek o = case (batchOption o, keyUrlPairs o) of
        (Batch fmt, _) -> seekBatch unregisterUrl o fmt
-       (NoBatch, ps) -> commandAction (start unregisterUrl ps)
+       (NoBatch, ps) -> commandAction (start unregisterUrl o ps)
 
 unregisterUrl :: Key -> String -> Annex ()
 unregisterUrl key url = do

diff --git a/doc/bugs/registerurl_does_not_register_if_external_remote/comment_5_b9057ce47bb57b3a3dbe390672310898._comment b/doc/bugs/registerurl_does_not_register_if_external_remote/comment_5_b9057ce47bb57b3a3dbe390672310898._comment
index 3a4aaeebe0d87f21bcdff559fcf1662e0ada02f9..dc0dda563f4ff01ae541df8668011e0265eb1d3e 100644 (file)
--- a/doc/bugs/registerurl_does_not_register_if_external_remote/comment_5_b9057ce47bb57b3a3dbe390672310898._comment
+++ b/doc/bugs/registerurl_does_not_register_if_external_remote/comment_5_b9057ce47bb57b3a3dbe390672310898._comment
@@ -11,6 +11,8 @@ So, you can then use registerurl with --remote=$uuid, check that it
 succeeded, and then use setpresentkey to mark it present on that uuid.
 Without the fragility you complained of.
 
+Update: The --remote parameter is implemented now.
+
 (Could registerurl with --remote update location tracking itself? Maybe,
 but I'd worry about a scenario like in the previous comment.)
 """]]

diff --git a/doc/git-annex-registerurl.mdwn b/doc/git-annex-registerurl.mdwn
index ad0e51166522b8021a9b041f1237db51aab08525..a74abd273bb2250db03a8a45775a1cab982eda69 100644 (file)
--- a/doc/git-annex-registerurl.mdwn
+++ b/doc/git-annex-registerurl.mdwn
@@ -17,8 +17,19 @@ 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.
 
+Registering an url makes content be treated as being present in the web
+special remote, unless some other special remote claims the url.
+
 # OPTIONS
 
+* `--remote=name|uuid`
+
+  Indicate that the url is expected to be claimed by the specified remote.
+  If some other remote claims the url instead, registering it will fail.
+
+  Note that `--remote=web` will prevent any other remote from claiming
+  the url.
+
 * `--batch`
 
   In batch input mode, lines are read from stdin, and each line

diff --git a/doc/git-annex-unregisterurl.mdwn b/doc/git-annex-unregisterurl.mdwn
index 0a2f8a395a7949876ad893bd18d9d0778351ca42..bed12b533152c772bb6b67e4cf01edaea4302a6b 100644 (file)
--- a/doc/git-annex-unregisterurl.mdwn
+++ b/doc/git-annex-unregisterurl.mdwn
@@ -19,6 +19,14 @@ parsed as a key, and is a valid url, an URL key is constructed from the url.
 
 # OPTIONS
 
+* `--remote=name|uuid`
+
+  Indicate that the url is expected to be claimed by the specified remote.
+  If some other remote claims the url instead, unregistering it will fail.
+
+  Note that `--remote=web` will prevent any other remote from claiming
+  the url.
+
 * `--batch`
 
   In batch input mode, lines are read from stdin, and each line

diff --git a/doc/todo/registerurl_--remote_REMOTE.mdwn b/doc/todo/registerurl_--remote_REMOTE.mdwn
index 45219a73946f1f82dc7c93f6a6b0aa49ff8972c5..e2fa249138b2c072d992ffde56c052513950bf37 100644 (file)
--- a/doc/todo/registerurl_--remote_REMOTE.mdwn
+++ b/doc/todo/registerurl_--remote_REMOTE.mdwn
@@ -3,3 +3,5 @@ If a remote can handle some urls (e.g. regular http) which annex can handle as w
 
 [[!meta author=yoh]]
 [[!tag projects/repronim]]
+
+> [[fixed|done]] --[[Joey]]

diff --git a/doc/todo/registerurl_--remote_REMOTE/comment_4_334ce2eb815d6d8489f9cb00c09b0bd7._comment b/doc/todo/registerurl_--remote_REMOTE/comment_4_334ce2eb815d6d8489f9cb00c09b0bd7._comment
new file mode 100644 (file)
index 0000000..99069ea
--- /dev/null
+++ b/doc/todo/registerurl_--remote_REMOTE/comment_4_334ce2eb815d6d8489f9cb00c09b0bd7._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2023-04-05T19:52:38Z"
+ content="""
+Implemented --remote for registerurl and unregisterurl. Including the --remote=web
+special case.
+"""]]