added git-annex satisfy

This ended up having an interface like sync, rather than like get/copy/drop.
That let it be implemented in terms of sync, which took a lot less code.
Also, it lets it handle many of the edge cases that sync does, such as
getting files that are not visible in a --hide-missing branch, and sending
files to exporttree remotes.

As well as being easier to implement, `git-annex satisfy myremote` makes
sense as it satisfies the preferred content settings of the remote.
`git-annex satisfy somefile` does not form a sentence that makes sense. So
while -C can be a little bit annoying, it still makes sense to have this
syntax.

Note that, while I initially thought this would also satisfy numcopies, it
does not. Arguably it ought to. But, sync does not send files in order to
satisfy numcopies, it only sends files to satisfy preferred content. And
it's important that this transfer the same files as sync does, because
it will probably be used in a workflow where the user sometimes syncs and
sometimes satisfies, and does not expect satisfy to do things that sync
would not do.

(Also opened a new bug that also affects sync et all, not only this command.)

Sponsored-by: Nicholas Golder-Manning on Patreon

CHANGELOG

@@ -1,9 +1,8 @@
 git-annex (10.20230627) UNRELEASED; urgency=medium
 
   * satify: New command that gets/sends/drops content to satisfy
-    numcopies and preferred content settings. This is similar to
+    preferred content settings. This is like to the --content
-    the --content part of git-annex sync, but with an interface
+    part of git-annex sync.
-    more like get/move/drop.
   * reinject: Added --guesskeys option.
   * diffdriver: Added --text option for easy diffing of the contents of
     annexed text files.

CmdLine/GitAnnex.hs

@@ -103,6 +103,7 @@ import qualified Command.Sync
 import qualified Command.Assist
 import qualified Command.Pull
 import qualified Command.Push
+import qualified Command.Satisfy
 import qualified Command.Mirror
 import qualified Command.AddUrl
 import qualified Command.ImportFeed
@@ -151,6 +152,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator = map addGitAnnexCommonOption
 	, Command.Assist.cmd
 	, Command.Pull.cmd
 	, Command.Push.cmd
+	, Command.Satisfy.cmd
 	, Command.Mirror.cmd
 	, Command.AddUrl.cmd
 	, Command.ImportFeed.cmd

Command/Satisfy.hs

@@ -0,0 +1,17 @@
+{- git-annex command
+ -
+ - Copyright 2023 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Command.Satisfy (cmd) where
+
+import Command
+import Command.Sync hiding (cmd)
+
+cmd :: Command
+cmd = withAnnexOptions [jobsOption, backendOption] $
+	command "satisfy" SectionCommon 
+		"transfer and drop content as configured"
+		(paramRepeating paramRemote) (seek <--< optParser SatisfyMode)

Command/Sync.hs

@@ -95,7 +95,7 @@ cmd = withAnnexOptions [jobsOption, backendOption] $
 		"synchronize local repository with remotes"
 		(paramRepeating paramRemote) (seek <--< optParser SyncMode)
 
-data OperationMode = SyncMode | PullMode | PushMode | AssistMode
+data OperationMode = SyncMode | PullMode | PushMode | SatisfyMode | AssistMode
 	deriving (Eq, Show)
 
 data SyncOptions = SyncOptions
@@ -143,15 +143,17 @@ optParser mode desc = SyncOptions
 		( metavar desc
 		<> completeRemotes
 		))
-	<*> switch 
+	<*> whenmode [SatisfyMode] True 
+		(switch 
 			( long "only-annex"
 			<> short 'a'
 			<> help "do not operate on git branches"
-		)
+			))
-	<*> switch 
+	<*> whenmode [SatisfyMode] False 
+		( switch 
 			( long "not-only-annex"
 			<> help "operate on git branches as well as annex"
-		)
+			))
 	<*> case mode of
 		SyncMode -> switch
 			( long "commit"
@@ -159,12 +161,15 @@ optParser mode desc = SyncOptions
 			)
 		PushMode -> pure False
 		PullMode -> pure False
+		SatisfyMode -> pure False
 		AssistMode -> pure True
-	<*> unlessmode [SyncMode] True (switch
+	<*> unlessmode [SyncMode] True 
+		(switch
 			( long "no-commit"
 			<> help "avoid git commit" 
 			))
-	<*> unlessmode [SyncMode, AssistMode] Nothing (optional (strOption
+	<*> unlessmode [SyncMode, AssistMode] Nothing
+		(optional (strOption
 			( long "message" <> short 'm' <> metavar "MSG"
 			<> help "commit message"
 			)))
@@ -174,6 +179,7 @@ optParser mode desc = SyncOptions
 			)
 		PullMode -> pure True
 		PushMode -> pure False
+		SatisfyMode -> pure False
 		AssistMode -> pure True
 	<*> case mode of
 		SyncMode -> invertableSwitch "push" True
@@ -181,31 +187,36 @@ optParser mode desc = SyncOptions
 			)
 		PullMode -> pure False
 		PushMode -> pure True
+		SatisfyMode -> pure False
 		AssistMode -> pure True
-	<*> optional (flag' True 
+	<*> whenmode [SatisfyMode] (Just True)
+		(optional (flag' True 
 			( long "content"
 			<> help "transfer annexed file contents" 
-		))
+			)))
-	<*> optional (flag' True
+	<*> whenmode [SatisfyMode] Nothing
+		(optional (flag' True
 			( long "no-content"
 			<> short 'g'
 			<> help "do not transfer annexed file contents"
-		))
+			)))
 	<*> many (strOption
 		( long "content-of"
 		<> short 'C'
 		<> help "transfer contents of annexed files in a given location"
 		<> metavar paramPath
 		))
-	<*> whenmode [PullMode] False (switch
+	<*> whenmode [PullMode, SatisfyMode] False 
+		(switch
 			( long "cleanup"
 			<> help "remove synced/ branches"
 			))
 	<*> optional parseAllOption
-	<*> whenmode [PushMode] False (invertableSwitch "resolvemerge" True
+	<*> whenmode [PushMode, SatisfyMode] False 
+		(invertableSwitch "resolvemerge" True
 			( help "do not automatically resolve merge conflicts"
 			))
-	<*> whenmode [PushMode] False
+	<*> whenmode [PushMode, SatisfyMode] False
 		parseUnrelatedHistoriesOption
 	<*> pure mode
   where
@@ -838,6 +849,7 @@ seekSyncContent o rs currbranch = do
 			SyncMode -> "sync"
 			PullMode -> "pull"
 			PushMode -> "push"
+			SatisfyMode -> "satisfy"
 			AssistMode -> "assist"
 
 	gofile bloom mvar _ f k = 
@@ -910,7 +922,7 @@ syncFile o ebloom rs af k = do
 	return (got || not (null putrs))
   where
 	wantget have inhere = allM id 
-		[ pure (pullOption o)
+		[ pure (pullOption o || operationMode o == SatisfyMode)
 		, pure (not $ null have)
 		, pure (not inhere)
 		, wantGet True (Just k) af
@@ -924,7 +936,7 @@ syncFile o ebloom rs af k = do
 			next $ return True
 
 	wantput r
-		| pushOption o == False = return False
+		| pushOption o == False && operationMode o /= SatisfyMode = return False
 		| Remote.readonly r || remoteAnnexReadOnly (Remote.gitconfig r) = return False
 		| isExport r = return False
 		| isThirdPartyPopulated r = return False
@@ -949,6 +961,7 @@ syncFile o ebloom rs af k = do
  - of the branch. (If the branch is not currently checked out, anything
  - imported from the remote will not yet have been merged into it yet and
  - so exporting would delete files from the remote unexpectedly.)
+ - (This is not done in SatifyMode.)
  -
  - Otherwise, transfer any files that were part of a previous export
  - but are not in the remote yet.
@@ -959,12 +972,14 @@ seekExportContent :: Maybe SyncOptions -> [Remote] -> CurrBranch -> Annex Bool
 seekExportContent o rs (currbranch, _) = or <$> forM rs go
   where
 	go r
+		| maybe False (\o' -> operationMode o' == SatisfyMode) o =
+			case remoteAnnexTrackingBranch (Remote.gitconfig r) of
+				Nothing -> return False
+				Just b -> withdb r $ \db ->
+					cannotupdateexport r db (Just b) False
 		| not (maybe True pushOption o) = return False
 		| not (remoteAnnexPush (Remote.gitconfig r)) = return False
-		| otherwise = bracket
+		| otherwise = withdb r (go' r)
-			(Export.openDb (Remote.uuid r))
-			Export.closeDb
-			(\db -> Export.writeLockDbWhile db (go' r db))
 	go' r db = case remoteAnnexTrackingBranch (Remote.gitconfig r) of
 		Nothing -> cannotupdateexport r db Nothing True
 		Just b -> do
@@ -986,6 +1001,11 @@ seekExportContent o rs (currbranch, _) = or <$> forM rs go
 					| otherwise -> cannotupdateexport r db (Just b) False
 				_ -> cannotupdateexport r db (Just b) True
 	
+	withdb r a = bracket
+		(Export.openDb (Remote.uuid r))
+		Export.closeDb
+		(\db -> Export.writeLockDbWhile db (a db))
+	
 	cannotupdateexport r db mtb showwarning = do
 		exported <- getExport (Remote.uuid r)
 		when showwarning $
@@ -1056,6 +1076,7 @@ cleanupRemote remote (Just b, _) =
 shouldSyncContent :: SyncOptions -> Annex Bool
 shouldSyncContent o
 	| fromMaybe False (noContentOption o) = pure False
+	| operationMode o == SatisfyMode = pure True
 	-- For git-annex pull and git-annex push and git-annex assist,
 	-- annex.syncontent defaults to True unless set
 	| operationMode o /= SyncMode = annexsynccontent True

doc/bugs/sync_-C_can_export_other_files.mdwn

@@ -0,0 +1,14 @@
+When an exporttree=yes remote has had a tree exported to it, but eg with
+`git-annex export master --to foo --fast`, so not all the files have been
+sent to it yet, `git-annex sync -Cfoo` will also export files in other
+directories to it.
+
+This seems like a bug, it ought to only export any files in the specified
+directory.
+
+Another way this can happen is `git-annex sync -Cfoo`, when file bar
+has changed. Currently this exports bar to the export remote, but does
+not send it to any other remotes, since it's not in directory foo.
+
+Also this affects `git-annex satisfy`, and other related commands too.
+--[[Joey]]

doc/git-annex-satisfy.mdwn

@@ -4,21 +4,34 @@ git-annex satisfy - transfer and drop content as configured
 
 # SYNOPSIS
 
-git annex satisffy `[path ...]`
+git annex satisfy `[remote ...]`
 
 # DESCRIPTION
 
-This transfers and drops content to satisfy the numcopies and preferred
+This transfers and drops content of annexed files to work toward satisfying
-content settings of the local repository and remotes.
+the preferred content settings of the local repository and remotes.
 
 It does the same thing as `git-annex sync --content` without the pulling
-and pushing of git repositories.
+and pushing of git repositories, and without changing the trees that are
-
+imported to or exported from special remotes.
-By default it operates on all annexed files in the current directory and
-its subdirectories. Paths of files or directories can also be specified.
 
 # OPTIONS
 
+* `[remote]`
+
+  By default this command operates on all remotes, except for remotes
+  that have `remote.<name>.annex-sync` set to false.
+
+  By specifying the names of remotes (or remote groups), you can control
+  which ones to operate on.
+
+* `--content-of=path` `-C path`
+
+  Operate on only files in the specified path. The default is to operate on
+  all files in the working tree.
+
+  This option can be repeated multiple times with different paths.
+
 * `--jobs=N` `-JN`
 
   Enables parallel processing with up to the specified number of jobs
@@ -28,47 +41,13 @@ its subdirectories. Paths of files or directories can also be specified.
 
 * `--all` `-A`
 
-  Operate on all objects stored in the git annex, not only objects used by
+  Usually this command operates on annexed files in the current branch.
-  currently existing files. 
+  This option makes it operate on all available versions of all annexed files
+  (when preferred content settings allow).
 
-  However, this bypasses checking the .gitattributes annex.numcopies
+  Note that preferred content settings that use `include=` or `exclude=`
-  setting when dropping files.
+  will only match the version of files currently in the work tree, but not
-
+  past versions of files.
-  This is the default behavior when running git-annex in a bare repository.
-
-* `--branch=ref`
-
-  Operate on files in the specified branch or treeish.
-
-  Like --all, this bypasses checking the .gitattributes annex.numcopies
-  setting when dropping files.
-
-* `--unused`
-
-  Operate on files found by last run of git-annex unused.
-
-* `--failed`
-
-  Operate on files that have recently failed to be transferred.
-
-* matching options
-
-  The [[git-annex-matching-options]](1)
-  can be used to control what files to operate on.
-
-* `--json`
-
-  Enable JSON output. This is intended to be parsed by programs that use
-  git-annex. Each line of output is a JSON object.
-
-* `--json-progress`
-
-  Include progress objects in JSON output.
-
-* `--json-error-messages`
-
-  Messages that would normally be output to standard error are included in
-  the JSON instead.
 
 * Also the [[git-annex-common-options]](1) can be used.
 
@@ -78,8 +57,6 @@ its subdirectories. Paths of files or directories can also be specified.
 
 [[git-annex-sync]](1)
 
-[[git-annex-preferred-numcopies]](1)
-
 [[git-annex-preferred-content]](1)
 
 # AUTHOR

doc/git-annex.mdwn

@@ -138,10 +138,9 @@ content from the key-value store.
   
   See [[git-annex-assist]](1) for details.
 
-* `satisfy [path ...]`
+* `satisfy [remote ...]`
 
-  Satisfy numcopies and preferred content settings by transferring
+  Satisfy preferred content settings by transferring and dropping content.
-  and dropping content.
   
   See [[git-annex-satisfy]](1) for details.
 

doc/todo/new_command_for_syncing_content_only.mdwn

@@ -19,3 +19,5 @@ What would be a good name for such a command?  --[[Joey]]
 > How about `git-annex port` as it carries content over like a luggage carrier aka. porter?
 > Another one that comes to mind is `git-annex shuttle` but that could be semantically too
 > similar to `git-annex assist`, perhaps. --[[jkniiv]]
+
+>> `git-annex satisfy` [[done]] --[[Joey]]

git-annex.cabal

@@ -790,6 +790,7 @@ Executable git-annex
     Command.ResolveMerge
     Command.Restage
     Command.RmUrl
+    Command.Satisfy
     Command.Schedule
     Command.Semitrust
     Command.SendKey