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.

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

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)

Assistant/Repair.hs

@@ -19,7 +19,7 @@ import qualified Types.Remote as Remote
 import Logs.FsckResults
 import Annex.UUID
 import Utility.Batch
-import Config.Files
+import Annex.Path
 import Assistant.Sync
 import Assistant.Alert
 import Assistant.DaemonStatus
@@ -105,7 +105,7 @@ runRepair u mrmt destructiverepair = do
 		return ok
 	
 	backgroundfsck params = liftIO $ void $ async $ do
-		program <- readProgramFile
+		program <- programPath
 		batchCommand program (Param "fsck" : params)
 
 {- Detect when a git lock file exists and has no git process currently

Assistant/Restart.hs

@@ -19,9 +19,9 @@ import Utility.Url
 import Utility.PID
 import qualified Git.Construct
 import qualified Git.Config
-import Config.Files
 import qualified Annex
 import qualified Git
+import Annex.Path
 
 import Control.Concurrent
 #ifndef mingw32_HOST_OS
@@ -110,7 +110,7 @@ assistantListening url = catchBoolIO $ exists url' def
  -}
 startAssistant :: FilePath -> IO ()
 startAssistant repo = void $ forkIO $ do
-	program <- readProgramFile
+	program <- programPath
 	(_, _, _, pid) <- 
 		createProcess $
 			(proc program ["assistant"]) { cwd = Just repo }

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

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)

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

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)

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

Assistant/WebApp/Configurators/Ssh.hs

@@ -28,7 +28,7 @@ import Logs.UUID
 import Assistant.RemoteControl
 import Types.Creds
 import Assistant.CredPairCache
-import Config.Files
+import Annex.Path
 import Utility.Tmp
 import Utility.FileMode
 import Utility.ThreadScheduler
@@ -381,7 +381,7 @@ sshAuthTranscript sshinput opts input = case inputAuthMethod sshinput of
 		Just (fromMaybe "" input)
 
 	setupAskPass = do
-		program <- liftIO readProgramFile
+		program <- liftIO programPath
 		v <- getCachedCred login
 		liftIO $ case v of
 			Nothing -> go [passwordprompts 0] Nothing

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"

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

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 

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