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.

9 files changed, 28 insertions, 17 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index c21ac405e..dcfd43866 100644
--- a/Annex/Content.hs
+++ b/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
diff --git a/CmdLine.hs b/CmdLine.hs
index 29b95d01b..61e6c26bb 100644
--- a/CmdLine.hs
+++ b/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
diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index 5243fa9d4..a27a5efdf 100644
--- a/Command/RecvKey.hs
+++ b/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
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index cef89a5cf..ec6d0abf3 100644
--- a/Command/Uninit.hs
+++ b/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
diff --git a/GitAnnex.hs b/GitAnnex.hs
index 4af10a9ce..1ca89315a 100644
--- a/GitAnnex.hs
+++ b/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
diff --git a/Remote/Git.hs b/Remote/Git.hs
index efe182961..501a617c0 100644
--- a/Remote/Git.hs
+++ b/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
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index ffc2f6002..c57b0bf68 100644
--- a/Upgrade/V2.hs
+++ b/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
diff --git a/debian/changelog b/debian/changelog
index e1c861d19..96234d927 100644
--- a/debian/changelog
+++ b/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
 
diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index 4fdeae1a8..e747a447b 100644
--- a/git-annex-shell.hs
+++ b/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 ()