Added updateproxy command and remote.name.annex-proxy configuration

So far this only records proxy information on the git-annex branch.

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
 

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

Command/UpdateProxy.hs

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

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

Logs/Proxy.hs

@@ -0,0 +1,78 @@
+{- git-annex proxy log
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - 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 = ':'

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)

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

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.<name>.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.<name>.annex-private`
 

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.

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