diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-05 10:21:22 -0600 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-05 10:21:22 -0600 |
commit | 83c66ccaf88a10e8f4b16fc2162cbed2656b95e0 (patch) | |
tree | 6b1807e02096a81c96f788d3fd4305f89ea2018e /Assistant/Threads | |
parent | b0894f00c075e4dd93a692880e8eb0ea865b6c28 (diff) |
queue Uploads of newly added files to remotes
Added knownRemotes to DaemonStatus. This list is not entirely trivial to
calculate, and having it here should make it easier to add/remove remotes
on the fly later on. It did require plumbing the daemonstatus through to
some more threads.
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/Committer.hs | 28 | ||||
-rw-r--r-- | Assistant/Threads/Pusher.hs | 11 |
2 files changed, 23 insertions, 16 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 488056fa2..ff5cc9eab 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -12,6 +12,9 @@ import Assistant.Changes import Assistant.Commits import Assistant.ThreadedMonad import Assistant.Threads.Watcher +import Assistant.TransferQueue +import Assistant.DaemonStatus +import Logs.Transfer import qualified Annex import qualified Annex.Queue import qualified Git.Command @@ -29,8 +32,8 @@ import qualified Data.Set as S import Data.Either {- This thread makes git commits at appropriate times. -} -commitThread :: ThreadState -> ChangeChan -> CommitChan -> IO () -commitThread st changechan commitchan = runEvery (Seconds 1) $ do +commitThread :: ThreadState -> ChangeChan -> CommitChan -> TransferQueue -> DaemonStatusHandle -> IO () +commitThread st changechan commitchan transferqueue dstatus = runEvery (Seconds 1) $ do -- We already waited one second as a simple rate limiter. -- Next, wait until at least one change is available for -- processing. @@ -39,7 +42,7 @@ commitThread st changechan commitchan = runEvery (Seconds 1) $ do time <- getCurrentTime if shouldCommit time changes then do - readychanges <- handleAdds st changechan changes + readychanges <- handleAdds st changechan transferqueue dstatus changes if shouldCommit time readychanges then do void $ tryIO $ runThreadState st commitStaged @@ -97,8 +100,8 @@ shouldCommit now changes - Any pending adds that are not ready yet are put back into the ChangeChan, - where they will be retried later. -} -handleAdds :: ThreadState -> ChangeChan -> [Change] -> IO [Change] -handleAdds st changechan cs = returnWhen (null pendingadds) $ do +handleAdds :: ThreadState -> ChangeChan -> TransferQueue -> DaemonStatusHandle -> [Change] -> IO [Change] +handleAdds st changechan transferqueue dstatus cs = returnWhen (null pendingadds) $ do (postponed, toadd) <- partitionEithers <$> safeToAdd st pendingadds @@ -110,7 +113,7 @@ handleAdds st changechan cs = returnWhen (null pendingadds) $ do if (DirWatcher.eventsCoalesce || null added) then return $ added ++ otherchanges else do - r <- handleAdds st changechan + r <- handleAdds st changechan transferqueue dstatus =<< getChanges changechan return $ r ++ added ++ otherchanges where @@ -121,12 +124,12 @@ handleAdds st changechan cs = returnWhen (null pendingadds) $ do | otherwise = a add :: Change -> IO (Maybe Change) - add change@(PendingAddChange { keySource = ks }) = do - r <- catchMaybeIO $ sanitycheck ks $ runThreadState st $ do - showStart "add" $ keyFilename ks - handle (finishedChange change) (keyFilename ks) - =<< Command.Add.ingest ks - return $ maybeMaybe r + add change@(PendingAddChange { keySource = ks }) = + liftM maybeMaybe $ catchMaybeIO $ + sanitycheck ks $ runThreadState st $ do + showStart "add" $ keyFilename ks + key <- Command.Add.ingest ks + handle (finishedChange change) (keyFilename ks) key add _ = return Nothing maybeMaybe (Just j@(Just _)) = j @@ -141,6 +144,7 @@ handleAdds st changechan cs = returnWhen (null pendingadds) $ do sha <- inRepo $ Git.HashObject.hashObject BlobObject link stageSymlink file sha + queueTransfers transferqueue dstatus key (Just file) Upload showEndOk return $ Just change diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index 04d343528..6d6836120 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -10,6 +10,7 @@ module Assistant.Threads.Pusher where import Common.Annex import Assistant.Commits import Assistant.Pushes +import Assistant.DaemonStatus import Assistant.ThreadedMonad import Assistant.Threads.Merger import qualified Command.Sync @@ -32,9 +33,8 @@ pushRetryThread st pushmap = runEvery (Seconds halfhour) $ do halfhour = 1800 {- This thread pushes git commits out to remotes soon after they are made. -} -pushThread :: ThreadState -> CommitChan -> FailedPushMap -> IO () -pushThread st commitchan pushmap = do - remotes <- runThreadState st $ Command.Sync.syncRemotes [] +pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> IO () +pushThread st daemonstatus commitchan pushmap = do runEvery (Seconds 2) $ do -- We already waited two seconds as a simple rate limiter. -- Next, wait until at least one commit has been made @@ -42,7 +42,10 @@ pushThread st commitchan pushmap = do -- Now see if now's a good time to push. now <- getCurrentTime if shouldPush now commits - then pushToRemotes now st pushmap remotes + then do + remotes <- runThreadState st $ + knownRemotes <$> getDaemonStatus daemonstatus + pushToRemotes now st pushmap remotes else refillCommits commitchan commits {- Decide if now is a good time to push to remotes. |