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:
parent
00526a6739
commit
74c1e0660b
8 changed files with 65 additions and 45 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue