Avoid repeated location log commits when a remote is receiving files.

Done by adding a oneshot mode, in which location log changes are written to
the journal, but not committed. Taking advantage of git-annex's existing
ability to recover in this situation.

This is used by git-annex-shell and other places where changes are made to
a remote's location log.

Annex/Content.hs

@@ -291,11 +291,16 @@ getKeysPresent' dir = do
 			let files = concat contents
 			return $ mapMaybe (fileKey . takeFileName) files
 
-{- Things to do to record changes to content. -}
-saveState :: Annex ()
-saveState = do
+{- Things to do to record changes to content when shutting down.
+ -
+ - It's acceptable to avoid committing changes to the branch,
+ - especially if performing a short-lived action.
+ -}
+saveState :: Bool -> Annex ()
+saveState oneshot = do
 	Annex.Queue.flush False
-	Annex.Branch.commit "update"
+	unless oneshot $
+		Annex.Branch.commit "update"
 
 {- Downloads content from any of a list of urls. -}
 downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool

CmdLine.hs

@@ -29,8 +29,8 @@ type Params = [String]
 type Flags = [Annex ()]
 
 {- Runs the passed command line. -}
-dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
-dispatch args cmds commonoptions header getgitrepo = do
+dispatch :: Bool -> Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
+dispatch oneshot args cmds commonoptions header getgitrepo = do
 	setupConsole
 	r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
 	case r of
@@ -40,7 +40,7 @@ dispatch args cmds commonoptions header getgitrepo = do
 			(actions, state') <- Annex.run state $ do
 				sequence_ flags
 				prepCommand cmd params
-			tryRun state' cmd $ [startup] ++ actions ++ [shutdown]
+			tryRun state' cmd $ [startup] ++ actions ++ [shutdown oneshot]
 	where
 		(flags, cmd, params) = parseCmd args cmds commonoptions header
 
@@ -89,9 +89,9 @@ startup :: Annex Bool
 startup = return True
 
 {- Cleanup actions. -}
-shutdown :: Annex Bool
-shutdown = do
-	saveState
+shutdown :: Bool -> Annex Bool
+shutdown oneshot = do
+	saveState oneshot
 	liftIO Git.Command.reap -- zombies from long-running git processes
 	sshCleanup -- ssh connection caching
 	return True

Command/RecvKey.hs

@@ -28,7 +28,7 @@ start key = do
 	if ok
 		then do
 			-- forcibly quit after receiving one key,
-			-- and shutdown cleanly so queued git commands run
-			_ <- shutdown
+			-- and shutdown cleanly
+			_ <- shutdown True
 			liftIO exitSuccess
 		else liftIO exitFailure

Command/Uninit.hs

@@ -57,7 +57,7 @@ cleanup = do
 	mapM_ removeAnnex =<< getKeysPresent
 	liftIO $ removeDirectoryRecursive annexdir
 	-- avoid normal shutdown
-	saveState
+	saveState False
 	inRepo $ Git.Command.run "branch"
 		[Param "-D", Param $ show Annex.Branch.name]
 	liftIO exitSuccess

GitAnnex.hs

@@ -129,4 +129,4 @@ header :: String
 header = "Usage: git-annex command [option ..]"
 
 run :: [String] -> IO ()
-run args = dispatch args cmds options header Git.Construct.fromCurrent
+run args = dispatch False args cmds options header Git.Construct.fromCurrent

Remote/Git.hs

@@ -230,7 +230,7 @@ copyToRemote r key
 		-- run copy from perspective of remote
 		liftIO $ onLocal r $ do
 			ensureInitialized
-			Annex.Content.saveState `after`
+			Annex.Content.saveState True `after`
 				Annex.Content.getViaTmp key
 					(rsyncOrCopyFile params keysrc)
 	| Git.repoIsSsh r = do

Upgrade/V2.hs

@@ -50,7 +50,7 @@ upgrade = do
 		mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs
 		mapM_ (\f -> inject f f) =<< logFiles old
 
-	saveState
+	saveState False
 	showProgress
 
 	when e $ do

debian/changelog

@@ -1,6 +1,12 @@
 git-annex (3.20120124) UNRELEASED; urgency=low
 
   * Use the haskell IfElse library.
+  * Avoid repeated location log commits when a remote is receiving files.
+    Done by adding a oneshot mode, in which location log changes are
+    written to the journal, but not committed. Taking advantage of
+    git-annex's existing ability to recover in this situation. This is
+    used by git-annex-shell and other places where changes are made to
+    a remote's location log.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 24 Jan 2012 16:21:55 -0400
 

git-annex-shell.hs

@@ -82,7 +82,7 @@ builtins = map cmdname cmds
 builtin :: String -> String -> [String] -> IO ()
 builtin cmd dir params = do
 	checkNotReadOnly cmd
-	dispatch (cmd : filterparams params) cmds options header $
+	dispatch True (cmd : filterparams params) cmds options header $
 		Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
 
 external :: [String] -> IO ()