When re-execing git-annex, use current program location, rather than ~/.config/git-annex/program, when possible.

Most of the time, there will be no discreprancy between programPath and
readProgramFile.

But, the programFile might have been written by an old version of git-annex
that is still installed, while a newer one is currently running. In this
case, we want to run the same one that's currently running.

This is especially important for things like the GIT_SSH=git-annex used for
ssh connection caching.

The only code that still uses readProgramFile directly is the upgrade code,
which needs to know where the standalone git-annex was installed, in order to
upgrade it.

11 files changed, 22 insertions, 19 deletions

diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 54c54d79f..cd28d1fc0 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -31,7 +31,7 @@ import qualified Annex
 import qualified Git
 import qualified Git.Url
 import Config
-import Config.Files
+import Annex.Path
 import Utility.Env
 import Types.CleanupActions
 import Annex.Index (addGitEnv)
@@ -273,7 +273,7 @@ sshOptionsTo remote gc g
 			case msockfile of
 				Nothing -> return g
 				Just sockfile -> do
-					command <- liftIO readProgramFile
+					command <- liftIO programPath
 					prepSocket sockfile
 					let val = toSshOptionsEnv $ concat
 						[ sshConnectionCachingParams sockfile
diff --git a/Assistant.hs b/Assistant.hs
index eb01bb9b9..b95348604 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -104,7 +104,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 			( liftIO $ withFile devNull WriteMode $ \nullh -> do
 				loghandle <- openLog logfile
 				e <- getEnvironment
-				cmd <- readProgramFile
+				cmd <- programPath
 				ps <- getArgs
 				(_, _, _, pid) <- createProcess (proc cmd ps)
 					{ env = Just (addEntry flag "1" e)
diff --git a/Assistant/Threads/Cronner.hs b/Assistant/Threads/Cronner.hs
index 451fa75c6..14026cfcc 100644
--- a/Assistant/Threads/Cronner.hs
+++ b/Assistant/Threads/Cronner.hs
@@ -15,7 +15,7 @@ import Assistant.Common
 import Assistant.DaemonStatus
 import Utility.NotificationBroadcaster
 import Annex.UUID
-import Config.Files
+import Annex.Path
 import Logs.Schedule
 import Utility.Scheduled
 import Types.ScheduledActivity
@@ -181,7 +181,7 @@ runActivity urlrenderer activity nowt = do
 
 runActivity' :: UrlRenderer -> ScheduledActivity -> Assistant ()
 runActivity' urlrenderer (ScheduledSelfFsck _ d) = do
-	program <- liftIO $ readProgramFile
+	program <- liftIO programPath
 	g <- liftAnnex gitRepo
 	fsckresults <- showFscking urlrenderer Nothing $ tryNonAsync $ do
 		void $ batchCommand program (Param "fsck" : annexFsckParams d)
@@ -196,7 +196,7 @@ runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (r
 	dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]
 	dispatch (Just rmt) = void $ case Remote.remoteFsck rmt of
 		Nothing -> go rmt $ do
-			program <- readProgramFile
+			program <- programPath
 			void $ batchCommand program $ 
 				[ Param "fsck"
 				-- avoid downloading files
diff --git a/Assistant/Threads/RemoteControl.hs b/Assistant/Threads/RemoteControl.hs
index ae63aff5c..447b493c6 100644
--- a/Assistant/Threads/RemoteControl.hs
+++ b/Assistant/Threads/RemoteControl.hs
@@ -9,7 +9,7 @@ module Assistant.Threads.RemoteControl where
 
 import Assistant.Common
 import RemoteDaemon.Types
-import Config.Files
+import Annex.Path
 import Utility.Batch
 import Utility.SimpleProtocol
 import Assistant.Alert
@@ -28,7 +28,7 @@ import qualified Data.Set as S
 
 remoteControlThread :: NamedThread
 remoteControlThread = namedThread "RemoteControl" $ do
-	program <- liftIO readProgramFile
+	program <- liftIO programPath
 	(cmd, params) <- liftIO $ toBatchCommand
 		(program, [Param "remotedaemon"])
 	let p = proc cmd (toCommand params)
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index 3073cfe41..0f2c1245a 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -39,7 +39,7 @@ import Git.Index
 import Assistant.Unused
 import Logs.Unused
 import Logs.Transfer
-import Config.Files
+import Annex.Path
 import Types.Key (keyBackendName)
 import qualified Annex
 #ifdef WITH_WEBAPP
@@ -182,7 +182,7 @@ dailyCheck urlrenderer = do
 	{- Run git-annex unused once per day. This is run as a separate
 	 - process to stay out of the annex monad and so it can run as a
 	 - batch job. -}
-	program <- liftIO readProgramFile
+	program <- liftIO programPath
 	let (program', params') = batchmaker (program, [Param "unused"])
 	void $ liftIO $ boolSystem program' params'
 	{- Invalidate unused keys cache, and queue transfers of all unused
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 073dbef3c..9e9256e3a 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -11,13 +11,13 @@ import Assistant.Common
 import Assistant.TransferQueue
 import Assistant.TransferSlots
 import Logs.Transfer
-import Config.Files
+import Annex.Path
 import Utility.Batch
 
 {- Dispatches transfers from the queue. -}
 transfererThread :: NamedThread
 transfererThread = namedThread "Transferrer" $ do
-	program <- liftIO readProgramFile
+	program <- liftIO programPath
 	batchmaker <- liftIO getBatchCommandMaker
 	forever $ inTransferSlot program batchmaker $
 		maybe (return Nothing) (uncurry genTransfer)
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index bbc2ec7e5..7490ede39 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -28,7 +28,7 @@ import qualified Remote
 import qualified Types.Remote as Remote
 import Annex.Content
 import Annex.Wanted
-import Config.Files
+import Annex.Path
 import Utility.Batch
 
 import qualified Data.Map as M 
@@ -284,7 +284,7 @@ startTransfer t = do
 		alterTransferInfo t $ \i -> i { transferPaused = False }
 		liftIO $ throwTo tid ResumeTransfer
 	start info = do
-		program <- liftIO readProgramFile
+		program <- liftIO programPath
 		batchmaker <- liftIO getBatchCommandMaker
 		inImmediateTransferSlot program batchmaker $
 			genTransfer t info
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs
index 2186b5bce..2841a1cf8 100644
--- a/Assistant/XMPP/Git.hs
+++ b/Assistant/XMPP/Git.hs
@@ -20,6 +20,7 @@ import Assistant.MakeRemote
 import Assistant.Sync
 import qualified Command.Sync
 import qualified Annex.Branch
+import Annex.Path
 import Annex.UUID
 import Logs.UUID
 import Annex.TaggedPush
@@ -27,7 +28,6 @@ import Annex.CatFile
 import Config
 import Git
 import qualified Git.Branch
-import Config.Files
 import qualified Types.Remote as Remote
 import qualified Remote as Remote
 import Remote.List
@@ -173,7 +173,7 @@ xmppPush cid gitpush = do
 	installwrapper tmpdir = liftIO $ do
 		createDirectoryIfMissing True tmpdir
 		let wrapper = tmpdir </> "git-remote-xmpp"
-		program <- readProgramFile
+		program <- programPath
 		writeFile wrapper $ unlines
 			[ shebang_local
 			, "exec " ++ program ++ " xmppgit"
diff --git a/Command/Assistant.hs b/Command/Assistant.hs
index 5bdf51682..0fad6b619 100644
--- a/Command/Assistant.hs
+++ b/Command/Assistant.hs
@@ -11,6 +11,7 @@ import Common.Annex
 import Command
 import qualified Command.Watch
 import Annex.Init
+import Annex.Path
 import Config.Files
 import qualified Build.SysConfig
 import Utility.HumanTime
@@ -69,7 +70,7 @@ autoStart startdelay = do
 	when (null dirs) $ do
 		f <- autoStartFile
 		error $ "Nothing listed in " ++ f
-	program <- readProgramFile
+	program <- programPath
 	haveionice <- pure Build.SysConfig.ionice <&&> inPath "ionice"
 	forM_ dirs $ \d -> do
 		putStrLn $ "git-annex autostart in " ++ d
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 01fc0d663..a7cecfc5c 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -49,7 +49,7 @@ import Remote.Helper.Git
 import Remote.Helper.Messages
 import qualified Remote.Helper.Ssh as Ssh
 import qualified Remote.GCrypt
-import Config.Files
+import Annex.Path
 import Creds
 import Annex.CatFile
 
@@ -499,7 +499,7 @@ fsckOnRemote r params
 			Nothing -> return False
 			Just (c, ps) -> batchCommand c ps
 	| otherwise = return $ do
-		program <- readProgramFile
+		program <- programPath
 		r' <- Git.Config.read r
 		environ <- getEnvironment
 		let environ' = addEntries 
diff --git a/debian/changelog b/debian/changelog
index 758a8d816..b5b545ca2 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -19,6 +19,8 @@ git-annex (5.2015022) UNRELEASED; urgency=medium
     git-annex:git-annex push, as long as the remote branch
     is an ancestor of the local branch, to better support bare git repos.
     (This used to be done, but it forgot to do it since version 4.20130909.)
+  * When re-execing git-annex, use current program location, rather than
+    ~/.config/git-annex/program, when possible.
 
  -- Joey Hess <id@joeyh.name>  Thu, 19 Feb 2015 14:16:03 -0400