run full transfer scan on all remotes at startup

Or when a remote first becomes available after startup.
This commit is contained in:
Joey Hess 2012-08-24 13:46:10 -04:00
parent 9fafddc7eb
commit e58d19b533
3 changed files with 39 additions and 17 deletions

View file

@ -41,9 +41,9 @@ getScanRemote v = atomically $ do
return ret
{- Adds new remotes that need scanning to the map. -}
addScanRemotes :: ScanRemoteMap -> [Remote] -> Bool -> IO ()
addScanRemotes _ [] _ = noop
addScanRemotes v rs full = atomically $ do
addScanRemotes :: ScanRemoteMap -> Bool -> [Remote] -> IO ()
addScanRemotes _ _ [] = noop
addScanRemotes v full rs = atomically $ do
m <- fromMaybe M.empty <$> tryTakeTMVar v
putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m
where

View file

@ -40,13 +40,13 @@ reconnectRemotes threadname st dstatus scanremotes rs = void $
where
sync (Just branch) = do
diverged <- manualPull st (Just branch) rs
addScanRemotes scanremotes rs diverged
addScanRemotes scanremotes diverged rs
now <- getCurrentTime
pushToRemotes threadname now st Nothing rs
{- No local branch exists yet, but we can try pulling. -}
sync Nothing = do
diverged <- manualPull st Nothing rs
addScanRemotes scanremotes rs diverged
addScanRemotes scanremotes diverged rs
return True
{- Updates the local sync branch, then pushes it to all remotes, in

View file

@ -29,17 +29,36 @@ 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 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]
then expensiveScan st dstatus transferqueue r
else failedTransferScan st dstatus transferqueue r
where
{- All 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.
- * We may have run before, and scanned a remote, but
- only been in a subdirectory of the git remote, and so
- not synced it all.
- * 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
removeDirectoryRecursive
=<< runThreadState st (fromRepo transferScannedDir)
addScanRemotes scanremotes True
=<< knownRemotes <$> getDaemonStatus dstatus
{- This is a cheap scan for failed transfers involving a remote. -}
failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
@ -77,14 +96,17 @@ failedTransferScan st dstatus transferqueue r = do
{- This is a expensive scan through the full git work tree.
-
- The scan is blocked when the transfer queue gets too large. -}
expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO Bool
expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
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 ["starting scan of", show r]
void $ alertWhile dstatus (scanAlert 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
go [] = noop
go (f:fs) = do