diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-24 15:52:23 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-24 15:52:23 -0400 |
commit | ab5e409a95f6a3aa6b9be55f4c1465008af91dd5 (patch) | |
tree | 14026185224e0c20d5ed936106fe2eae6208127c | |
parent | 0b1015370b402d859968944224758b317af16787 (diff) |
keep track of which remotes have been scanned in process state
Since it turned out to make sense to always scan all remotes on startup,
there's no need to persist the info about which have been scanned.
-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 |