diff options
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 44 |
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. -} |