summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-24 15:52:23 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-24 15:52:23 -0400
commitab5e409a95f6a3aa6b9be55f4c1465008af91dd5 (patch)
tree14026185224e0c20d5ed936106fe2eae6208127c
parent0b1015370b402d859968944224758b317af16787 (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.hs38
-rw-r--r--Logs/Transfer.hs20
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