From d20933a25956a3a07247f66fe3a554761d616173 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 20 Sep 2017 13:27:59 -0400 Subject: first pass at assistant knowing about export remotes Split exportRemotes out from syncDataRemotes; the parts of the assistant that upload keys and drop keys from remotes don't apply to exports, because those operations are not supported. Some parts of the assistant and webapp do operate on both syncDataRemotes and exportRemotes. Particularly when downloading from either of them. Added a downloadRemotes that combines both. With this, the assistant should download from exports, but it won't yet upload changes to them. This commit was sponsored by Fernando Jimenez on Patreon. --- Assistant/DaemonStatus.hs | 10 +++++++--- Assistant/Threads/Glacier.hs | 2 +- Assistant/Threads/TransferScanner.hs | 33 +++++++++++++++++++-------------- Assistant/TransferQueue.hs | 13 ++++++------- Assistant/Types/DaemonStatus.hs | 6 ++++++ 5 files changed, 39 insertions(+), 25 deletions(-) (limited to 'Assistant') diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 58cb28c01..49823c3c0 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -20,6 +20,7 @@ import Logs.TimeStamp import qualified Remote import qualified Types.Remote as Remote import Config.DynamicConfig +import Annex.Export import Control.Concurrent.STM import System.Posix.Types @@ -53,15 +54,18 @@ calcSyncRemotes = do alive <- trustExclude DeadTrusted (map Remote.uuid rs) let good r = Remote.uuid r `elem` alive let syncable = filter good rs - syncdata <- filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) $ + contentremotes <- filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) $ filter (\r -> Remote.uuid r /= NoUUID) $ filter (not . Remote.isXMPPRemote) syncable + let (exportremotes, dataremotes) = partition (exportTree . Remote.config) contentremotes return $ \dstatus -> dstatus { syncRemotes = syncable , syncGitRemotes = filter Remote.gitSyncableRemote syncable - , syncDataRemotes = syncdata - , syncingToCloudRemote = any iscloud syncdata + , syncDataRemotes = dataremotes + , exportRemotes = exportremotes + , downloadRemotes = contentremotes + , syncingToCloudRemote = any iscloud contentremotes } where iscloud r = not (Remote.readonly r) && Remote.availability r == Remote.GloballyAvailable diff --git a/Assistant/Threads/Glacier.hs b/Assistant/Threads/Glacier.hs index b5eaa5ea9..2fd025df1 100644 --- a/Assistant/Threads/Glacier.hs +++ b/Assistant/Threads/Glacier.hs @@ -29,7 +29,7 @@ glacierThread = namedThread "Glacier" $ runEvery (Seconds 3600) <~> go where isglacier r = Remote.remotetype r == Glacier.remote go = do - rs <- filter isglacier . syncDataRemotes <$> getDaemonStatus + rs <- filter isglacier . downloadRemotes <$> getDaemonStatus forM_ rs $ \r -> check r =<< liftAnnex (getFailedTransfers $ Remote.uuid r) check _ [] = noop diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 4b6a90cd9..fd77b88d2 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -78,7 +78,7 @@ transferScannerThread urlrenderer = namedThread "TransferScanner" $ do -} startupScan = do reconnectRemotes =<< syncGitRemotes <$> getDaemonStatus - addScanRemotes True =<< syncDataRemotes <$> getDaemonStatus + addScanRemotes True =<< scannableRemotes {- This is a cheap scan for failed transfers involving a remote. -} failedTransferScan :: Remote -> Assistant () @@ -157,24 +157,29 @@ expensiveScan urlrenderer rs = batch <~> do (AssociatedFile (Just f)) t r findtransfers f unwanted key = do let af = AssociatedFile (Just f) - {- The syncable remotes may have changed since this - - scan began. -} - syncrs <- syncDataRemotes <$> getDaemonStatus locs <- liftAnnex $ loggedLocations key present <- liftAnnex $ inAnnex key + let slocs = S.fromList locs + + {- The remotes may have changed since this scan began. -} + syncrs <- syncDataRemotes <$> getDaemonStatus + let use l a = mapMaybe (a key slocs) . l <$> getDaemonStatus + liftAnnex $ handleDropsFrom locs syncrs "expensive scan found too many copies of object" present key af [] callCommandAction - liftAnnex $ do - let slocs = S.fromList locs - let use a = return $ mapMaybe (a key slocs) syncrs - ts <- if present - then filterM (wantSend True (Just key) af . Remote.uuid . fst) - =<< use (genTransfer Upload False) - else ifM (wantGet True (Just key) af) - ( use (genTransfer Download True) , return [] ) - let unwanted' = S.difference unwanted slocs - return (unwanted', ts) + ts <- if present + then liftAnnex . filterM (wantSend True (Just key) af . Remote.uuid . fst) + =<< use syncDataRemotes (genTransfer Upload False) + else ifM (liftAnnex $ wantGet True (Just key) af) + ( use downloadRemotes (genTransfer Download True) , return [] ) + let unwanted' = S.difference unwanted slocs + return (unwanted', ts) + +-- Both syncDataRemotes and exportRemotes can be scanned. +-- The downloadRemotes list contains both. +scannableRemotes :: Assistant [Remote] +scannableRemotes = downloadRemotes <$> getDaemonStatus genTransfer :: Direction -> Bool -> Key -> S.Set UUID -> Remote -> Maybe (Remote, Transfer) genTransfer direction want key slocs r diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 8117d309c..278bcbaa1 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -66,9 +66,7 @@ queueTransfersMatching matching reason schedule k f direction | otherwise = go where go = do - - rs <- liftAnnex . selectremotes - =<< syncDataRemotes <$> getDaemonStatus + rs <- liftAnnex . selectremotes =<< getDaemonStatus let matchingrs = filter (matching . Remote.uuid) rs if null matchingrs then do @@ -78,20 +76,21 @@ queueTransfersMatching matching reason schedule k f direction forM_ matchingrs $ \r -> enqueue reason schedule (gentransfer r) (stubInfo f r) return True - selectremotes rs + selectremotes st {- Queue downloads from all remotes that - have the key. The list of remotes is ordered with - cheapest first. More expensive ones will only be tried - if downloading from a cheap one fails. -} | direction == Download = do s <- locs - return $ filter (inset s) rs + return $ filter (inset s) (downloadRemotes st) {- Upload to all remotes that want the content and don't - already have it. -} | otherwise = do s <- locs filterM (wantSend True (Just k) f . Remote.uuid) $ - filter (\r -> not (inset s r || Remote.readonly r)) rs + filter (\r -> not (inset s r || Remote.readonly r)) + (syncDataRemotes st) where locs = S.fromList <$> Remote.keyLocations k inset s r = S.member (Remote.uuid r) s @@ -114,7 +113,7 @@ queueDeferredDownloads :: Reason -> Schedule -> Assistant () queueDeferredDownloads reason schedule = do q <- getAssistant transferQueue l <- liftIO $ atomically $ readTList (deferreddownloads q) - rs <- syncDataRemotes <$> getDaemonStatus + rs <- downloadRemotes <$> getDaemonStatus left <- filterM (queue rs) l unless (null left) $ liftIO $ atomically $ appendTList (deferreddownloads q) left diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs index 08e98d98e..1166cd18a 100644 --- a/Assistant/Types/DaemonStatus.hs +++ b/Assistant/Types/DaemonStatus.hs @@ -49,6 +49,10 @@ data DaemonStatus = DaemonStatus , syncGitRemotes :: [Remote] -- Ordered list of remotes to sync data with , syncDataRemotes :: [Remote] + -- Ordered list of remotes to export to + , exportRemotes :: [Remote] + -- Ordered list of remotes that data can be downloaded from + , downloadRemotes :: [Remote] -- Are we syncing to any cloud remotes? , syncingToCloudRemote :: Bool -- Set of uuids of remotes that are currently connected. @@ -97,6 +101,8 @@ newDaemonStatus = DaemonStatus <*> pure [] <*> pure [] <*> pure [] + <*> pure [] + <*> pure [] <*> pure False <*> pure S.empty <*> pure Nothing -- cgit v1.2.3