use programPath consistently, not readProgramFile

Improve git-annex's ability to find the path to its program, especially
when it needs to run itself in another repo to upgrade it.

Some parts of the code used readProgramFile, probably because I forgot that
programPath exists.

I noticed this when a git-annex auto-upgrade failed because it was running
git-annex upgrade --autoonly, but the code to run git-annex used
readProgramFile, which happened to point to an older build of git-annex.

Annex/Multicast.hs

@@ -7,7 +7,7 @@
 
 module Annex.Multicast where
 
-import Config.Files
+import Annex.Path
 import Utility.Env
 import Utility.PartialPrelude
 
@@ -22,7 +22,7 @@ multicastReceiveEnv = "GIT_ANNEX_MULTICAST_RECEIVE"
 
 multicastCallbackEnv :: IO (FilePath, [(String, String)], Handle)
 multicastCallbackEnv = do
-	gitannex <- readProgramFile
+	gitannex <- programPath
 	-- This will even work on Windows
 	(rfd, wfd) <- createPipeFd
 	rh <- fdToHandle rfd

Annex/Path.hs

@@ -34,3 +34,24 @@ programPath = go =<< getEnv "GIT_ANNEX_PROGRAMPATH"
 			then return exe
 			else readProgramFile
 		maybe cannotFindProgram return =<< searchPath p
+
+{- Returns the path for git-annex that is recorded in the programFile. -}
+readProgramFile :: IO FilePath
+readProgramFile = do
+	programfile <- programFile
+	p <- catchDefaultIO cmd $ 
+		fromMaybe cmd . headMaybe . lines <$> readFile programfile
+	ifM (inPath p)
+		( return p
+		, ifM (inPath cmd)
+			( return cmd
+			, cannotFindProgram
+			)
+		)
+  where
+	cmd = "git-annex"
+
+cannotFindProgram :: IO a
+cannotFindProgram = do
+	f <- programFile
+	giveup $ "cannot find git-annex program in PATH or in " ++ f

Assistant/WebApp/Configurators/Pairing.hs

@@ -33,7 +33,7 @@ import Assistant.WebApp.SideBar
 import Command.P2P (unusedPeerRemoteName, PairingResult(..))
 import P2P.Address
 import Git
-import Config.Files
+import Annex.Path
 import Utility.Process.Transcript
 
 import qualified Data.Map as M
@@ -72,7 +72,7 @@ getPrepareWormholePairR pairingwith = do
 
 enableTor :: Handler ()
 enableTor = do
-	gitannex <- liftIO readProgramFile
+	gitannex <- liftIO programPath
 	(transcript, ok) <- liftIO $ processTranscript gitannex ["enable-tor"] Nothing
 	if ok
 		-- Reload remotedameon so it's serving the tor hidden

CHANGELOG

@@ -1,3 +1,10 @@
+git-annex (8.20200331) UNRELEASED; urgency=medium
+
+  * Improve git-annex's ability to find the path to its program,
+    especially when it needs to run itself in another repo to upgrade it.
+
+ -- Joey Hess <id@joeyh.name>  Mon, 30 Mar 2020 15:58:34 -0400
+
 git-annex (8.20200330) upstream; urgency=medium
 
   * fsck: Fix reversion in 8.20200226 that made it incorrectly warn

Command/EnableTor.hs

@@ -16,7 +16,7 @@ import P2P.Annex
 import Utility.Tor
 import Annex.UUID
 #ifndef mingw32_HOST_OS
-import Config.Files
+import Annex.Path
 #endif
 import P2P.IO
 import qualified P2P.Protocol as P2P
@@ -53,7 +53,7 @@ start _os = do
 			Nothing -> giveup "Need user-id parameter."
 			Just userid -> go userid
 		else starting "enable-tor" (ActionItemOther Nothing) $ do
-			gitannex <- liftIO readProgramFile
+			gitannex <- liftIO programPath
 			let ps = [Param (cmdname cmd), Param (show curruserid)]
 			sucommand <- liftIO $ mkSuCommand gitannex ps
 			maybe noop showLongNote

Command/Sync.hs

@@ -46,7 +46,7 @@ import Config
 import Config.GitConfig
 import Annex.SpecialRemote.Config
 import Config.DynamicConfig
-import Config.Files
+import Annex.Path
 import Annex.Wanted
 import Annex.Content
 import Command.Get (getKey')
@@ -509,7 +509,7 @@ pushRemote o remote (Just branch, _) = do
 		Nothing -> return True
 		Just wt -> ifM needemulation
 			( liftIO $ do
-				p <- readProgramFile
+				p <- programPath
 				boolSystem' p [Param "post-receive"]
 					(\cp -> cp { cwd = Just (fromRawFilePath wt) })
 			, return True

Config/Files.hs

@@ -61,27 +61,6 @@ removeAutoStartFile path = do
 programFile :: IO FilePath
 programFile = userConfigFile "program"
 
-{- Returns a command to run for git-annex. -}
-readProgramFile :: IO FilePath
-readProgramFile = do
-	programfile <- programFile
-	p <- catchDefaultIO cmd $ 
-		fromMaybe cmd . headMaybe . lines <$> readFile programfile
-	ifM (inPath p)
-		( return p
-		, ifM (inPath cmd)
-			( return cmd
-			, cannotFindProgram
-			)
-		)
-  where
-	cmd = "git-annex"
-
-cannotFindProgram :: IO a
-cannotFindProgram = do
-	f <- programFile
-	giveup $ "cannot find git-annex program in PATH or in the location listed in " ++ f
-
 {- A .noannex file in a git repository prevents git-annex from
  - initializing that repository.. The content of the file is returned. -}
 noAnnexFileContent :: Maybe FilePath -> IO (Maybe String)

Upgrade.hs

@@ -13,7 +13,7 @@ import Annex.Common
 import qualified Annex
 import qualified Git
 import Config
-import Config.Files
+import Annex.Path
 import Annex.Version
 import Types.RepoVersion
 #ifndef mingw32_HOST_OS
@@ -103,7 +103,7 @@ upgrade automatic destversion = do
 	-- upgrading a git repo other than the current repo.
 	upgraderemote = do
 		rp <- fromRawFilePath <$> fromRepo Git.repoPath
-		cmd <- liftIO readProgramFile
+		cmd <- liftIO programPath
 		liftIO $ boolSystem' cmd
 			[ Param "upgrade"
 			, Param "--quiet"