From 74c1e0660b29a293d297d066f147539d548d4dfa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 15 Dec 2020 11:36:25 -0400 Subject: [PATCH] propagate git-annex -c on to transferrer child process 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. --- Annex/Init.hs | 2 +- Annex/Path.hs | 18 +++++++--- Annex/PidLock.hs | 4 +-- Annex/TransferrerPool.hs | 33 +++++++++++-------- Assistant/Threads/Transferrer.hs | 8 ++--- Assistant/TransferSlots.hs | 33 +++++++++---------- Upgrade.hs | 4 +-- ...nex_transferrer_does_not_propigate_-c.mdwn | 8 ++++- 8 files changed, 65 insertions(+), 45 deletions(-) diff --git a/Annex/Init.hs b/Annex/Init.hs index 18ff042464..331c82a9d2 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -384,7 +384,7 @@ autoEnableSpecialRemotes :: Annex () autoEnableSpecialRemotes = do rp <- fromRawFilePath <$> fromRepo Git.repoPath withNullHandle $ \nullh -> gitAnnexChildProcess "init" - [ "--autoenable" ] + [ Param "--autoenable" ] (\p -> p { std_out = UseHandle nullh , std_err = UseHandle nullh diff --git a/Annex/Path.hs b/Annex/Path.hs index f9bce267f8..db68f124f0 100644 --- a/Annex/Path.hs +++ b/Annex/Path.hs @@ -57,13 +57,21 @@ cannotFindProgram = do -} gitAnnexChildProcess :: String - -> [String] + -> [CommandParam] -> (CreateProcess -> CreateProcess) -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) -> Annex a gitAnnexChildProcess subcmd ps f a = do cmd <- liftIO programPath - -- Pass along git config values that were set on command line - -- to the child process. - cps <- concatMap (\c -> ["-c", c]) <$> Annex.getGitConfigOverrides - pidLockChildProcess cmd (subcmd:cps++ps) f a + 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) diff --git a/Annex/PidLock.hs b/Annex/PidLock.hs index a7267f8182..c1bb91c9eb 100644 --- a/Annex/PidLock.hs +++ b/Annex/PidLock.hs @@ -38,12 +38,12 @@ import Config -} pidLockChildProcess :: FilePath - -> [String] + -> [CommandParam] -> (CreateProcess -> CreateProcess) -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) -> Annex a pidLockChildProcess cmd ps f a = do - let p = f (proc cmd ps) + let p = f (proc cmd (toCommand ps)) let gonopidlock = withCreateProcess p a #ifndef mingw32_HOST_OS pidLockFile >>= liftIO . \case diff --git a/Annex/TransferrerPool.hs b/Annex/TransferrerPool.hs index 86e3c036d0..9f7880bd52 100644 --- a/Annex/TransferrerPool.hs +++ b/Annex/TransferrerPool.hs @@ -41,14 +41,22 @@ import System.Posix.Process (getProcessGroupIDOf) type SignalActionsVar = TVar (M.Map SignalAction (Int -> IO ())) +data RunTransferrer = RunTransferrer String [CommandParam] BatchCommandMaker + +mkRunTransferrer :: BatchCommandMaker -> Annex RunTransferrer +mkRunTransferrer batchmaker = RunTransferrer + <$> liftIO programPath + <*> gitAnnexChildProcessParams "transferrer" [] + <*> pure batchmaker + {- Runs an action with a Transferrer from the pool. -} withTransferrer :: (Transferrer -> Annex a) -> Annex a withTransferrer a = do - program <- liftIO programPath + rt <- mkRunTransferrer nonBatchCommandMaker pool <- Annex.getState Annex.transferrerpool let nocheck = pure (pure True) signalactonsvar <- Annex.getState Annex.signalactions - withTransferrer' False signalactonsvar nocheck program nonBatchCommandMaker pool a + withTransferrer' False signalactonsvar nocheck rt pool a withTransferrer' :: (MonadIO m, MonadMask m) @@ -59,19 +67,18 @@ withTransferrer' -- processes are left in the pool for use later. -> SignalActionsVar -> MkCheckTransferrer - -> FilePath - -> BatchCommandMaker + -> RunTransferrer -> TransferrerPool -> (Transferrer -> m a) -> m a -withTransferrer' minimizeprocesses signalactonsvar mkcheck program batchmaker pool a = do +withTransferrer' minimizeprocesses signalactonsvar mkcheck rt pool a = do (mi, leftinpool) <- liftIO $ atomically (popTransferrerPool pool) (i@(TransferrerPoolItem _ check), t) <- liftIO $ case mi of Nothing -> do - t <- mkTransferrer signalactonsvar program batchmaker + t <- mkTransferrer signalactonsvar rt i <- mkTransferrerPoolItem mkcheck t return (i, t) - Just i -> checkTransferrerPoolItem signalactonsvar program batchmaker i + Just i -> checkTransferrerPoolItem signalactonsvar rt i a t `finally` returntopool leftinpool check t i where returntopool leftinpool check t i @@ -87,8 +94,8 @@ withTransferrer' minimizeprocesses signalactonsvar mkcheck program batchmaker po {- Check if a Transferrer from the pool is still ok to be used. - If not, stop it and start a new one. -} -checkTransferrerPoolItem :: SignalActionsVar -> FilePath -> BatchCommandMaker -> TransferrerPoolItem -> IO (TransferrerPoolItem, Transferrer) -checkTransferrerPoolItem signalactonsvar program batchmaker i = case i of +checkTransferrerPoolItem :: SignalActionsVar -> RunTransferrer -> TransferrerPoolItem -> IO (TransferrerPoolItem, Transferrer) +checkTransferrerPoolItem signalactonsvar rt i = case i of TransferrerPoolItem (Just t) check -> ifM check ( return (i, t) , do @@ -98,7 +105,7 @@ checkTransferrerPoolItem signalactonsvar program batchmaker i = case i of TransferrerPoolItem Nothing check -> new check where new check = do - t <- mkTransferrer signalactonsvar program batchmaker + t <- mkTransferrer signalactonsvar rt return (TransferrerPoolItem (Just t) check, t) data TransferRequestLevel = AnnexLevel | AssistantLevel @@ -203,10 +210,10 @@ detectStalls (Just (StallDetection minsz duration)) metervar onstall = go Nothin {- Starts a new git-annex transfer process, setting up handles - that will be used to communicate with it. -} -mkTransferrer :: SignalActionsVar -> FilePath -> BatchCommandMaker -> IO Transferrer -mkTransferrer signalactonsvar program batchmaker = do +mkTransferrer :: SignalActionsVar -> RunTransferrer -> IO Transferrer +mkTransferrer signalactonsvar (RunTransferrer program params batchmaker) = do {- It runs as a batch job. -} - let (program', params') = batchmaker (program, [Param "transferrer"]) + let (program', params') = batchmaker (program, params) {- It's put into its own group so that the whole group can be - killed to stop a transfer. -} (Just writeh, Just readh, _, ph) <- createProcess diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index 1b2b14d7b8..923479e7a1 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -11,15 +11,15 @@ import Assistant.Common import Assistant.TransferQueue import Assistant.TransferSlots import Types.Transfer -import Annex.Path +import Annex.TransferrerPool import Utility.Batch {- Dispatches transfers from the queue. -} transfererThread :: NamedThread transfererThread = namedThread "Transferrer" $ do - program <- liftIO programPath - batchmaker <- liftIO getBatchCommandMaker - forever $ inTransferSlot program batchmaker $ + rt <- liftAnnex . mkRunTransferrer + =<< liftIO getBatchCommandMaker + forever $ inTransferSlot rt $ maybe (return Nothing) (uncurry genTransfer) =<< getNextTransfer notrunning where diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 6d51b1a0b1..4ff870b6c1 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -34,7 +34,6 @@ import qualified Remote import qualified Types.Remote as Remote import Annex.Content import Annex.Wanted -import Annex.Path import Utility.Batch import Types.NumCopies @@ -55,17 +54,17 @@ type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer - {- Waits until a transfer slot becomes available, then runs a - TransferGenerator, and then runs the transfer action in its own thread. -} -inTransferSlot :: FilePath -> BatchCommandMaker -> TransferGenerator -> Assistant () -inTransferSlot program batchmaker gen = do +inTransferSlot :: RunTransferrer -> TransferGenerator -> Assistant () +inTransferSlot rt gen = do flip MSemN.wait 1 <<~ transferSlots - runTransferThread program batchmaker =<< gen + runTransferThread rt =<< gen {- Runs a TransferGenerator, and its transfer action, - without waiting for a slot to become available. -} -inImmediateTransferSlot :: FilePath -> BatchCommandMaker -> TransferGenerator -> Assistant () -inImmediateTransferSlot program batchmaker gen = do +inImmediateTransferSlot :: RunTransferrer -> TransferGenerator -> Assistant () +inImmediateTransferSlot rt gen = do flip MSemN.signal (-1) <<~ transferSlots - runTransferThread program batchmaker =<< gen + runTransferThread rt =<< gen {- Runs a transfer action, in an already allocated transfer slot. - Once it finishes, frees the transfer slot. @@ -77,25 +76,25 @@ inImmediateTransferSlot program batchmaker gen = do - then pausing the thread until a ResumeTransfer exception is raised, - then rerunning the action. -} -runTransferThread :: FilePath -> BatchCommandMaker -> Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()) -> Assistant () -runTransferThread _ _ Nothing = flip MSemN.signal 1 <<~ transferSlots -runTransferThread program batchmaker (Just (t, info, a)) = do +runTransferThread :: RunTransferrer -> Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()) -> Assistant () +runTransferThread _ Nothing = flip MSemN.signal 1 <<~ transferSlots +runTransferThread rt (Just (t, info, a)) = do d <- getAssistant id mkcheck <- checkNetworkConnections <$> getAssistant daemonStatusHandle aio <- asIO1 a - tid <- liftIO $ forkIO $ runTransferThread' mkcheck program batchmaker d aio + tid <- liftIO $ forkIO $ runTransferThread' mkcheck rt d aio updateTransferInfo t $ info { transferTid = Just tid } -runTransferThread' :: MkCheckTransferrer -> FilePath -> BatchCommandMaker -> AssistantData -> (Transferrer -> IO ()) -> IO () -runTransferThread' mkcheck program batchmaker d run = go +runTransferThread' :: MkCheckTransferrer -> RunTransferrer -> AssistantData -> (Transferrer -> IO ()) -> IO () +runTransferThread' mkcheck rt d run = go where go = catchPauseResume $ do p <- runAssistant d $ liftAnnex $ Annex.getState Annex.transferrerpool signalactonsvar <- runAssistant d $ liftAnnex $ Annex.getState Annex.signalactions - withTransferrer' True signalactonsvar mkcheck program batchmaker p run + withTransferrer' True signalactonsvar mkcheck rt p run pause = catchPauseResume $ runEvery (Seconds 86400) noop {- Note: This must use E.try, rather than E.catch. @@ -303,9 +302,9 @@ startTransfer t = do alterTransferInfo t $ \i -> i { transferPaused = False } liftIO $ throwTo tid ResumeTransfer start info = do - program <- liftIO programPath - batchmaker <- liftIO getBatchCommandMaker - inImmediateTransferSlot program batchmaker $ + rt <- liftAnnex . mkRunTransferrer + =<< liftIO getBatchCommandMaker + inImmediateTransferSlot rt $ genTransfer t info getCurrentTransfers :: Assistant TransferMap diff --git a/Upgrade.hs b/Upgrade.hs index f497217ebf..387d11de6d 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -104,8 +104,8 @@ upgrade automatic destversion = do upgraderemote = do rp <- fromRawFilePath <$> fromRepo Git.repoPath gitAnnexChildProcess "upgrade" - [ "--quiet" - , "--autoonly" + [ Param "--quiet" + , Param "--autoonly" ] (\p -> p { cwd = Just rp }) (\_ _ _ pid -> waitForProcess pid >>= return . \case diff --git a/doc/todo/git-annex_transferrer_does_not_propigate_-c.mdwn b/doc/todo/git-annex_transferrer_does_not_propigate_-c.mdwn index bee7a36ee2..23e05c4041 100644 --- a/doc/todo/git-annex_transferrer_does_not_propigate_-c.mdwn +++ b/doc/todo/git-annex_transferrer_does_not_propigate_-c.mdwn @@ -1,6 +1,12 @@ -When `git -c foo.bar annex` runs git-annex transferrer, +When `git annex -c foo.bar` runs git-annex transferrer, it does not pass along the settings from -c. +(Note that, `git -c foo.bar annex` does propagate the -c. Git does it by +setting an environment variable, which causes git config to reflect the +override. The environment variable propagates to child processes.) + There are a lot of config settings that impact transfers, and some of them might be commonly used at the command line, so something needs to be done about this. --[[Joey]] + +> [[done]] -- 2.30.2