From c8cd4ec3082ac7dd24c0377d66c95cb05b51f0ba Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 28 Oct 2012 16:05:34 -0400
Subject: 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.
---
 Assistant/Threads/Transferrer.hs | 25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

(limited to 'Assistant/Threads/Transferrer.hs')

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"
-- 
cgit v1.2.3