diff --git a/CHANGELOG b/CHANGELOG index 693f55a8ab..007c9273e0 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,6 @@ git-annex (10.20240532) UNRELEASED; urgency=medium + * Added updateproxy command and remote.name.annex-proxy configuration. * Fix Windows build with Win32 2.13.4+ Thanks, Oleg Tolmatcev diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index debf30fffd..2f2bf7c86e 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -124,6 +124,7 @@ import qualified Command.Smudge import qualified Command.FilterProcess import qualified Command.Restage import qualified Command.Undo +import qualified Command.UpdateProxy import qualified Command.Version import qualified Command.RemoteDaemon #ifdef WITH_ASSISTANT @@ -247,6 +248,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator = map addGitAnnexCommonOption , Command.FilterProcess.cmd , Command.Restage.cmd , Command.Undo.cmd + , Command.UpdateProxy.cmd , Command.Version.cmd , Command.RemoteDaemon.cmd #ifdef WITH_ASSISTANT diff --git a/Command/UpdateProxy.hs b/Command/UpdateProxy.hs new file mode 100644 index 0000000000..da09c64a21 --- /dev/null +++ b/Command/UpdateProxy.hs @@ -0,0 +1,52 @@ +{- git-annex command + - + - Copyright 2024 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Command.UpdateProxy where + +import Command +import Logs.Proxy +import Annex.UUID +import qualified Remote as R +import qualified Types.Remote as R +import Utility.SafeOutput + +import qualified Data.Map as M +import qualified Data.Set as S + +cmd :: Command +cmd = noMessages $ command "updateproxy" SectionSetup + "update records with proxy configuration" + paramNothing (withParams seek) + +seek :: CmdParams -> CommandSeek +seek = withNothing (commandAction start) + +start :: CommandStart +start = startingCustomOutput (ActionItemOther Nothing) $ do + rs <- R.remoteList + let proxies = S.fromList $ + map (\r -> Proxy (R.uuid r) (R.name r)) $ + filter (remoteAnnexProxy . R.gitconfig) rs + u <- getUUID + oldproxies <- fromMaybe mempty . M.lookup u <$> getProxies + if oldproxies == proxies + then liftIO $ putStrLn "No proxy changes to record." + else do + describechanges oldproxies proxies + recordProxies proxies + next $ return True + where + describechanges oldproxies proxies = + forM_ (S.toList $ S.union oldproxies proxies) $ \p -> + case (S.member p oldproxies, S.member p proxies) of + (False, True) -> liftIO $ + putStrLn $ safeOutput $ + "Started proxying for " ++ proxyRemoteName p + (True, False) -> liftIO $ + putStrLn $ safeOutput $ + "Stopped proxying for " ++ proxyRemoteName p + _ -> noop diff --git a/Logs.hs b/Logs.hs index 6cb7ebdb02..f86b27cd61 100644 --- a/Logs.hs +++ b/Logs.hs @@ -98,6 +98,7 @@ topLevelOldUUIDBasedLogs = topLevelNewUUIDBasedLogs :: [RawFilePath] topLevelNewUUIDBasedLogs = [ exportLog + , proxyLog ] {- Other top-level logs. -} @@ -154,6 +155,9 @@ multicastLog = "multicast.log" exportLog :: RawFilePath exportLog = "export.log" +proxyLog :: RawFilePath +proxyLog = "proxy.log" + {- This is not a log file, it's where exported treeishes get grafted into - the git-annex branch. -} exportTreeGraftPoint :: RawFilePath diff --git a/Logs/Proxy.hs b/Logs/Proxy.hs new file mode 100644 index 0000000000..7a289ff0a9 --- /dev/null +++ b/Logs/Proxy.hs @@ -0,0 +1,78 @@ +{- git-annex proxy log + - + - Copyright 2024 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE OverloadedStrings #-} + +module Logs.Proxy ( + Proxy(..), + getProxies, + recordProxies, +) where + +import qualified Data.Map as M + +import qualified Annex +import Annex.Common +import qualified Annex.Branch +import Git.Types +import Logs +import Logs.UUIDBased +import Logs.MapLog +import Annex.UUID + +import qualified Data.Set as S +import Data.ByteString.Builder +import qualified Data.Attoparsec.ByteString as A +import qualified Data.Attoparsec.ByteString.Char8 as A8 +import qualified Data.ByteString.Lazy as L + +data Proxy = Proxy + { proxyRemoteUUID :: UUID + , proxyRemoteName :: RemoteName + } deriving (Show, Eq, Ord) + +-- TODO caching +getProxies :: Annex (M.Map UUID (S.Set Proxy)) +getProxies = M.map value . fromMapLog . parseProxyLog + <$> Annex.Branch.get proxyLog + +recordProxies :: S.Set Proxy -> Annex () +recordProxies proxies = do + -- If a private UUID has been configured as a proxy, avoid leaking + -- it into the git-annex log. + privateuuids <- annexPrivateRepos <$> Annex.getGitConfig + let proxies' = S.filter + (\p -> S.notMember (proxyRemoteUUID p) privateuuids) proxies + + c <- currentVectorClock + u <- getUUID + Annex.Branch.change (Annex.Branch.RegardingUUID [u]) proxyLog $ + (buildLogNew buildProxyList) + . changeLog c u proxies' + . parseProxyLog + +buildProxyList :: S.Set Proxy -> Builder +buildProxyList = mconcat . map fmt . S.toList + where + fmt p = buildUUID (proxyRemoteUUID p) + <> colon + <> byteString (encodeBS (proxyRemoteName p)) + colon = charUtf8 ':' + +parseProxyLog :: L.ByteString -> Log (S.Set Proxy) +parseProxyLog = parseLogNew parseProxyList + +parseProxyList :: A.Parser (S.Set Proxy) +parseProxyList = S.fromList <$> many parseword + where + parseword = parseproxy + <* ((const () <$> A8.char ' ') <|> A.endOfInput) + parseproxy = Proxy + <$> (toUUID <$> A8.takeWhile1 (/= colon)) + <* (const () <$> A8.char colon) + <*> (decodeBS <$> A8.takeWhile1 (/= ' ')) + colon = ':' diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 0c756749b4..a93d5c6fbc 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -375,6 +375,7 @@ data RemoteGitConfig = RemoteGitConfig , remoteAnnexConfigUUID :: Maybe UUID , remoteAnnexMaxGitBundles :: Int , remoteAnnexAllowEncryptedGitRepo :: Bool + , remoteAnnexProxy :: Bool , remoteUrl :: Maybe String {- These settings are specific to particular types of remotes @@ -459,6 +460,7 @@ extractRemoteGitConfig r remotename = do fromMaybe 100 (getmayberead "max-git-bundles") , remoteAnnexAllowEncryptedGitRepo = getbool "allow-encrypted-gitrepo" False + , remoteAnnexProxy = getbool "proxy" False , remoteUrl = case Git.Config.getMaybe (remoteConfig remotename "url") r of Just (ConfigValue b) diff --git a/doc/git-annex-updateproxy.mdwn b/doc/git-annex-updateproxy.mdwn new file mode 100644 index 0000000000..20cbeef278 --- /dev/null +++ b/doc/git-annex-updateproxy.mdwn @@ -0,0 +1,39 @@ +# NAME + +git-annex updateproxy - update records with proxy configuration + +# SYNOPSIS + +git annex updateproxy + +# DESCRIPTION + +A git-annex repository can act as a proxy for its remotes. That allows +annexed content to be stored and removed from the proxy's remotes, by +repositories that do not have a direct connection to the remotes. + +By default, no proxying is done. To configure the local repository to act +as a proxy for its remote named "foo", run `git config remote.foo.annex-proxy` +true`. + +After setting or unsetting `remote..annex-proxy` git configurations, +run `git-annex updateproxy` to record the proxy configuration in the +git-annex branch. That tells other repositories about the proxy +configuration. + +Suppose, for example, that remote "work" has had this command run in +it. Then git-annex will know about an additional remote, "work-foo". + +# OPTIONS + +* The [[git-annex-common-options]](1) can be used. + +# SEE ALSO + +[[git-annex]](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 19570dcfb8..3a7a6bd39f 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -252,7 +252,6 @@ content from the key-value store. See [[git-annex-configremote]](1) for details. - * `renameremote` Renames a special remote. @@ -327,6 +326,12 @@ content from the key-value store. See [[git-annex-required]](1) for details. +* `updateproxy` + + Update records with proxy configuration. + + See [[git-annex-updateproxy](1) for details. + * `schedule repository [expression]` Get or set scheduled jobs. @@ -1640,6 +1645,12 @@ Remotes are configured using these settings in `.git/config`. content of any file, even though its normal location tracking does not indicate that it does. This will cause git-annex to try to get all file contents from the remote. Can be useful in setting up a caching remote. + +* `remote..annex-proxy` + + Set to "true" to make the local repository able to act as a proxy to this + remote. After configuring this, run [[git-annex-updateproxy](1) to store + the new configuration in the git-annex branch. * `remote..annex-private` diff --git a/doc/internals.mdwn b/doc/internals.mdwn index f0ee6f66c1..37e652d9ce 100644 --- a/doc/internals.mdwn +++ b/doc/internals.mdwn @@ -308,6 +308,21 @@ For example, this logs that a remote has an object stored using both (When those chunks are removed from the remote, the 9 is changed to 0.) +## `proxy.log` + +Used to record what repositories are accessible via a proxy. + +Each line starts with a timestamp, then the uuid of the repository +that can serve as a proxy, and then a list of the remotes that it can +proxy to, separated by spaces. + +Each remote in the list consists of a uuid, followed by a colon (`:`) +and then a remote name. + +For example: + + 1317929100.012345s e605dca6-446a-11e0-8b2a-002170d25c55 26339d22-446b-11e0-9101-002170d25c55:foo c076460c-2290-11ef-be53-b7f0d194c863:bar + ## `schedule.log` Used to record scheduled events, such as periodic fscks. diff --git a/git-annex.cabal b/git-annex.cabal index 2e9f4c9d1e..112e62c8cd 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -720,6 +720,7 @@ Executable git-annex Command.UnregisterUrl Command.Untrust Command.Unused + Command.UpdateProxy Command.Upgrade Command.VAdd Command.VCycle @@ -838,6 +839,7 @@ Executable git-annex Logs.PreferredContent.Raw Logs.Presence Logs.Presence.Pure + Logs.Proxy Logs.Remote Logs.Remote.Pure Logs.RemoteState