From 87d5583a91adfeea93addc90a894131fb6f8347b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 30 Mar 2020 16:03:44 -0400 Subject: [PATCH] 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 | 4 ++-- Annex/Path.hs | 21 +++++++++++++++++++++ Assistant/WebApp/Configurators/Pairing.hs | 4 ++-- CHANGELOG | 7 +++++++ Command/EnableTor.hs | 4 ++-- Command/Sync.hs | 4 ++-- Config/Files.hs | 21 --------------------- Upgrade.hs | 4 ++-- 8 files changed, 38 insertions(+), 31 deletions(-) diff --git a/Annex/Multicast.hs b/Annex/Multicast.hs index 4aa213939e..1443de776c 100644 --- 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 dba10a1cef..70564058f4 100644 --- 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 4088ebb1c5..1f01fa9be6 100644 --- 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 12dbd9f582..8a63f14123 100644 --- 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 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 df4b43cfd3..df08217afb 100644 --- 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 fe6f72c7dc..49ec61cb52 100644 --- 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 8ad4fe5bcf..17ebd6f857 100644 --- 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 13e55f8cde..6879fd7bea 100644 --- 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"