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.

diff --git a/Annex/Multicast.hs b/Annex/Multicast.hs
index 4aa213939ef03b01c224c09172f6876269715435..1443de776c8eeb1881a57e06454cd8edf4c14d47 100644 (file)
--- a/Annex/Multicast.hs
+++ b/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

diff --git a/Annex/Path.hs b/Annex/Path.hs
index dba10a1cefb66b05197338058c4c95039ae8322d..70564058f436685f6733ee7a46126201d377e222 100644 (file)
--- a/Annex/Path.hs
+++ b/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

diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs
index 4088ebb1c57a1b278999abddd4d769aa9811362d..1f01fa9be6af86704fa7d0d13c5da9e9e912061f 100644 (file)
--- a/Assistant/WebApp/Configurators/Pairing.hs
+++ b/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

diff --git a/CHANGELOG b/CHANGELOG
index 12dbd9f582d3c885d913b71bb175c1cf26b0f5a0..8a63f14123112c065d90dff7f3a4b78e876ce855 100644 (file)
--- a/CHANGELOG
+++ b/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

diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs
index df4b43cfd345a623f3c82338dcb626d3eb50c3ba..df08217afb309f720cd4db0b809462e6fcea590a 100644 (file)
--- a/Command/EnableTor.hs
+++ b/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

diff --git a/Command/Sync.hs b/Command/Sync.hs
index fe6f72c7dcced427b715838a91efdbd3b97a819e..49ec61cb526f2761d2ae0e5a7208d1885ab25c2a 100644 (file)
--- a/Command/Sync.hs
+++ b/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

diff --git a/Config/Files.hs b/Config/Files.hs
index 8ad4fe5bcfd509332f7a827f906e06e20aac9a02..17ebd6f85778af61958a3babd700e2b9f9dc38d1 100644 (file)
--- a/Config/Files.hs
+++ b/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)

diff --git a/Upgrade.hs b/Upgrade.hs
index 13e55f8cde15a49b0dda9951e644a74f821f70de..6879fd7bea7a031e5b80448e9e039c0de312739a 100644 (file)
--- a/Upgrade.hs
+++ b/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"