git-remote-annex: Fix buggy behavior when annex.stalldetection is configured
Make programPath never return "git-remote-annex" or other known multi-call program names, which are not git-annex and won't behave like it. If the git-annex binary gets installed under some entirely other name, it will still return it. This change exposed that readProgramFile actually could crash, which happened before only if getExecutablePath was not absolute and there was no ~/.config/git-annex/program. So fixed that to catch exception.
This commit is contained in:
parent
2fc76ef062
commit
8663c72f1e
7 changed files with 66 additions and 11 deletions
|
@ -1,6 +1,6 @@
|
|||
{- git-annex program path
|
||||
-
|
||||
- Copyright 2013-2022 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2013-2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -18,9 +18,11 @@ import Annex.Common
|
|||
import Config.Files
|
||||
import Utility.Env
|
||||
import Annex.PidLock
|
||||
import CmdLine.Multicall
|
||||
import qualified Annex
|
||||
|
||||
import System.Environment (getExecutablePath, getArgs, getProgName)
|
||||
import qualified Data.Map as M
|
||||
|
||||
{- A fully qualified path to the currently running git-annex program.
|
||||
-
|
||||
|
@ -33,23 +35,35 @@ import System.Environment (getExecutablePath, getArgs, getProgName)
|
|||
- getExecutablePath. It sets GIT_ANNEX_DIR to the location of the
|
||||
- standalone build directory, and there are wrapper scripts for git-annex
|
||||
- and git-annex-shell in that directory.
|
||||
-
|
||||
- When the currently running program is not git-annex, but is instead eg
|
||||
- git-annex-shell or git-remote-annex, this finds a git-annex program
|
||||
- instead.
|
||||
-}
|
||||
programPath :: IO FilePath
|
||||
programPath = go =<< getEnv "GIT_ANNEX_DIR"
|
||||
where
|
||||
go (Just dir) = do
|
||||
name <- getProgName
|
||||
name <- reqgitannex <$> getProgName
|
||||
return (dir </> name)
|
||||
go Nothing = do
|
||||
exe <- getExecutablePath
|
||||
name <- getProgName
|
||||
exe <- if isgitannex name
|
||||
then getExecutablePath
|
||||
else pure "git-annex"
|
||||
p <- if isAbsolute exe
|
||||
then return exe
|
||||
else fromMaybe exe <$> readProgramFile
|
||||
maybe cannotFindProgram return =<< searchPath p
|
||||
|
||||
reqgitannex name
|
||||
| isgitannex name = name
|
||||
| otherwise = "git-annex"
|
||||
isgitannex = flip M.notMember otherMulticallCommands
|
||||
|
||||
{- Returns the path for git-annex that is recorded in the programFile. -}
|
||||
readProgramFile :: IO (Maybe FilePath)
|
||||
readProgramFile = do
|
||||
readProgramFile = catchDefaultIO Nothing $ do
|
||||
programfile <- programFile
|
||||
headMaybe . lines <$> readFile programfile
|
||||
|
||||
|
|
|
@ -23,6 +23,8 @@ git-annex (10.20241032) UNRELEASED; urgency=medium
|
|||
unnecessary duplicate password prompts.
|
||||
* git-remote-annex: Require git version 2.31 or newer, since old
|
||||
ones had a buggy git bundle command.
|
||||
* git-remote-annex: Fix buggy behavior when annex.stalldetection is
|
||||
configured.
|
||||
* p2phttp: Added --directory option which serves multiple git-annex
|
||||
repositories located inside a directory.
|
||||
|
||||
|
|
28
CmdLine/Multicall.hs
Normal file
28
CmdLine/Multicall.hs
Normal file
|
@ -0,0 +1,28 @@
|
|||
{- git-annex multicall binary
|
||||
-
|
||||
- Copyright 2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module CmdLine.Multicall where
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- Commands besides git-annex that can be run by the multicall binary.
|
||||
--
|
||||
-- The reason git-annex itself is not included here is because the program
|
||||
-- can be renamed to any other name than these and will behave the same as
|
||||
-- git-annex.
|
||||
data OtherMultiCallCommand
|
||||
= GitAnnexShell
|
||||
| GitRemoteAnnex
|
||||
| GitRemoteTorAnnex
|
||||
|
||||
otherMulticallCommands :: M.Map String OtherMultiCallCommand
|
||||
otherMulticallCommands = M.fromList
|
||||
[ ("git-annex-shell", GitAnnexShell)
|
||||
, ("git-remote-annex", GitRemoteAnnex)
|
||||
, ("git-remote-tor-annex", GitRemoteTorAnnex)
|
||||
]
|
||||
|
|
@ -75,4 +75,6 @@ although there in first failing was a bit different on OSX
|
|||
Use -p '/git-remote-annex/' to rerun this test only.
|
||||
```
|
||||
|
||||
[[!meta title="git-remote-annex clone from special remote fails on OSX"]]
|
||||
[[!meta title="git-remote-annex clone from special remote fails"]]
|
||||
|
||||
> [[fixed|done]] --[[Joey]]
|
||||
|
|
|
@ -5,4 +5,6 @@
|
|||
content="""
|
||||
And the specific reason these test cases are failing is because they have
|
||||
annex.stalldetection set, which needs to run the transferrer.
|
||||
|
||||
Fixed this.
|
||||
"""]]
|
||||
|
|
|
@ -633,9 +633,10 @@ Executable git-annex
|
|||
CmdLine.GitAnnexShell.Checks
|
||||
CmdLine.GitAnnexShell.Fields
|
||||
CmdLine.AnnexSetter
|
||||
CmdLine.Option
|
||||
CmdLine.Multicall
|
||||
CmdLine.GitRemoteAnnex
|
||||
CmdLine.GitRemoteTorAnnex
|
||||
CmdLine.Option
|
||||
CmdLine.Seek
|
||||
CmdLine.Usage
|
||||
Command
|
||||
|
|
16
git-annex.hs
16
git-annex.hs
|
@ -10,7 +10,9 @@
|
|||
import System.Environment (getArgs, getProgName)
|
||||
import System.FilePath
|
||||
import Network.Socket (withSocketsDo)
|
||||
import qualified Data.Map as M
|
||||
|
||||
import CmdLine.Multicall
|
||||
import qualified CmdLine.GitAnnex
|
||||
import qualified CmdLine.GitAnnexShell
|
||||
import qualified CmdLine.GitRemoteAnnex
|
||||
|
@ -34,11 +36,15 @@ main = sanitizeTopLevelExceptionMessages $ withSocketsDo $ do
|
|||
#endif
|
||||
run ps =<< getProgName
|
||||
where
|
||||
run ps n = case takeFileName n of
|
||||
"git-annex-shell" -> CmdLine.GitAnnexShell.run ps
|
||||
"git-remote-annex" -> CmdLine.GitRemoteAnnex.run ps
|
||||
"git-remote-tor-annex" -> CmdLine.GitRemoteTorAnnex.run ps
|
||||
_ -> CmdLine.GitAnnex.run Test.optParser Test.runner Benchmark.mkGenerator ps
|
||||
run ps n = case M.lookup (takeFileName n) otherMulticallCommands of
|
||||
Just GitAnnexShell -> CmdLine.GitAnnexShell.run ps
|
||||
Just GitRemoteAnnex -> CmdLine.GitRemoteAnnex.run ps
|
||||
Just GitRemoteTorAnnex -> CmdLine.GitRemoteTorAnnex.run ps
|
||||
Nothing -> CmdLine.GitAnnex.run
|
||||
Test.optParser
|
||||
Test.runner
|
||||
Benchmark.mkGenerator
|
||||
ps
|
||||
|
||||
#ifdef mingw32_HOST_OS
|
||||
{- On Windows, if HOME is not set, probe it and set it.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue