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.
This commit is contained in:
Joey Hess 2012-10-28 16:05:34 -04:00
parent 5406416234
commit 4ac2fd0a22
10 changed files with 41 additions and 28 deletions

View file

@ -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"