74c1e0660b
git -c was already propagated via environment, but need this for consistency. Also, notice it does not use gitAnnexChildProcess to run the transferrer. So nothing is done about avoid it taking the pid lock. It's possible that the caller is already doing something that took the pid lock, and if so, the transferrer will certianly fail, since it needs to take the pid lock too. This may prevent combining annex.stalldetection with annex.pidlock, but I have not verified it's really a problem. If it was, it seems git-annex would have to take the pid lock when starting a transferrer, and hold it until shutdown, or would need to take pid lock when starting to use a transferrer, and hold it until done with a transfer and then drop it. The latter would require starting the transferrer with pid locking disabled for the child process, so assumes that the transferrer does not do anyting that needs locking when not running a transfer.
77 lines
2.4 KiB
Haskell
77 lines
2.4 KiB
Haskell
{- git-annex program path
|
|
-
|
|
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.Path where
|
|
|
|
import Annex.Common
|
|
import Config.Files
|
|
import Utility.Env
|
|
import Annex.PidLock
|
|
import qualified Annex
|
|
|
|
import System.Environment (getExecutablePath)
|
|
|
|
{- A fully qualified path to the currently running git-annex program.
|
|
-
|
|
- getExecutablePath is used when possible. On OSs it supports
|
|
- well, it returns the complete path to the program. But, on other OSs,
|
|
- it might return just the basename. Fall back to reading the programFile,
|
|
- or searching for the command name in PATH.
|
|
-
|
|
- The standalone build runs git-annex via ld.so, and defeats
|
|
- getExecutablePath. It sets GIT_ANNEX_PROGRAMPATH to the correct path
|
|
- to the wrapper script to use.
|
|
-}
|
|
programPath :: IO FilePath
|
|
programPath = go =<< getEnv "GIT_ANNEX_PROGRAMPATH"
|
|
where
|
|
go (Just p) = return p
|
|
go Nothing = do
|
|
exe <- getExecutablePath
|
|
p <- if isAbsolute exe
|
|
then return exe
|
|
else fromMaybe exe <$> readProgramFile
|
|
maybe cannotFindProgram return =<< searchPath p
|
|
|
|
{- Returns the path for git-annex that is recorded in the programFile. -}
|
|
readProgramFile :: IO (Maybe FilePath)
|
|
readProgramFile = do
|
|
programfile <- programFile
|
|
headMaybe . lines <$> readFile programfile
|
|
|
|
cannotFindProgram :: IO a
|
|
cannotFindProgram = do
|
|
f <- programFile
|
|
giveup $ "cannot find git-annex program in PATH or in " ++ f
|
|
|
|
{- Runs a git-annex child process.
|
|
-
|
|
- Like runsGitAnnexChildProcessViaGit, when pid locking is in use,
|
|
- this takes the pid lock, while running it, and sets an env var
|
|
- that prevents the child process trying to take the pid lock,
|
|
- to avoid it deadlocking.
|
|
-}
|
|
gitAnnexChildProcess
|
|
:: String
|
|
-> [CommandParam]
|
|
-> (CreateProcess -> CreateProcess)
|
|
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
|
|
-> Annex a
|
|
gitAnnexChildProcess subcmd ps f a = do
|
|
cmd <- liftIO programPath
|
|
ps' <- gitAnnexChildProcessParams subcmd ps
|
|
pidLockChildProcess cmd ps' f a
|
|
|
|
{- Parameters to pass to a git-annex child process to run a subcommand
|
|
- with some parameters.
|
|
-
|
|
- Includes -c values that were passed on the git-annex command line.
|
|
-}
|
|
gitAnnexChildProcessParams :: String -> [CommandParam] -> Annex [CommandParam]
|
|
gitAnnexChildProcessParams subcmd ps = do
|
|
cps <- concatMap (\c -> [Param "-c", Param c]) <$> Annex.getGitConfigOverrides
|
|
return (Param subcmd : cps ++ ps)
|