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.
This commit is contained in:
Joey Hess 2020-12-15 11:36:25 -04:00
parent 00526a6739
commit 74c1e0660b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 65 additions and 45 deletions

View file

@ -384,7 +384,7 @@ autoEnableSpecialRemotes :: Annex ()
autoEnableSpecialRemotes = do autoEnableSpecialRemotes = do
rp <- fromRawFilePath <$> fromRepo Git.repoPath rp <- fromRawFilePath <$> fromRepo Git.repoPath
withNullHandle $ \nullh -> gitAnnexChildProcess "init" withNullHandle $ \nullh -> gitAnnexChildProcess "init"
[ "--autoenable" ] [ Param "--autoenable" ]
(\p -> p (\p -> p
{ std_out = UseHandle nullh { std_out = UseHandle nullh
, std_err = UseHandle nullh , std_err = UseHandle nullh

View file

@ -57,13 +57,21 @@ cannotFindProgram = do
-} -}
gitAnnexChildProcess gitAnnexChildProcess
:: String :: String
-> [String] -> [CommandParam]
-> (CreateProcess -> CreateProcess) -> (CreateProcess -> CreateProcess)
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> Annex a -> Annex a
gitAnnexChildProcess subcmd ps f a = do gitAnnexChildProcess subcmd ps f a = do
cmd <- liftIO programPath cmd <- liftIO programPath
-- Pass along git config values that were set on command line ps' <- gitAnnexChildProcessParams subcmd ps
-- to the child process. pidLockChildProcess cmd ps' f a
cps <- concatMap (\c -> ["-c", c]) <$> Annex.getGitConfigOverrides
pidLockChildProcess cmd (subcmd:cps++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)

View file

@ -38,12 +38,12 @@ import Config
-} -}
pidLockChildProcess pidLockChildProcess
:: FilePath :: FilePath
-> [String] -> [CommandParam]
-> (CreateProcess -> CreateProcess) -> (CreateProcess -> CreateProcess)
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> Annex a -> Annex a
pidLockChildProcess cmd ps f a = do pidLockChildProcess cmd ps f a = do
let p = f (proc cmd ps) let p = f (proc cmd (toCommand ps))
let gonopidlock = withCreateProcess p a let gonopidlock = withCreateProcess p a
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
pidLockFile >>= liftIO . \case pidLockFile >>= liftIO . \case

View file

@ -41,14 +41,22 @@ import System.Posix.Process (getProcessGroupIDOf)
type SignalActionsVar = TVar (M.Map SignalAction (Int -> IO ())) 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. -} {- Runs an action with a Transferrer from the pool. -}
withTransferrer :: (Transferrer -> Annex a) -> Annex a withTransferrer :: (Transferrer -> Annex a) -> Annex a
withTransferrer a = do withTransferrer a = do
program <- liftIO programPath rt <- mkRunTransferrer nonBatchCommandMaker
pool <- Annex.getState Annex.transferrerpool pool <- Annex.getState Annex.transferrerpool
let nocheck = pure (pure True) let nocheck = pure (pure True)
signalactonsvar <- Annex.getState Annex.signalactions signalactonsvar <- Annex.getState Annex.signalactions
withTransferrer' False signalactonsvar nocheck program nonBatchCommandMaker pool a withTransferrer' False signalactonsvar nocheck rt pool a
withTransferrer' withTransferrer'
:: (MonadIO m, MonadMask m) :: (MonadIO m, MonadMask m)
@ -59,19 +67,18 @@ withTransferrer'
-- processes are left in the pool for use later. -- processes are left in the pool for use later.
-> SignalActionsVar -> SignalActionsVar
-> MkCheckTransferrer -> MkCheckTransferrer
-> FilePath -> RunTransferrer
-> BatchCommandMaker
-> TransferrerPool -> TransferrerPool
-> (Transferrer -> m a) -> (Transferrer -> m a)
-> 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) (mi, leftinpool) <- liftIO $ atomically (popTransferrerPool pool)
(i@(TransferrerPoolItem _ check), t) <- liftIO $ case mi of (i@(TransferrerPoolItem _ check), t) <- liftIO $ case mi of
Nothing -> do Nothing -> do
t <- mkTransferrer signalactonsvar program batchmaker t <- mkTransferrer signalactonsvar rt
i <- mkTransferrerPoolItem mkcheck t i <- mkTransferrerPoolItem mkcheck t
return (i, 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 a t `finally` returntopool leftinpool check t i
where where
returntopool leftinpool check t i 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. {- Check if a Transferrer from the pool is still ok to be used.
- If not, stop it and start a new one. -} - If not, stop it and start a new one. -}
checkTransferrerPoolItem :: SignalActionsVar -> FilePath -> BatchCommandMaker -> TransferrerPoolItem -> IO (TransferrerPoolItem, Transferrer) checkTransferrerPoolItem :: SignalActionsVar -> RunTransferrer -> TransferrerPoolItem -> IO (TransferrerPoolItem, Transferrer)
checkTransferrerPoolItem signalactonsvar program batchmaker i = case i of checkTransferrerPoolItem signalactonsvar rt i = case i of
TransferrerPoolItem (Just t) check -> ifM check TransferrerPoolItem (Just t) check -> ifM check
( return (i, t) ( return (i, t)
, do , do
@ -98,7 +105,7 @@ checkTransferrerPoolItem signalactonsvar program batchmaker i = case i of
TransferrerPoolItem Nothing check -> new check TransferrerPoolItem Nothing check -> new check
where where
new check = do new check = do
t <- mkTransferrer signalactonsvar program batchmaker t <- mkTransferrer signalactonsvar rt
return (TransferrerPoolItem (Just t) check, t) return (TransferrerPoolItem (Just t) check, t)
data TransferRequestLevel = AnnexLevel | AssistantLevel 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 {- Starts a new git-annex transfer process, setting up handles
- that will be used to communicate with it. -} - that will be used to communicate with it. -}
mkTransferrer :: SignalActionsVar -> FilePath -> BatchCommandMaker -> IO Transferrer mkTransferrer :: SignalActionsVar -> RunTransferrer -> IO Transferrer
mkTransferrer signalactonsvar program batchmaker = do mkTransferrer signalactonsvar (RunTransferrer program params batchmaker) = do
{- It runs as a batch job. -} {- 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 {- It's put into its own group so that the whole group can be
- killed to stop a transfer. -} - killed to stop a transfer. -}
(Just writeh, Just readh, _, ph) <- createProcess (Just writeh, Just readh, _, ph) <- createProcess

View file

@ -11,15 +11,15 @@ import Assistant.Common
import Assistant.TransferQueue import Assistant.TransferQueue
import Assistant.TransferSlots import Assistant.TransferSlots
import Types.Transfer import Types.Transfer
import Annex.Path import Annex.TransferrerPool
import Utility.Batch import Utility.Batch
{- Dispatches transfers from the queue. -} {- Dispatches transfers from the queue. -}
transfererThread :: NamedThread transfererThread :: NamedThread
transfererThread = namedThread "Transferrer" $ do transfererThread = namedThread "Transferrer" $ do
program <- liftIO programPath rt <- liftAnnex . mkRunTransferrer
batchmaker <- liftIO getBatchCommandMaker =<< liftIO getBatchCommandMaker
forever $ inTransferSlot program batchmaker $ forever $ inTransferSlot rt $
maybe (return Nothing) (uncurry genTransfer) maybe (return Nothing) (uncurry genTransfer)
=<< getNextTransfer notrunning =<< getNextTransfer notrunning
where where

View file

@ -34,7 +34,6 @@ import qualified Remote
import qualified Types.Remote as Remote import qualified Types.Remote as Remote
import Annex.Content import Annex.Content
import Annex.Wanted import Annex.Wanted
import Annex.Path
import Utility.Batch import Utility.Batch
import Types.NumCopies import Types.NumCopies
@ -55,17 +54,17 @@ type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -
{- Waits until a transfer slot becomes available, then runs a {- Waits until a transfer slot becomes available, then runs a
- TransferGenerator, and then runs the transfer action in its own thread. - TransferGenerator, and then runs the transfer action in its own thread.
-} -}
inTransferSlot :: FilePath -> BatchCommandMaker -> TransferGenerator -> Assistant () inTransferSlot :: RunTransferrer -> TransferGenerator -> Assistant ()
inTransferSlot program batchmaker gen = do inTransferSlot rt gen = do
flip MSemN.wait 1 <<~ transferSlots flip MSemN.wait 1 <<~ transferSlots
runTransferThread program batchmaker =<< gen runTransferThread rt =<< gen
{- Runs a TransferGenerator, and its transfer action, {- Runs a TransferGenerator, and its transfer action,
- without waiting for a slot to become available. -} - without waiting for a slot to become available. -}
inImmediateTransferSlot :: FilePath -> BatchCommandMaker -> TransferGenerator -> Assistant () inImmediateTransferSlot :: RunTransferrer -> TransferGenerator -> Assistant ()
inImmediateTransferSlot program batchmaker gen = do inImmediateTransferSlot rt gen = do
flip MSemN.signal (-1) <<~ transferSlots flip MSemN.signal (-1) <<~ transferSlots
runTransferThread program batchmaker =<< gen runTransferThread rt =<< gen
{- Runs a transfer action, in an already allocated transfer slot. {- Runs a transfer action, in an already allocated transfer slot.
- Once it finishes, frees the 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 pausing the thread until a ResumeTransfer exception is raised,
- then rerunning the action. - then rerunning the action.
-} -}
runTransferThread :: FilePath -> BatchCommandMaker -> Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()) -> Assistant () runTransferThread :: RunTransferrer -> Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()) -> Assistant ()
runTransferThread _ _ Nothing = flip MSemN.signal 1 <<~ transferSlots runTransferThread _ Nothing = flip MSemN.signal 1 <<~ transferSlots
runTransferThread program batchmaker (Just (t, info, a)) = do runTransferThread rt (Just (t, info, a)) = do
d <- getAssistant id d <- getAssistant id
mkcheck <- checkNetworkConnections mkcheck <- checkNetworkConnections
<$> getAssistant daemonStatusHandle <$> getAssistant daemonStatusHandle
aio <- asIO1 a 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 } updateTransferInfo t $ info { transferTid = Just tid }
runTransferThread' :: MkCheckTransferrer -> FilePath -> BatchCommandMaker -> AssistantData -> (Transferrer -> IO ()) -> IO () runTransferThread' :: MkCheckTransferrer -> RunTransferrer -> AssistantData -> (Transferrer -> IO ()) -> IO ()
runTransferThread' mkcheck program batchmaker d run = go runTransferThread' mkcheck rt d run = go
where where
go = catchPauseResume $ do go = catchPauseResume $ do
p <- runAssistant d $ liftAnnex $ p <- runAssistant d $ liftAnnex $
Annex.getState Annex.transferrerpool Annex.getState Annex.transferrerpool
signalactonsvar <- runAssistant d $ liftAnnex $ signalactonsvar <- runAssistant d $ liftAnnex $
Annex.getState Annex.signalactions Annex.getState Annex.signalactions
withTransferrer' True signalactonsvar mkcheck program batchmaker p run withTransferrer' True signalactonsvar mkcheck rt p run
pause = catchPauseResume $ pause = catchPauseResume $
runEvery (Seconds 86400) noop runEvery (Seconds 86400) noop
{- Note: This must use E.try, rather than E.catch. {- Note: This must use E.try, rather than E.catch.
@ -303,9 +302,9 @@ startTransfer t = do
alterTransferInfo t $ \i -> i { transferPaused = False } alterTransferInfo t $ \i -> i { transferPaused = False }
liftIO $ throwTo tid ResumeTransfer liftIO $ throwTo tid ResumeTransfer
start info = do start info = do
program <- liftIO programPath rt <- liftAnnex . mkRunTransferrer
batchmaker <- liftIO getBatchCommandMaker =<< liftIO getBatchCommandMaker
inImmediateTransferSlot program batchmaker $ inImmediateTransferSlot rt $
genTransfer t info genTransfer t info
getCurrentTransfers :: Assistant TransferMap getCurrentTransfers :: Assistant TransferMap

View file

@ -104,8 +104,8 @@ upgrade automatic destversion = do
upgraderemote = do upgraderemote = do
rp <- fromRawFilePath <$> fromRepo Git.repoPath rp <- fromRawFilePath <$> fromRepo Git.repoPath
gitAnnexChildProcess "upgrade" gitAnnexChildProcess "upgrade"
[ "--quiet" [ Param "--quiet"
, "--autoonly" , Param "--autoonly"
] ]
(\p -> p { cwd = Just rp }) (\p -> p { cwd = Just rp })
(\_ _ _ pid -> waitForProcess pid >>= return . \case (\_ _ _ pid -> waitForProcess pid >>= return . \case

View file

@ -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. 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, There are a lot of config settings that impact transfers,
and some of them might be commonly used at the command line, so something and some of them might be commonly used at the command line, so something
needs to be done about this. --[[Joey]] needs to be done about this. --[[Joey]]
> [[done]]