diff options
Diffstat (limited to 'Assistant/Threads')
| -rw-r--r-- | Assistant/Threads/Committer.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 12 |
2 files changed, 8 insertions, 6 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 2ddaade2f..e8d17b13f 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -464,7 +464,7 @@ checkChangeContent change@(Change { changeInfo = i }) = Nothing -> noop Just k -> whenM (scanComplete <$> getDaemonStatus) $ do present <- liftAnnex $ inAnnex k - if present + void $ if present then queueTransfers "new file created" Next k (Just f) Upload else queueTransfers "new or renamed file wanted" Next k (Just f) Download handleDrops "file renamed" present k (Just f) Nothing diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 8a513a43b..aa7d4ff19 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -17,6 +17,7 @@ import Assistant.Common import Assistant.DaemonStatus import Assistant.Alert import Assistant.Repair +import Assistant.Drop import Assistant.Ssh import Assistant.TransferQueue import Assistant.Types.UrlRenderer @@ -94,11 +95,11 @@ sanityCheckerHourlyThread = namedThread "SanityCheckerHourly" $ forever $ do {- This thread wakes up daily to make sure the tree is in good shape. -} sanityCheckerDailyThread :: UrlRenderer -> NamedThread sanityCheckerDailyThread urlrenderer = namedThread "SanityCheckerDaily" $ forever $ do - waitForNextCheck - debug ["starting sanity check"] void $ alertWhile sanityCheckAlert go debug ["sanity check complete"] + waitForNextCheck + where go = do modifyDaemonStatus_ $ \s -> s { sanityCheckRunning = True } @@ -172,11 +173,12 @@ dailyCheck urlrenderer = do let (program', params') = batchmaker (program, [Param "unused"]) void $ liftIO $ boolSystem program' params' {- Invalidate unused keys cache, and queue transfers of all unused - - keys. -} + - keys, or if no transfers are called for, drop them. -} unused <- liftAnnex unusedKeys' void $ liftAnnex $ setUnusedKeys unused - forM_ unused $ \k -> - queueTransfers "unused" Later k Nothing Upload + forM_ unused $ \k -> do + unlessM (queueTransfers "unused" Later k Nothing Upload) $ + handleDrops "unused" True k Nothing Nothing return True where |