When re-execing git-annex, use current program location, rather than ~/.config/git-annex/program, when possible.

Most of the time, there will be no discreprancy between programPath and
readProgramFile.

But, the programFile might have been written by an old version of git-annex
that is still installed, while a newer one is currently running. In this
case, we want to run the same one that's currently running.

This is especially important for things like the GIT_SSH=git-annex used for
ssh connection caching.

The only code that still uses readProgramFile directly is the upgrade code,
which needs to know where the standalone git-annex was installed, in order to
upgrade it.
This commit is contained in:
Joey Hess 2015-02-28 17:23:13 -04:00
parent b9275b65f9
commit 450ee53ab6
14 changed files with 28 additions and 25 deletions

View file

@ -15,7 +15,7 @@ import Assistant.Common
import Assistant.DaemonStatus
import Utility.NotificationBroadcaster
import Annex.UUID
import Config.Files
import Annex.Path
import Logs.Schedule
import Utility.Scheduled
import Types.ScheduledActivity
@ -181,7 +181,7 @@ runActivity urlrenderer activity nowt = do
runActivity' :: UrlRenderer -> ScheduledActivity -> Assistant ()
runActivity' urlrenderer (ScheduledSelfFsck _ d) = do
program <- liftIO $ readProgramFile
program <- liftIO programPath
g <- liftAnnex gitRepo
fsckresults <- showFscking urlrenderer Nothing $ tryNonAsync $ do
void $ batchCommand program (Param "fsck" : annexFsckParams d)
@ -196,7 +196,7 @@ runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (r
dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]
dispatch (Just rmt) = void $ case Remote.remoteFsck rmt of
Nothing -> go rmt $ do
program <- readProgramFile
program <- programPath
void $ batchCommand program $
[ Param "fsck"
-- avoid downloading files

View file

@ -9,7 +9,7 @@ module Assistant.Threads.RemoteControl where
import Assistant.Common
import RemoteDaemon.Types
import Config.Files
import Annex.Path
import Utility.Batch
import Utility.SimpleProtocol
import Assistant.Alert
@ -28,7 +28,7 @@ import qualified Data.Set as S
remoteControlThread :: NamedThread
remoteControlThread = namedThread "RemoteControl" $ do
program <- liftIO readProgramFile
program <- liftIO programPath
(cmd, params) <- liftIO $ toBatchCommand
(program, [Param "remotedaemon"])
let p = proc cmd (toCommand params)

View file

@ -39,7 +39,7 @@ import Git.Index
import Assistant.Unused
import Logs.Unused
import Logs.Transfer
import Config.Files
import Annex.Path
import Types.Key (keyBackendName)
import qualified Annex
#ifdef WITH_WEBAPP
@ -182,7 +182,7 @@ dailyCheck urlrenderer = do
{- Run git-annex unused once per day. This is run as a separate
- process to stay out of the annex monad and so it can run as a
- batch job. -}
program <- liftIO readProgramFile
program <- liftIO programPath
let (program', params') = batchmaker (program, [Param "unused"])
void $ liftIO $ boolSystem program' params'
{- Invalidate unused keys cache, and queue transfers of all unused

View file

@ -11,13 +11,13 @@ import Assistant.Common
import Assistant.TransferQueue
import Assistant.TransferSlots
import Logs.Transfer
import Config.Files
import Annex.Path
import Utility.Batch
{- Dispatches transfers from the queue. -}
transfererThread :: NamedThread
transfererThread = namedThread "Transferrer" $ do
program <- liftIO readProgramFile
program <- liftIO programPath
batchmaker <- liftIO getBatchCommandMaker
forever $ inTransferSlot program batchmaker $
maybe (return Nothing) (uncurry genTransfer)