summaryrefslogtreecommitdiff
path: root/Assistant/Threads/TransferScanner.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/Threads/TransferScanner.hs')
-rw-r--r--Assistant/Threads/TransferScanner.hs44
1 files changed, 32 insertions, 12 deletions
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 6bef2a6f1..b3222edb4 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -30,24 +30,45 @@ thisThread = "TransferScanner"
transferScannerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> TransferQueue -> IO ()
transferScannerThread st dstatus scanremotes transferqueue = do
runEvery (Seconds 2) $ do
- r <- getScanRemote scanremotes
- liftIO $ debug thisThread ["starting scan of", show r]
- void $ alertWhile dstatus (scanAlert r) $
- scan st dstatus transferqueue r
- liftIO $ debug thisThread ["finished scan of", show r]
+ (r, info) <- getScanRemote scanremotes
+ scanned <- runThreadState st $ inRepo $
+ checkTransferScanned $ Remote.uuid r
+ if not scanned || fullScan info
+ then do
+ liftIO $ debug thisThread ["starting scan of", show r]
+ void $ alertWhile dstatus (scanAlert r) $
+ expensiveScan st dstatus transferqueue r
+ liftIO $ debug thisThread ["finished scan of", show r]
+ runThreadState st $ inRepo $
+ transferScanned $ Remote.uuid r
+ else failedTransferScan st dstatus transferqueue r
-{- This is a naive scan through the git work tree.
+{- This is a cheap scan for failed transfers involving a remote. -}
+failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
+failedTransferScan st dstatus transferqueue r = do
+ ts <- runThreadState st $
+ getFailedTransfers $ Remote.uuid r
+ go ts
+ where
+ go [] = noop
+ go ((t, info):ts) = do
+ queueTransferWhenSmall
+ transferqueue dstatus (associatedFile info) t r
+ void $ runThreadState st $ inRepo $
+ liftIO . tryIO . removeFile . failedTransferFile t
+ go ts
+
+{- This is a expensive scan through the full git work tree.
-
- The scan is blocked when the transfer queue gets too large. -}
-scan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO Bool
-scan st dstatus transferqueue r = do
+expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO Bool
+expensiveScan st dstatus transferqueue r = do
g <- runThreadState st $ fromRepo id
files <- LsFiles.inRepo [] g
go files
- inRepo $ transferScanned $ uuid r
return True
where
- go [] = return ()
+ go [] = noop
go (f:fs) = do
v <- runThreadState st $ whenAnnexed check f
case v of
@@ -67,8 +88,7 @@ scan st dstatus transferqueue r = do
| otherwise = return Nothing
u = Remote.uuid r
- enqueue f t = queueTransferAt smallsize Later transferqueue dstatus (Just f) t r
- smallsize = 10
+ enqueue f t = queueTransferWhenSmall transferqueue dstatus (Just f) t r
{- Look directly in remote for the key when it's cheap;
- otherwise rely on the location log. -}