diff options
| -rw-r--r-- | Assistant/Threads/TransferScanner.hs | 38 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 20 |
2 files changed, 17 insertions, 41 deletions
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 5a55cf354..e5191956e 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -21,6 +21,8 @@ import qualified Git.LsFiles as LsFiles import Command import Annex.Content +import qualified Data.Set as S + thisThread :: ThreadName thisThread = "TransferScanner" @@ -30,16 +32,20 @@ thisThread = "TransferScanner" transferScannerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> TransferQueue -> IO () transferScannerThread st dstatus scanremotes transferqueue = do startupScan - runEvery (Seconds 2) $ do - (r, info) <- getScanRemote scanremotes - scanned <- runThreadState st $ inRepo $ - checkTransferScanned $ Remote.uuid r - if not scanned || fullScan info - then expensiveScan st dstatus transferqueue r - else failedTransferScan st dstatus transferqueue r + go S.empty where - {- All remotes are scanned in full on startup, for multiple - - reasons, including: + go scanned = do + threadDelaySeconds (Seconds 2) + (r, info) <- getScanRemote scanremotes + if fullScan info || not (S.member r scanned) + then do + expensiveScan st dstatus transferqueue r + go (S.insert r scanned) + else do + failedTransferScan st dstatus transferqueue r + go scanned + {- All available remotes are scanned in full on startup, + - for multiple reasons, including: - - * This may be the first run, and there may be remotes - already in place, that need to be synced. @@ -49,17 +55,9 @@ transferScannerThread st dstatus scanremotes transferqueue = do - * We may have run before, and had transfers queued, - and then the system (or us) crashed, and that info was - lost. - - - - But not all remotes may be available now. So all - - prior indications that remotes have been scanned - - are first removed. -} - startupScan = do - void $ tryIO $ - removeDirectoryRecursive - =<< runThreadState st (fromRepo transferScannedDir) - addScanRemotes scanremotes True - =<< knownRemotes <$> getDaemonStatus dstatus + startupScan = addScanRemotes scanremotes True + =<< knownRemotes <$> getDaemonStatus dstatus {- This is a cheap scan for failed transfers involving a remote. -} failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO () @@ -104,8 +102,6 @@ expensiveScan st dstatus transferqueue r = do g <- runThreadState st $ fromRepo id files <- LsFiles.inRepo [] g go files - runThreadState st $ inRepo $ - transferScanned $ Remote.uuid r return True liftIO $ debug thisThread ["finished scan of", show r] where diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index b412ccd3e..a10ffa7d7 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -230,23 +230,3 @@ failedTransferDir u direction r = gitAnnexTransferDir r </> "failed" </> showLcDirection direction </> fromUUID u - -{- The directory holding remote uuids that have been scanned for transfers. -} -transferScannedDir :: Git.Repo -> FilePath -transferScannedDir r = gitAnnexTransferDir r </> "scanned" - -{- The file indicating whether a remote uuid has been scanned. -} -transferScannedFile :: UUID -> Git.Repo -> FilePath -transferScannedFile u r = transferScannedDir r </> fromUUID u - -{- Checks if a given remote UUID has been scanned for transfers. -} -checkTransferScanned :: UUID -> Git.Repo -> IO Bool -checkTransferScanned u r = doesFileExist $ transferScannedFile u r - -{- Records that a scan has taken place. -} -transferScanned :: UUID -> Git.Repo -> IO () -transferScanned u r = do - createDirectoryIfMissing True (parentDir f) - writeFile f "" - where - f = transferScannedFile u r |