2012-08-22 18:32:17 +00:00
|
|
|
{- git-annex assistant repo syncing
|
|
|
|
-
|
2015-01-21 16:50:09 +00:00
|
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
2012-08-22 18:32:17 +00:00
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2012-08-22 18:32:17 +00:00
|
|
|
-}
|
|
|
|
|
2019-12-05 19:10:23 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2012-08-22 18:32:17 +00:00
|
|
|
module Assistant.Sync where
|
|
|
|
|
|
|
|
import Assistant.Common
|
|
|
|
import Assistant.Pushes
|
|
|
|
import Assistant.Alert
|
2013-04-04 05:48:26 +00:00
|
|
|
import Assistant.Alert.Utility
|
2012-08-22 18:32:17 +00:00
|
|
|
import Assistant.DaemonStatus
|
|
|
|
import Assistant.ScanRemotes
|
2014-04-08 19:23:50 +00:00
|
|
|
import Assistant.RemoteControl
|
2012-08-22 18:32:17 +00:00
|
|
|
import qualified Command.Sync
|
|
|
|
import qualified Git
|
|
|
|
import qualified Git.Command
|
|
|
|
import qualified Remote
|
2012-09-04 19:54:30 +00:00
|
|
|
import qualified Types.Remote as Remote
|
2021-07-19 15:28:31 +00:00
|
|
|
import qualified Annex
|
2012-08-22 18:32:17 +00:00
|
|
|
import qualified Annex.Branch
|
2020-05-27 15:54:39 +00:00
|
|
|
import Remote.List.Util
|
2012-09-16 23:48:12 +00:00
|
|
|
import Annex.UUID
|
assistant: Get back in sync with XMPP remotes after network reconnection, and on startup.
Make manualPull send push requests over XMPP.
When reconnecting with remotes, those that are XMPP remotes cannot
immediately be pulled from and scanned, so instead maintain a set of
(probably) desynced remotes, and put XMPP remotes on it. (This set could be
used in other ways later, if we can detect we're out of sync with other
types of remotes.)
The merger handles detecting when a XMPP push is received from a desynced
remote, and triggers a scan then, if they have in fact diverged.
This has one known bug: A single XMPP remote can have multiple clients
behind it. When this happens, only the UUID of one client is recorded
as the UUID of the XMPP remote. Pushes from the other XMPP clients will not
trigger a scan. If the client whose UUID is expected responds to the push
request, it'll work, but when that client is offline, we're SOL.
2013-03-06 19:09:31 +00:00
|
|
|
import Annex.TaggedPush
|
2015-11-10 20:52:30 +00:00
|
|
|
import Annex.Ssh
|
2018-10-19 19:17:48 +00:00
|
|
|
import Annex.CurrentBranch
|
2013-10-26 20:54:49 +00:00
|
|
|
import qualified Config
|
|
|
|
import Git.Config
|
2017-08-17 16:26:14 +00:00
|
|
|
import Config.DynamicConfig
|
2013-10-26 20:54:49 +00:00
|
|
|
import Assistant.NamedThread
|
|
|
|
import Assistant.Threads.Watcher (watchThread, WatcherControl(..))
|
|
|
|
import Assistant.TransferSlots
|
|
|
|
import Assistant.TransferQueue
|
2013-10-29 17:41:44 +00:00
|
|
|
import Assistant.RepoProblem
|
2017-09-20 18:37:20 +00:00
|
|
|
import Assistant.Commits
|
2016-08-03 16:37:12 +00:00
|
|
|
import Types.Transfer
|
2017-09-20 20:34:29 +00:00
|
|
|
import Database.Export
|
2012-08-22 18:32:17 +00:00
|
|
|
|
|
|
|
import Data.Time.Clock
|
|
|
|
import qualified Data.Map as M
|
2012-09-11 01:55:59 +00:00
|
|
|
import Control.Concurrent
|
2020-06-05 18:16:37 +00:00
|
|
|
import Control.Concurrent.Async
|
2012-08-22 18:32:17 +00:00
|
|
|
|
|
|
|
{- Syncs with remotes that may have been disconnected for a while.
|
|
|
|
-
|
2012-08-23 19:22:23 +00:00
|
|
|
- First gets git in sync, and then prepares any necessary file transfers.
|
|
|
|
-
|
scan multiple remotes in one pass
The expensive transfer scan now scans a whole set of remotes in one pass.
So at startup, or when network comes up, it will run only once.
Note that this can result in transfers from/to higher cost remotes being
queued before other transfers of other content from/to lower cost remotes.
Before, low cost remotes were scanned first and all their transfers came
first. When multiple transfers are queued for a key, the lower cost ones
are still queued first. However, this could result in transfers from slow
remotes running for a long time while transfers of other data from faster
remotes waits.
I expect to make the transfer queue smarter about ordering
and/or make it allow multiple transfers at a time, which should eliminate
this annoyance. (Also, it was already possible to get into that situation,
for example if the network was up, lots of transfers from slow remotes
might be queued, and then a disk is mounted and its faster transfers have
to wait.)
Also note that this means I don't need to improve the code in
Assistant.Sync that currently checks if any of the reconnected remotes
have diverged, and if so, queues scans of all of them. That had been very
innefficient, but now doesn't matter.
2012-08-26 18:01:43 +00:00
|
|
|
- An expensive full scan is queued when the git-annex branches of some of
|
|
|
|
- the remotes have diverged from the local git-annex branch. Otherwise,
|
2012-08-23 19:22:23 +00:00
|
|
|
- it's sufficient to requeue failed transfers.
|
assistant: Get back in sync with XMPP remotes after network reconnection, and on startup.
Make manualPull send push requests over XMPP.
When reconnecting with remotes, those that are XMPP remotes cannot
immediately be pulled from and scanned, so instead maintain a set of
(probably) desynced remotes, and put XMPP remotes on it. (This set could be
used in other ways later, if we can detect we're out of sync with other
types of remotes.)
The merger handles detecting when a XMPP push is received from a desynced
remote, and triggers a scan then, if they have in fact diverged.
This has one known bug: A single XMPP remote can have multiple clients
behind it. When this happens, only the UUID of one client is recorded
as the UUID of the XMPP remote. Pushes from the other XMPP clients will not
trigger a scan. If the client whose UUID is expected responds to the push
request, it'll work, but when that client is offline, we're SOL.
2013-03-06 19:09:31 +00:00
|
|
|
-
|
2013-10-13 21:14:56 +00:00
|
|
|
- Also handles signaling any connectRemoteNotifiers, after the syncing is
|
2017-09-20 18:37:20 +00:00
|
|
|
- done, and records an export commit to make any exports be updated.
|
2012-08-22 18:32:17 +00:00
|
|
|
-}
|
2016-11-14 18:26:20 +00:00
|
|
|
reconnectRemotes :: [Remote] -> Assistant ()
|
2017-09-20 18:37:20 +00:00
|
|
|
reconnectRemotes [] = recordExportCommit
|
2016-11-14 18:26:20 +00:00
|
|
|
reconnectRemotes rs = void $ do
|
2013-10-27 20:42:13 +00:00
|
|
|
rs' <- liftIO $ filterM (Remote.checkAvailable True) rs
|
2013-10-14 19:36:47 +00:00
|
|
|
unless (null rs') $ do
|
|
|
|
failedrs <- syncAction rs' (const go)
|
2013-10-27 20:42:13 +00:00
|
|
|
forM_ failedrs $ \r ->
|
|
|
|
whenM (liftIO $ Remote.checkAvailable False r) $
|
2013-10-29 18:22:56 +00:00
|
|
|
repoHasProblem (Remote.uuid r) (syncRemote r)
|
2013-10-14 19:36:47 +00:00
|
|
|
mapM_ signal $ filter (`notElem` failedrs) rs'
|
2017-09-20 18:37:20 +00:00
|
|
|
recordExportCommit
|
2012-10-30 23:33:27 +00:00
|
|
|
where
|
2018-06-04 18:31:55 +00:00
|
|
|
gitremotes = liftAnnex $
|
|
|
|
filterM (notspecialremote <$$> Remote.getRepo) rs
|
2012-10-30 23:33:27 +00:00
|
|
|
notspecialremote r
|
|
|
|
| Git.repoIsUrl r = True
|
|
|
|
| Git.repoIsLocal r = True
|
2013-03-18 20:19:42 +00:00
|
|
|
| Git.repoIsLocalUnknown r = True
|
2012-10-30 23:33:27 +00:00
|
|
|
| otherwise = False
|
2016-02-29 19:23:08 +00:00
|
|
|
sync currentbranch@(Just _, _) = do
|
2018-06-04 18:31:55 +00:00
|
|
|
(failedpull, diverged) <- manualPull currentbranch =<< gitremotes
|
2012-10-30 23:33:27 +00:00
|
|
|
now <- liftIO getCurrentTime
|
2018-06-04 18:31:55 +00:00
|
|
|
failedpush <- pushToRemotes' now =<< gitremotes
|
2013-03-18 20:19:42 +00:00
|
|
|
return (nub $ failedpull ++ failedpush, diverged)
|
2012-10-30 23:33:27 +00:00
|
|
|
{- No local branch exists yet, but we can try pulling. -}
|
2018-06-04 18:31:55 +00:00
|
|
|
sync (Nothing, _) = manualPull (Nothing, Nothing) =<< gitremotes
|
2013-03-06 20:29:19 +00:00
|
|
|
go = do
|
2018-10-19 19:17:48 +00:00
|
|
|
(failed, diverged) <- sync =<< liftAnnex getCurrentBranch
|
2017-08-17 16:26:14 +00:00
|
|
|
addScanRemotes diverged =<<
|
2018-06-04 18:31:55 +00:00
|
|
|
filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) rs
|
2013-03-18 20:19:42 +00:00
|
|
|
return failed
|
2013-10-13 21:14:56 +00:00
|
|
|
signal r = liftIO . mapM_ (flip tryPutMVar ())
|
|
|
|
=<< fromMaybe [] . M.lookup (Remote.uuid r) . connectRemoteNotifiers
|
|
|
|
<$> getDaemonStatus
|
2012-08-22 18:32:17 +00:00
|
|
|
|
2014-06-16 15:32:13 +00:00
|
|
|
{- Pushes the local sync branch to all remotes, in
|
2012-09-16 23:48:12 +00:00
|
|
|
- parallel, along with the git-annex branch. This is the same
|
|
|
|
- as "git annex sync", except in parallel, and will co-exist with use of
|
|
|
|
- "git annex sync".
|
2012-08-22 18:32:17 +00:00
|
|
|
-
|
|
|
|
- Avoids running possibly long-duration commands in the Annex monad, so
|
2012-09-16 23:48:12 +00:00
|
|
|
- as not to block other threads.
|
|
|
|
-
|
|
|
|
- This can fail, when the remote's sync branch (or git-annex branch) has
|
|
|
|
- been updated by some other remote pushing into it, or by the remote
|
|
|
|
- itself. To handle failure, a manual pull and merge is done, and the push
|
|
|
|
- is retried.
|
|
|
|
-
|
|
|
|
- When there's a lot of activity, we may fail more than once.
|
|
|
|
- On the other hand, we may fail because the remote is not available.
|
|
|
|
- Rather than retrying indefinitely, after the first retry we enter a
|
|
|
|
- fallback mode, where our push is guarenteed to succeed if the remote is
|
|
|
|
- reachable. If the fallback fails, the push is queued to be retried
|
|
|
|
- later.
|
2013-03-18 20:19:42 +00:00
|
|
|
-
|
|
|
|
- Returns any remotes that it failed to push to.
|
2012-09-16 23:48:12 +00:00
|
|
|
-}
|
2016-11-14 18:26:20 +00:00
|
|
|
pushToRemotes :: [Remote] -> Assistant [Remote]
|
|
|
|
pushToRemotes remotes = do
|
2013-03-18 20:19:42 +00:00
|
|
|
now <- liftIO getCurrentTime
|
Added remote.<name>.annex-push and remote.<name>.annex-pull
The former can be useful to make remotes that don't get fully synced with
local changes, which comes up in a lot of situations.
The latter was mostly added for symmetry, but could be useful (though less
likely to be).
Implementing `remote.<name>.annex-pull` was a bit tricky, as there's no one
place where git-annex pulls/fetches from remotes. I audited all
instances of "fetch" and "pull". A few cases were left not checking this
config:
* Git.Repair can try to pull missing refs from a remote, and if the local
repo is corrupted, that seems a reasonable thing to do even though
the config would normally prevent it.
* Assistant.WebApp.Gpg and Remote.Gcrypt and Remote.Git do fetches
as part of the setup process of a remote. The config would probably not
be set then, and having the setup fail seems worse than honoring it if it
is already set.
I have not prevented all the code that does a "merge" from merging branches
from remotes with remote.<name>.annex-pull=false. That could perhaps
be done, but it would need a way to map from branch name to remote name,
and the way refspecs work makes that hard to get really correct. So if the
user fetches manually, the git-annex branch will get merged, for example.
Anther way of looking at/justifying this is that the setting is called
"annex-pull", not "annex-merge".
This commit was supported by the NSF-funded DataLad project.
2017-04-05 17:04:02 +00:00
|
|
|
let remotes' = filter (wantpush . Remote.gitconfig) remotes
|
2016-11-14 18:26:20 +00:00
|
|
|
syncAction remotes' (pushToRemotes' now)
|
Added remote.<name>.annex-push and remote.<name>.annex-pull
The former can be useful to make remotes that don't get fully synced with
local changes, which comes up in a lot of situations.
The latter was mostly added for symmetry, but could be useful (though less
likely to be).
Implementing `remote.<name>.annex-pull` was a bit tricky, as there's no one
place where git-annex pulls/fetches from remotes. I audited all
instances of "fetch" and "pull". A few cases were left not checking this
config:
* Git.Repair can try to pull missing refs from a remote, and if the local
repo is corrupted, that seems a reasonable thing to do even though
the config would normally prevent it.
* Assistant.WebApp.Gpg and Remote.Gcrypt and Remote.Git do fetches
as part of the setup process of a remote. The config would probably not
be set then, and having the setup fail seems worse than honoring it if it
is already set.
I have not prevented all the code that does a "merge" from merging branches
from remotes with remote.<name>.annex-pull=false. That could perhaps
be done, but it would need a way to map from branch name to remote name,
and the way refspecs work makes that hard to get really correct. So if the
user fetches manually, the git-annex branch will get merged, for example.
Anther way of looking at/justifying this is that the setting is called
"annex-pull", not "annex-merge".
This commit was supported by the NSF-funded DataLad project.
2017-04-05 17:04:02 +00:00
|
|
|
where
|
|
|
|
wantpush gc
|
|
|
|
| remoteAnnexReadOnly gc = False
|
|
|
|
| not (remoteAnnexPush gc) = False
|
|
|
|
| otherwise = True
|
|
|
|
|
2016-11-14 18:26:20 +00:00
|
|
|
pushToRemotes' :: UTCTime -> [Remote] -> Assistant [Remote]
|
|
|
|
pushToRemotes' now remotes = do
|
2021-07-19 15:28:31 +00:00
|
|
|
(g, branch, u, ms) <- liftAnnex $ do
|
2018-08-02 18:06:06 +00:00
|
|
|
Annex.Branch.commit =<< Annex.Branch.commitMessage
|
2021-07-19 15:28:31 +00:00
|
|
|
(,,,)
|
2012-10-28 19:33:21 +00:00
|
|
|
<$> gitRepo
|
2018-10-19 19:17:48 +00:00
|
|
|
<*> getCurrentBranch
|
2012-10-28 19:33:21 +00:00
|
|
|
<*> getUUID
|
2021-07-19 15:28:31 +00:00
|
|
|
<*> Annex.getState Annex.output
|
|
|
|
ret <- go ms True branch g u remotes
|
2012-11-10 16:18:00 +00:00
|
|
|
return ret
|
2012-10-29 20:22:14 +00:00
|
|
|
where
|
2021-07-19 15:28:31 +00:00
|
|
|
go _ _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do
|
|
|
|
go _ _ _ _ _ [] = return [] -- no remotes, so nothing to do
|
|
|
|
go ms shouldretry currbranch@(Just branch, _) g u rs = do
|
2012-10-29 20:22:14 +00:00
|
|
|
debug ["pushing to", show rs]
|
2021-07-19 15:28:31 +00:00
|
|
|
(succeeded, failed) <- parallelPush g rs (push ms branch)
|
2012-10-29 20:22:14 +00:00
|
|
|
updatemap succeeded []
|
|
|
|
if null failed
|
2016-11-14 18:26:20 +00:00
|
|
|
then return []
|
2012-10-29 20:22:14 +00:00
|
|
|
else if shouldretry
|
2021-07-19 15:28:31 +00:00
|
|
|
then retry ms currbranch g u failed
|
2012-10-29 20:22:14 +00:00
|
|
|
else fallback branch g u failed
|
2012-08-22 18:32:17 +00:00
|
|
|
|
2017-09-20 18:37:20 +00:00
|
|
|
updatemap succeeded failed = do
|
|
|
|
v <- getAssistant failedPushMap
|
|
|
|
changeFailedPushMap v $ \m ->
|
|
|
|
M.union (makemap failed) $
|
|
|
|
M.difference m (makemap succeeded)
|
2012-10-29 20:22:14 +00:00
|
|
|
makemap l = M.fromList $ zip l (repeat now)
|
2012-08-22 18:32:17 +00:00
|
|
|
|
2021-07-19 15:28:31 +00:00
|
|
|
retry ms currbranch g u rs = do
|
2012-10-29 20:22:14 +00:00
|
|
|
debug ["trying manual pull to resolve failed pushes"]
|
2016-02-29 19:23:08 +00:00
|
|
|
void $ manualPull currbranch rs
|
2021-07-19 15:28:31 +00:00
|
|
|
go ms False currbranch g u rs
|
2012-09-16 23:48:12 +00:00
|
|
|
|
2012-10-29 20:22:14 +00:00
|
|
|
fallback branch g u rs = do
|
|
|
|
debug ["fallback pushing to", show rs]
|
2015-11-10 20:52:30 +00:00
|
|
|
(succeeded, failed) <- parallelPush g rs (taggedPush u Nothing branch)
|
2012-10-29 20:22:14 +00:00
|
|
|
updatemap succeeded failed
|
2013-03-18 20:19:42 +00:00
|
|
|
return failed
|
2012-10-29 20:22:14 +00:00
|
|
|
|
2021-07-19 15:28:31 +00:00
|
|
|
push ms branch remote = Command.Sync.pushBranch remote (Just branch) ms
|
2015-11-10 20:52:30 +00:00
|
|
|
|
|
|
|
parallelPush :: Git.Repo -> [Remote] -> (Remote -> Git.Repo -> IO Bool)-> Assistant ([Remote], [Remote])
|
|
|
|
parallelPush g rs a = do
|
|
|
|
rgs <- liftAnnex $ mapM topush rs
|
|
|
|
(succeededrgs, failedrgs) <- liftIO $ inParallel (uncurry a) rgs
|
|
|
|
return (map fst succeededrgs, map fst failedrgs)
|
|
|
|
where
|
|
|
|
topush r = (,)
|
|
|
|
<$> pure r
|
2018-06-04 18:31:55 +00:00
|
|
|
<*> (Remote.getRepo r >>= \repo ->
|
|
|
|
sshOptionsTo repo (Remote.gitconfig r) g)
|
2012-11-10 18:38:50 +00:00
|
|
|
|
2020-06-05 18:16:37 +00:00
|
|
|
inParallel :: (v -> IO Bool) -> [v] -> IO ([v], [v])
|
|
|
|
inParallel a l = (\(t,f) -> (map fst t, map fst f))
|
|
|
|
. partition snd
|
|
|
|
. zip l <$> mapConcurrently a l
|
|
|
|
|
2013-03-18 20:19:42 +00:00
|
|
|
{- Displays an alert while running an action that syncs with some remotes,
|
|
|
|
- and returns any remotes that it failed to sync with.
|
|
|
|
-
|
2013-03-28 18:51:39 +00:00
|
|
|
- Readonly remotes are also hidden (to hide the web special remote).
|
2013-03-18 20:19:42 +00:00
|
|
|
-}
|
|
|
|
syncAction :: [Remote] -> ([Remote] -> Assistant [Remote]) -> Assistant [Remote]
|
|
|
|
syncAction rs a
|
2013-03-28 18:51:39 +00:00
|
|
|
| null visibleremotes = a rs
|
2013-03-18 20:19:42 +00:00
|
|
|
| otherwise = do
|
2013-03-28 18:51:39 +00:00
|
|
|
i <- addAlert $ syncAlert visibleremotes
|
2013-03-18 20:19:42 +00:00
|
|
|
failed <- a rs
|
2018-06-04 18:31:55 +00:00
|
|
|
failed' <- filterM (not . Git.repoIsLocalUnknown <$$> liftAnnex . Remote.getRepo) failed
|
2013-03-28 18:51:39 +00:00
|
|
|
let succeeded = filter (`notElem` failed) visibleremotes
|
2013-03-27 18:25:49 +00:00
|
|
|
if null succeeded && null failed'
|
|
|
|
then removeAlert i
|
|
|
|
else updateAlertMap $ mergeAlert i $
|
|
|
|
syncResultAlert succeeded failed'
|
2013-03-18 20:19:42 +00:00
|
|
|
return failed
|
|
|
|
where
|
2018-06-04 18:31:55 +00:00
|
|
|
visibleremotes = filter (not . Remote.readonly) rs
|
2013-03-18 20:19:42 +00:00
|
|
|
|
|
|
|
{- Manually pull from remotes and merge their branches. Returns any
|
|
|
|
- remotes that it failed to pull from, and a Bool indicating
|
|
|
|
- whether the git-annex branches of the remotes and local had
|
|
|
|
- diverged before the pull.
|
assistant: Get back in sync with XMPP remotes after network reconnection, and on startup.
Make manualPull send push requests over XMPP.
When reconnecting with remotes, those that are XMPP remotes cannot
immediately be pulled from and scanned, so instead maintain a set of
(probably) desynced remotes, and put XMPP remotes on it. (This set could be
used in other ways later, if we can detect we're out of sync with other
types of remotes.)
The merger handles detecting when a XMPP push is received from a desynced
remote, and triggers a scan then, if they have in fact diverged.
This has one known bug: A single XMPP remote can have multiple clients
behind it. When this happens, only the UUID of one client is recorded
as the UUID of the XMPP remote. Pushes from the other XMPP clients will not
trigger a scan. If the client whose UUID is expected responds to the push
request, it'll work, but when that client is offline, we're SOL.
2013-03-06 19:09:31 +00:00
|
|
|
-}
|
2016-02-29 19:23:08 +00:00
|
|
|
manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool)
|
2012-10-29 20:28:45 +00:00
|
|
|
manualPull currentbranch remotes = do
|
|
|
|
g <- liftAnnex gitRepo
|
remove direct mode remnant of merging unrelated histories
sync, merge, post-receive: Avoid merging unrelated histories, which used to
be allowed only to support direct mode repositories.
(However, sync does still merge unrelated histories when importing trees
from special remotes, and the assistant still merges unrelated histories
always.)
See 556b2ded2ba8270846fa207255b4c2def6ef5d8a for why this was added
back in 2016, for direct mode.
This is a behavior change, which might break something that was relying
on sync merging unrelated histories, but git had a good reason to
prevent it, since it's easy to foot shoot with it, and git-annex should
follow suit.
Sponsored-by: Noam Kremen on Patreon
2021-07-19 15:40:48 +00:00
|
|
|
-- Allow merging unrelated histories.
|
|
|
|
mc <- liftAnnex $ Command.Sync.mergeConfig True
|
2018-06-04 18:31:55 +00:00
|
|
|
failed <- forM remotes $ \r -> if wantpull $ Remote.gitconfig r
|
Added remote.<name>.annex-push and remote.<name>.annex-pull
The former can be useful to make remotes that don't get fully synced with
local changes, which comes up in a lot of situations.
The latter was mostly added for symmetry, but could be useful (though less
likely to be).
Implementing `remote.<name>.annex-pull` was a bit tricky, as there's no one
place where git-annex pulls/fetches from remotes. I audited all
instances of "fetch" and "pull". A few cases were left not checking this
config:
* Git.Repair can try to pull missing refs from a remote, and if the local
repo is corrupted, that seems a reasonable thing to do even though
the config would normally prevent it.
* Assistant.WebApp.Gpg and Remote.Gcrypt and Remote.Git do fetches
as part of the setup process of a remote. The config would probably not
be set then, and having the setup fail seems worse than honoring it if it
is already set.
I have not prevented all the code that does a "merge" from merging branches
from remotes with remote.<name>.annex-pull=false. That could perhaps
be done, but it would need a way to map from branch name to remote name,
and the way refspecs work makes that hard to get really correct. So if the
user fetches manually, the git-annex branch will get merged, for example.
Anther way of looking at/justifying this is that the setting is called
"annex-pull", not "annex-merge".
This commit was supported by the NSF-funded DataLad project.
2017-04-05 17:04:02 +00:00
|
|
|
then do
|
2018-06-04 18:31:55 +00:00
|
|
|
g' <- liftAnnex $ do
|
|
|
|
repo <- Remote.getRepo r
|
|
|
|
sshOptionsTo repo (Remote.gitconfig r) g
|
Added remote.<name>.annex-push and remote.<name>.annex-pull
The former can be useful to make remotes that don't get fully synced with
local changes, which comes up in a lot of situations.
The latter was mostly added for symmetry, but could be useful (though less
likely to be).
Implementing `remote.<name>.annex-pull` was a bit tricky, as there's no one
place where git-annex pulls/fetches from remotes. I audited all
instances of "fetch" and "pull". A few cases were left not checking this
config:
* Git.Repair can try to pull missing refs from a remote, and if the local
repo is corrupted, that seems a reasonable thing to do even though
the config would normally prevent it.
* Assistant.WebApp.Gpg and Remote.Gcrypt and Remote.Git do fetches
as part of the setup process of a remote. The config would probably not
be set then, and having the setup fail seems worse than honoring it if it
is already set.
I have not prevented all the code that does a "merge" from merging branches
from remotes with remote.<name>.annex-pull=false. That could perhaps
be done, but it would need a way to map from branch name to remote name,
and the way refspecs work makes that hard to get really correct. So if the
user fetches manually, the git-annex branch will get merged, for example.
Anther way of looking at/justifying this is that the setting is called
"annex-pull", not "annex-merge".
This commit was supported by the NSF-funded DataLad project.
2017-04-05 17:04:02 +00:00
|
|
|
ifM (liftIO $ Git.Command.runBool [Param "fetch", Param $ Remote.name r] g')
|
|
|
|
( return Nothing
|
|
|
|
, return $ Just r
|
|
|
|
)
|
|
|
|
else return Nothing
|
2020-04-15 17:04:34 +00:00
|
|
|
haddiverged <- Annex.Branch.refsWereMerged
|
|
|
|
<$> liftAnnex Annex.Branch.forceUpdate
|
2018-06-04 18:31:55 +00:00
|
|
|
forM_ remotes $ \r ->
|
2017-06-01 16:46:36 +00:00
|
|
|
liftAnnex $ Command.Sync.mergeRemote r
|
2021-07-19 15:28:31 +00:00
|
|
|
currentbranch mc def
|
2017-09-20 20:34:29 +00:00
|
|
|
when haddiverged $
|
|
|
|
updateExportTreeFromLogAll
|
2013-03-18 20:19:42 +00:00
|
|
|
return (catMaybes failed, haddiverged)
|
Added remote.<name>.annex-push and remote.<name>.annex-pull
The former can be useful to make remotes that don't get fully synced with
local changes, which comes up in a lot of situations.
The latter was mostly added for symmetry, but could be useful (though less
likely to be).
Implementing `remote.<name>.annex-pull` was a bit tricky, as there's no one
place where git-annex pulls/fetches from remotes. I audited all
instances of "fetch" and "pull". A few cases were left not checking this
config:
* Git.Repair can try to pull missing refs from a remote, and if the local
repo is corrupted, that seems a reasonable thing to do even though
the config would normally prevent it.
* Assistant.WebApp.Gpg and Remote.Gcrypt and Remote.Git do fetches
as part of the setup process of a remote. The config would probably not
be set then, and having the setup fail seems worse than honoring it if it
is already set.
I have not prevented all the code that does a "merge" from merging branches
from remotes with remote.<name>.annex-pull=false. That could perhaps
be done, but it would need a way to map from branch name to remote name,
and the way refspecs work makes that hard to get really correct. So if the
user fetches manually, the git-annex branch will get merged, for example.
Anther way of looking at/justifying this is that the setting is called
"annex-pull", not "annex-merge".
This commit was supported by the NSF-funded DataLad project.
2017-04-05 17:04:02 +00:00
|
|
|
where
|
|
|
|
wantpull gc = remoteAnnexPull gc
|
2012-09-11 01:55:59 +00:00
|
|
|
|
2013-04-08 19:36:09 +00:00
|
|
|
{- Start syncing a remote, using a background thread. -}
|
|
|
|
syncRemote :: Remote -> Assistant ()
|
|
|
|
syncRemote remote = do
|
2012-10-30 19:39:15 +00:00
|
|
|
updateSyncRemotes
|
2012-10-30 23:12:05 +00:00
|
|
|
thread <- asIO $ do
|
2016-11-14 18:26:20 +00:00
|
|
|
reconnectRemotes [remote]
|
2012-12-06 21:15:45 +00:00
|
|
|
addScanRemotes True [remote]
|
2012-10-30 23:12:05 +00:00
|
|
|
void $ liftIO $ forkIO $ thread
|
2013-10-26 20:54:49 +00:00
|
|
|
|
|
|
|
{- Use Nothing to change autocommit setting; or a remote to change
|
|
|
|
- its sync setting. -}
|
|
|
|
changeSyncable :: Maybe Remote -> Bool -> Assistant ()
|
|
|
|
changeSyncable Nothing enable = do
|
|
|
|
liftAnnex $ Config.setConfig key (boolConfig enable)
|
|
|
|
liftIO . maybe noop (`throwTo` signal)
|
|
|
|
=<< namedThreadId watchThread
|
|
|
|
where
|
|
|
|
key = Config.annexConfig "autocommit"
|
|
|
|
signal
|
|
|
|
| enable = ResumeWatcher
|
|
|
|
| otherwise = PauseWatcher
|
|
|
|
changeSyncable (Just r) True = do
|
|
|
|
liftAnnex $ changeSyncFlag r True
|
|
|
|
syncRemote r
|
2014-04-08 19:23:50 +00:00
|
|
|
sendRemoteControl RELOAD
|
2013-10-26 20:54:49 +00:00
|
|
|
changeSyncable (Just r) False = do
|
|
|
|
liftAnnex $ changeSyncFlag r False
|
|
|
|
updateSyncRemotes
|
|
|
|
{- Stop all transfers to or from this remote.
|
|
|
|
- XXX Can't stop any ongoing scan, or git syncs. -}
|
|
|
|
void $ dequeueTransfers tofrom
|
|
|
|
mapM_ (cancelTransfer False) =<<
|
|
|
|
filter tofrom . M.keys . currentTransfers <$> getDaemonStatus
|
|
|
|
where
|
|
|
|
tofrom t = transferUUID t == Remote.uuid r
|
|
|
|
|
|
|
|
changeSyncFlag :: Remote -> Bool -> Annex ()
|
|
|
|
changeSyncFlag r enabled = do
|
2018-06-04 18:31:55 +00:00
|
|
|
repo <- Remote.getRepo r
|
2020-02-19 17:45:11 +00:00
|
|
|
let key = Config.remoteAnnexConfig repo "sync"
|
2013-10-26 20:54:49 +00:00
|
|
|
Config.setConfig key (boolConfig enabled)
|
2020-05-27 15:54:39 +00:00
|
|
|
remotesChanged
|
2017-09-20 20:34:29 +00:00
|
|
|
|
|
|
|
updateExportTreeFromLogAll :: Assistant ()
|
|
|
|
updateExportTreeFromLogAll = do
|
|
|
|
rs <- exportRemotes <$> getDaemonStatus
|
|
|
|
forM_ rs $ \r -> liftAnnex $
|
|
|
|
openDb (Remote.uuid r) >>= updateExportTreeFromLog
|