From a7840c0e04398a1f0e44ba68b040fbdbbba3af80 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 15 Apr 2020 16:46:34 -0400 Subject: [PATCH] improve programPath Fixes a failure mode where git-annex sync would try to run git-annex and complain that it failed to find it in ~/.config/git-annex/program or PATH, when there was a git-annex in /usr/bin/, but the original one was run from elsewhere (eg, ~/bin) and happened not to be present any longer. Now, it will fall back to using git-annex from PATH in such a case. Which might fail due to some version incompatability, but still better than a misleading error message. Also made readProgramFile only read the file, not look for git-annex in PATH as a fallback. That fallback may have confused Assistant.Upgrade, which really wants the value from the file. --- Annex/Path.hs | 16 +++------------- Assistant/Upgrade.hs | 33 +++++++++++++++++---------------- 2 files changed, 20 insertions(+), 29 deletions(-) diff --git a/Annex/Path.hs b/Annex/Path.hs index 70564058f4..26baf908ab 100644 --- a/Annex/Path.hs +++ b/Annex/Path.hs @@ -32,24 +32,14 @@ programPath = go =<< getEnv "GIT_ANNEX_PROGRAMPATH" exe <- getExecutablePath p <- if isAbsolute exe then return exe - else readProgramFile + else fromMaybe exe <$> readProgramFile maybe cannotFindProgram return =<< searchPath p {- Returns the path for git-annex that is recorded in the programFile. -} -readProgramFile :: IO FilePath +readProgramFile :: IO (Maybe 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" + headMaybe . lines <$> readFile programfile cannotFindProgram :: IO a cannotFindProgram = do diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index a8a6778abe..a0645100ee 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -225,20 +225,22 @@ upgradeToDistribution newdir cleanup distributionfile = do {- Finds where the old version was installed. -} oldVersionLocation :: IO FilePath -oldVersionLocation = do - pdir <- parentDir <$> readProgramFile +oldVersionLocation = readProgramFile >>= \case + Nothing -> error "Cannot find old distribution bundle; not upgrading." + Just pf -> do + let pdir = parentDir pf #ifdef darwin_HOST_OS - let dirs = splitDirectories pdir - {- It will probably be deep inside a git-annex.app directory. -} - let olddir = case findIndex ("git-annex.app" `isPrefixOf`) dirs of - Nothing -> pdir - Just i -> joinPath (take (i + 1) dirs) + let dirs = splitDirectories pdir + {- It will probably be deep inside a git-annex.app directory. -} + let olddir = case findIndex ("git-annex.app" `isPrefixOf`) dirs of + Nothing -> pdir + Just i -> joinPath (take (i + 1) dirs) #else - let olddir = pdir + let olddir = pdir #endif - when (null olddir) $ - error $ "Cannot find old distribution bundle; not upgrading. (Looked in " ++ pdir ++ ")" - return olddir + when (null olddir) $ + error $ "Cannot find old distribution bundle; not upgrading. (Looked in " ++ pdir ++ ")" + return olddir {- Finds a place to install the new version. - Generally, put it in the parent directory of where the old version was @@ -344,10 +346,9 @@ distributionInfoSigUrl = distributionInfoUrl ++ ".sig" - trustedkeys.gpg, next to the git-annex program. -} verifyDistributionSig :: GpgCmd -> FilePath -> IO Bool -verifyDistributionSig gpgcmd sig = do - p <- readProgramFile - if isAbsolute p - then withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do +verifyDistributionSig gpgcmd sig = readProgramFile >>= \case + Just p | isAbsolute p -> + withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do let trustedkeys = takeDirectory p "trustedkeys.gpg" boolGpgCmd gpgcmd [ Param "--no-default-keyring" @@ -360,4 +361,4 @@ verifyDistributionSig gpgcmd sig = do , Param "--verify" , File sig ] - else return False + _ -> return False