From d372553540d7567f0d14fa93b4a5dd9854e31f14 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 17 Apr 2024 15:19:42 -0400 Subject: [PATCH] rclone special remote Added rclone special remote, which can be used without needing to install the git-annex-remote-rclone program. This needs a new version of rclone, which supports "rclone gitannex". This is implemented as a variant of an external special remote, that runs "rclone gitannex" instead of the usual git-annex-remote- command. Parameterized Remote.External to support that. Sponsored-by: Luke T. Shumaker on Patreon --- CHANGELOG | 3 + Remote/External.hs | 82 +++++++++++-------- Remote/External/Types.hs | 19 +++-- Remote/List.hs | 2 + Remote/Rclone.hs | 31 +++++++ doc/git-annex.mdwn | 7 +- doc/special_remotes.mdwn | 1 + doc/special_remotes/rclone.mdwn | 14 ++-- ...es_not_using_git-annex-remote_in_name.mdwn | 2 + git-annex.cabal | 1 + 10 files changed, 114 insertions(+), 48 deletions(-) create mode 100644 Remote/Rclone.hs diff --git a/CHANGELOG b/CHANGELOG index 3a4adca108..5e73fd0dac 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -15,6 +15,9 @@ git-annex (10.20240228) UNRELEASED; urgency=medium versions of MinTTY. * sync, assist, import: Allow -m option to be specified multiple times, to provide additional paragraphs for the commit message. + * Added rclone special remote, which can be used without needing + to install the git-annex-remote-rclone program. This needs + a new version of rclone, which supports "rclone gitannex". -- Joey Hess Tue, 27 Feb 2024 13:07:10 -0400 diff --git a/Remote/External.hs b/Remote/External.hs index 179043c3bc..a974ad126c 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -9,7 +9,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} -module Remote.External (remote) where +module Remote.External where import Remote.External.Types import Remote.External.AsyncExtension @@ -48,10 +48,10 @@ remote :: RemoteType remote = specialRemoteType $ RemoteType { typename = "external" , enumerate = const (findSpecialRemotes "externaltype") - , generate = gen - , configParser = remoteConfigParser - , setup = externalSetup - , exportSupported = checkExportSupported + , generate = gen remote Nothing + , configParser = remoteConfigParser Nothing + , setup = externalSetup Nothing Nothing + , exportSupported = checkExportSupported Nothing , importSupported = importUnsupported , thirdPartyPopulated = False } @@ -62,15 +62,15 @@ externaltypeField = Accepted "externaltype" readonlyField :: RemoteConfigField readonlyField = Accepted "readonly" -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote) -gen r u rc gc rs +gen :: RemoteType -> Maybe ExternalProgram -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote) +gen rt externalprogram r u rc gc rs -- readonly mode only downloads urls; does not use external program - | externaltype == "readonly" = do + | externalprogram' == ExternalType "readonly" = do c <- parsedRemoteConfig remote rc cst <- remoteCost gc c expensiveRemoteCost let rmt = mk c cst (pure GloballyAvailable) Nothing - (externalInfo externaltype) + (externalInfo externalprogram') Nothing Nothing exportUnsupported @@ -83,7 +83,7 @@ gen r u rc gc rs rmt | otherwise = do c <- parsedRemoteConfig remote rc - external <- newExternal externaltype (Just u) c (Just gc) + external <- newExternal externalprogram' (Just u) c (Just gc) (Git.remoteName r) (Just rs) Annex.addCleanupAction (RemoteCleanup u) $ stopExternal external cst <- getCost external r gc c @@ -150,19 +150,27 @@ gen r u rc gc rs , appendonly = False , untrustworthy = False , availability = avail - , remotetype = remote + , remotetype = rt { exportSupported = cheapexportsupported } - , mkUnavailable = gen r u rc - (gc { remoteAnnexExternalType = Just "!dne!" }) rs + , mkUnavailable = + let dneprogram = case externalprogram of + Just (ExternalCommand _ _) -> Just (ExternalType "!dne!") + _ -> Nothing + dnegc = gc { remoteAnnexExternalType = Just "!dne!" } + in gen rt dneprogram r u rc dnegc rs , getInfo = togetinfo , claimUrl = toclaimurl , checkUrl = tocheckurl , remoteStateHandle = rs } - externaltype = fromMaybe (giveup "missing externaltype") (remoteAnnexExternalType gc) + externalprogram' = case externalprogram of + Just p -> p + Nothing -> ExternalType $ + fromMaybe (giveup "missing externaltype") + (remoteAnnexExternalType gc) -externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -externalSetup _ mu _ c gc = do +externalSetup :: Maybe ExternalProgram -> Maybe (String, String) -> SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +externalSetup externalprogram setgitconfig _ mu _ c gc = do u <- maybe (liftIO genUUID) return mu pc <- either giveup return $ parseRemoteConfig c lenientRemoteConfigParser let readonlyconfig = getRemoteConfigValue readonlyField pc == Just True @@ -182,7 +190,8 @@ externalSetup _ mu _ c gc = do return c' else do pc' <- either giveup return $ parseRemoteConfig c' lenientRemoteConfigParser - external <- newExternal externaltype (Just u) pc' (Just gc) Nothing Nothing + let p = fromMaybe (ExternalType externaltype) externalprogram + external <- newExternal p (Just u) pc' (Just gc) Nothing Nothing -- Now that we have an external, ask it to LISTCONFIGS, -- and re-parse the RemoteConfig strictly, so we can -- error out if the user provided an unexpected config. @@ -200,17 +209,20 @@ externalSetup _ mu _ c gc = do liftIO . atomically . readTMVar . externalConfigChanges return (changes c') - gitConfigSpecialRemote u c'' [("externaltype", externaltype)] + gitConfigSpecialRemote u c'' + [ fromMaybe ("externaltype", externaltype) setgitconfig ] return (M.delete readonlyField c'', u) -checkExportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool -checkExportSupported c gc = do +checkExportSupported :: Maybe ExternalProgram -> ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool +checkExportSupported Nothing c gc = do let externaltype = fromMaybe (giveup "Specify externaltype=") $ remoteAnnexExternalType gc <|> getRemoteConfigValue externaltypeField c if externaltype == "readonly" then return False - else checkExportSupported' - =<< newExternal externaltype Nothing c (Just gc) Nothing Nothing + else checkExportSupported (Just (ExternalType externaltype)) c gc +checkExportSupported (Just externalprogram) c gc = + checkExportSupported' + =<< newExternal externalprogram Nothing c (Just gc) Nothing Nothing checkExportSupported' :: External -> Annex Bool checkExportSupported' external = go `catchNonAsync` (const (return False)) @@ -658,7 +670,7 @@ startExternal' external = do n <- succ <$> readTVar (externalLastPid external) writeTVar (externalLastPid external) n return n - AddonProcess.startExternalAddonProcess basecmd [] pid >>= \case + AddonProcess.startExternalAddonProcess externalcmd externalparams pid >>= \case Left (AddonProcess.ProgramFailure err) -> do unusable err Left (AddonProcess.ProgramNotInstalled err) -> @@ -667,7 +679,7 @@ startExternal' external = do [ err , "This remote has annex-readonly=true, and previous versions of" , "git-annex would try to download from it without" - , "installing " ++ basecmd ++ ". If you want that, you need to set:" + , "installing " ++ externalcmd ++ ". If you want that, you need to set:" , "git config remote." ++ rname ++ ".annex-externaltype readonly" ] _ -> unusable err @@ -686,7 +698,9 @@ startExternal' external = do extensions <- startproto st return (st, extensions) where - basecmd = "git-annex-remote-" ++ externalType external + (externalcmd, externalparams) = case externalProgram external of + ExternalType t -> ("git-annex-remote-" ++ t, []) + ExternalCommand c ps -> (c, ps) startproto st = do receiveMessage st external (const Nothing) @@ -707,13 +721,13 @@ startExternal' external = do case filter (`notElem` fromExtensionList supportedExtensionList) (fromExtensionList exwanted) of [] -> return exwanted exrest -> unusable $ unwords $ - [ basecmd + [ externalcmd , "requested extensions that this version of git-annex does not support:" ] ++ exrest unusable msg = do warning (UnquotedString msg) - giveup ("unable to use external special remote " ++ basecmd) + giveup ("unable to use external special remote " ++ externalcmd) stopExternal :: External -> Annex () stopExternal external = liftIO $ do @@ -825,12 +839,13 @@ getWebUrls key = filter supported <$> getUrls key where supported u = snd (getDownloader u) == WebDownloader -externalInfo :: ExternalType -> Annex [(String, String)] -externalInfo et = return [("externaltype", et)] +externalInfo :: ExternalProgram -> Annex [(String, String)] +externalInfo (ExternalType et) = return [("externaltype", et)] +externalInfo (ExternalCommand _ _) = return [] getInfoM :: External -> Annex [(String, String)] getInfoM external = (++) - <$> externalInfo (externalType external) + <$> externalInfo (externalProgram external) <*> handleRequest external GETINFO Nothing (collect []) where collect l req = case req of @@ -886,8 +901,8 @@ listConfigs external = handleRequest external LISTCONFIGS Nothing (collect []) UNSUPPORTED_REQUEST -> result Nothing _ -> Nothing -remoteConfigParser :: RemoteConfig -> Annex RemoteConfigParser -remoteConfigParser c +remoteConfigParser :: Maybe ExternalProgram -> RemoteConfig -> Annex RemoteConfigParser +remoteConfigParser externalprogram c -- No need to start the external when there is no config to parse, -- or when everything in the config was already accepted; in those -- cases the lenient parser will do the same thing as the strict @@ -899,7 +914,8 @@ remoteConfigParser c (Nothing, _) -> return lenientRemoteConfigParser (_, Just True) -> return lenientRemoteConfigParser (Just externaltype, _) -> do - external <- newExternal externaltype Nothing pc Nothing Nothing Nothing + let p = fromMaybe (ExternalType externaltype) externalprogram + external <- newExternal p Nothing pc Nothing Nothing Nothing strictRemoteConfigParser external where isproposed (Accepted _) = False diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 1ee29ebd6c..7eb1d95c7b 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -1,6 +1,6 @@ {- External special remote data types. - - - Copyright 2013-2020 Joey Hess + - Copyright 2013-2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -12,7 +12,7 @@ module Remote.External.Types ( External(..), newExternal, - ExternalType, + ExternalProgram(..), ExternalState(..), PrepareStatus(..), ExtensionList(..), @@ -64,7 +64,7 @@ import Text.Read import qualified Data.ByteString.Short as S (fromShort) data External = External - { externalType :: ExternalType + { externalProgram :: ExternalProgram , externalUUID :: Maybe UUID , externalState :: TVar [ExternalState] -- ^ Contains states for external special remote processes @@ -77,9 +77,9 @@ data External = External , externalAsync :: TMVar ExternalAsync } -newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteName -> Maybe RemoteStateHandle -> Annex External -newExternal externaltype u c gc rn rs = liftIO $ External - <$> pure externaltype +newExternal :: ExternalProgram -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteName -> Maybe RemoteStateHandle -> Annex External +newExternal p u c gc rn rs = liftIO $ External + <$> pure p <*> pure u <*> atomically (newTVar []) <*> atomically (newTVar 0) @@ -89,7 +89,12 @@ newExternal externaltype u c gc rn rs = liftIO $ External <*> pure rs <*> atomically (newTMVar UncheckedExternalAsync) -type ExternalType = String +data ExternalProgram + = ExternalType String + -- ^ "git-annex-remote-" is prepended to this to get the program + | ExternalCommand String [CommandParam] + -- ^ to use a program with a different name, and parameters + deriving (Show, Eq) data ExternalState = ExternalState { externalSend :: forall t. (Proto.Sendable t, ToAsyncWrapped t) => t -> IO () diff --git a/Remote/List.hs b/Remote/List.hs index 8ca9d8f794..e884a25a3b 100644 --- a/Remote/List.hs +++ b/Remote/List.hs @@ -37,6 +37,7 @@ import qualified Remote.Ddar import qualified Remote.GitLFS import qualified Remote.HttpAlso import qualified Remote.Borg +import qualified Remote.Rclone import qualified Remote.Hook import qualified Remote.External @@ -59,6 +60,7 @@ remoteTypes = map adjustExportImportRemoteType , Remote.GitLFS.remote , Remote.HttpAlso.remote , Remote.Borg.remote + , Remote.Rclone.remote , Remote.Hook.remote , Remote.External.remote ] diff --git a/Remote/Rclone.hs b/Remote/Rclone.hs new file mode 100644 index 0000000000..a2ab8f501f --- /dev/null +++ b/Remote/Rclone.hs @@ -0,0 +1,31 @@ +{- Rclone special remote, using "rclone gitannex" + - + - Copyright 2024 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Remote.Rclone (remote) where + +import Types +import Types.Remote +import Remote.Helper.Special +import Remote.Helper.ExportImport +import Utility.SafeCommand +import qualified Remote.External as External +import Remote.External.Types + +remote :: RemoteType +remote = specialRemoteType $ RemoteType + { typename = "rclone" + , enumerate = const (findSpecialRemotes "rclone") + , generate = External.gen remote p + , configParser = External.remoteConfigParser p + , setup = External.externalSetup p setgitconfig + , exportSupported = External.checkExportSupported p + , importSupported = importUnsupported + , thirdPartyPopulated = False + } + where + p = Just $ ExternalCommand "rclone" [Param "gitannex"] + setgitconfig = Just ("rclone", "true") diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 30028a45e2..60acd0573c 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -1794,6 +1794,11 @@ Remotes are configured using these settings in `.git/config`. Used to identify Amazon Glacier special remotes. Normally this is automatically set up by `git annex initremote`. +* `remote..annex-rclone` + + Used to identify rclone special remotes. + Normally this is automatically set up by `git annex initremote`. + * `remote..annex-web` Used to identify web special remotes. @@ -1832,7 +1837,7 @@ Remotes are configured using these settings in `.git/config`. * `remote..annex-externaltype` - Used external special remotes to record the type of the remote. + Used by external special remotes to record the type of the remote. Eg, if this is set to "foo", git-annex will run a "git-annex-remote-foo" program to communicate with the external special remote. diff --git a/doc/special_remotes.mdwn b/doc/special_remotes.mdwn index 7c227ee07e..7399ba34a8 100644 --- a/doc/special_remotes.mdwn +++ b/doc/special_remotes.mdwn @@ -26,6 +26,7 @@ the git history is not stored in them. * [[git]] * [[httpalso]] * [[borg]] +* [[rclone]] The above special remotes are built into git-annex, and can be used to tie git-annex into many cloud services. diff --git a/doc/special_remotes/rclone.mdwn b/doc/special_remotes/rclone.mdwn index 12dc18e36c..d8d058e9a7 100644 --- a/doc/special_remotes/rclone.mdwn +++ b/doc/special_remotes/rclone.mdwn @@ -26,12 +26,12 @@ the time of writing, this includes the following services: That list is regularly expanding. -git-annex supports all of those through -the use of the [rclone special remote](https://github.com/DanielDent/git-annex-remote-rclone). +There are two ways to use rclone as a git-annex special remote. -Alternatively, rclone recently gained support for being used as a special -remote on its own, without needing installation of the above program. -For documentation on using rclone that way, see the output of -`rclone gitannex -h` or [here](//github.com/rclone/rclone/blob/master/cmd/gitannex/gitannex.md). +1. Install [git-annex-remote-rclone](https://github.com/DanielDent/git-annex-remote-rclone). + This will work with any versions of rclone and git-annex. +2. With a recent version of rclone and git-annex, it is not necessary to + install anything else, just use `git-annex initremote type=rclone ...` -See their documentation for more concrete examples. + For documentation on using rclone that way, see the output of + `rclone gitannex -h` or [here](https://github.com/rclone/rclone/blob/master/cmd/gitannex/gitannex.md). diff --git a/doc/todo/external_special_remotes_not_using_git-annex-remote_in_name.mdwn b/doc/todo/external_special_remotes_not_using_git-annex-remote_in_name.mdwn index c21aebe88e..5956cccdbe 100644 --- a/doc/todo/external_special_remotes_not_using_git-annex-remote_in_name.mdwn +++ b/doc/todo/external_special_remotes_not_using_git-annex-remote_in_name.mdwn @@ -44,3 +44,5 @@ a wrapper around the external special remote, that makes it use > I feel that the simplicity of the type=rclone config will pay off in the > long term, vs short term complication for probably a small subset of users > who somehow can upgrade rclone but can't upgrade git-annex. --[[Joey]] + +> > [[done]] diff --git a/git-annex.cabal b/git-annex.cabal index a207606d83..3b850d5e6a 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -900,6 +900,7 @@ Executable git-annex Remote.List Remote.List.Util Remote.P2P + Remote.Rclone Remote.Rsync Remote.Rsync.RsyncUrl Remote.S3