diff --git a/CHANGELOG b/CHANGELOG index 1ca2a8c512..f3a5daf159 100644 --- 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 Fri, 31 Mar 2023 12:48:54 -0400 diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index 36434aad14..9e6cd50c39 100644 --- 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 9222ab5a82..8c4f34f812 100644 --- 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 7a08cf68ff..f2427917c2 100644 --- 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 910dc5686e..b30b880522 100644 --- 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 be1e9ab41b..f19f7daf01 100644 --- 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 634365c69f..bf5505ca4c 100644 --- 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 d82b94cb6d..1f851605e4 100644 --- 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 19750c9cc5..a26cdf56f3 100644 --- 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 3a4aaeebe0..dc0dda563f 100644 --- 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 ad0e511665..a74abd273b 100644 --- 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 0a2f8a395a..bed12b5331 100644 --- 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 45219a7394..e2fa249138 100644 --- 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 index 0000000000..99069ea64e --- /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. +"""]]