diff options
author | 2012-10-28 16:05:34 -0400 | |
---|---|---|
committer | 2012-10-28 16:05:34 -0400 | |
commit | c8cd4ec3082ac7dd24c0377d66c95cb05b51f0ba (patch) | |
tree | d970ff1097f6bf0b0aa5dd371495a2b0932e08e4 /Assistant/Threads/Transferrer.hs | |
parent | fce32440a51e51f53022b4025fa005e52525a100 (diff) |
ensure that git-annex branch is pushed after a successful transfer
I now have this topology working:
assistant ---> {bare repo, special remote} <--- assistant
And, I think, also this one:
+----------- bare repo --------+
v v
assistant ---> special remote <--- assistant
While before with assistant <---> assistant connections, both sides got
location info updated after a transfer, in this topology, the bare repo
*might* get its location info updated, but the other assistant has no way to
know that it did. And a special remote doesn't record location info,
so transfers to it won't propigate out location log changes at all.
So, for these to work, after a transfer succeeds, the git-annex branch
needs to be pushed. This is done by recording a synthetic commit has
occurred, which lets the pusher handle pushing out the change (which will
include actually committing any still journalled changes to the git-annex
branch).
Of course, this means rather a lot more syncing action than happened
before. At least the pusher bundles together very close together pushes,
somewhat. Currently it just waits 2 seconds between each push.
Diffstat (limited to 'Assistant/Threads/Transferrer.hs')
-rw-r--r-- | Assistant/Threads/Transferrer.hs | 25 |
1 files changed, 17 insertions, 8 deletions
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index fe06d5fa1..30d736073 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -13,6 +13,7 @@ import Assistant.DaemonStatus import Assistant.TransferQueue import Assistant.TransferSlots import Assistant.Alert +import Assistant.Commits import Logs.Transfer import Logs.Location import Annex.Content @@ -30,20 +31,20 @@ maxTransfers :: Int maxTransfers = 1 {- Dispatches transfers from the queue. -} -transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> NamedThread -transfererThread st dstatus transferqueue slots = thread $ go =<< readProgramFile +transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> CommitChan -> NamedThread +transfererThread st dstatus transferqueue slots commitchan = thread $ go =<< readProgramFile where thread = NamedThread thisThread go program = forever $ inTransferSlot dstatus slots $ - maybe (return Nothing) (uncurry $ startTransfer st dstatus program) + maybe (return Nothing) (uncurry $ startTransfer st dstatus commitchan program) =<< getNextTransfer transferqueue dstatus notrunning {- Skip transfers that are already running. -} notrunning = isNothing . startedTime {- By the time this is called, the daemonstatus's transfer map should - already have been updated to include the transfer. -} -startTransfer :: ThreadState -> DaemonStatusHandle -> FilePath -> Transfer -> TransferInfo -> TransferGenerator -startTransfer st dstatus program t info = case (transferRemote info, associatedFile info) of +startTransfer :: ThreadState -> DaemonStatusHandle -> CommitChan -> FilePath -> Transfer -> TransferInfo -> TransferGenerator +startTransfer st dstatus commitchan program t info = case (transferRemote info, associatedFile info) of (Just remote, Just file) -> ifM (runThreadState st $ shouldTransfer t info) ( do debug thisThread [ "Transferring:" , show t ] @@ -66,11 +67,19 @@ startTransfer st dstatus program t info = case (transferRemote info, associatedF {- Alerts are only shown for successful transfers. - Transfers can temporarily fail for many reasons, - so there's no point in bothering the user about - - those. The assistant should recover. -} - whenM ((==) ExitSuccess <$> waitForProcess pid) $ void $ - addAlert dstatus $ + - those. The assistant should recover. + - + - Also, after a successful transfer, the location + - log has changed. Indicate that a commit has been + - made, in order to queue a push of the git-annex + - branch out to remotes that did not participate + - in the transfer. + -} + whenM ((==) ExitSuccess <$> waitForProcess pid) $ do + void $ addAlert dstatus $ makeAlertFiller True $ transferFileAlert direction True file + recordCommit commitchan where params = [ Param "transferkey" |