2012-06-22 21:01:08 +00:00
|
|
|
{- git-annex assistant git merge thread
|
|
|
|
-
|
2022-03-31 17:02:16 +00:00
|
|
|
- Copyright 2012-2021 Joey Hess <id@joeyh.name>
|
2012-06-23 05:20:40 +00:00
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2012-06-22 21:01:08 +00:00
|
|
|
-}
|
|
|
|
|
2020-11-04 18:20:37 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2012-08-26 18:14:12 +00:00
|
|
|
module Assistant.Threads.Merger where
|
2012-06-22 21:01:08 +00:00
|
|
|
|
2012-07-20 23:29:59 +00:00
|
|
|
import Assistant.Common
|
2012-09-18 01:05:50 +00:00
|
|
|
import Assistant.TransferQueue
|
add ConfigMonitor thread
Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.
Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.
A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.
Also added a uuid.log cache. All other config files already had caches.
2012-10-20 20:37:06 +00:00
|
|
|
import Assistant.BranchChange
|
2017-09-20 20:34:29 +00:00
|
|
|
import Assistant.Sync
|
2012-06-22 21:01:08 +00:00
|
|
|
import Utility.DirWatcher
|
2013-03-11 02:24:13 +00:00
|
|
|
import Utility.DirWatcher.Types
|
2020-11-04 18:20:37 +00:00
|
|
|
import Utility.Directory.Create
|
2018-10-19 19:17:48 +00:00
|
|
|
import Annex.CurrentBranch
|
2022-03-31 17:02:16 +00:00
|
|
|
import Assistant.Commits
|
2019-11-11 22:20:35 +00:00
|
|
|
import qualified Annex
|
2012-09-16 22:53:13 +00:00
|
|
|
import qualified Annex.Branch
|
2012-06-22 21:01:08 +00:00
|
|
|
import qualified Git
|
|
|
|
import qualified Git.Branch
|
2017-06-07 20:16:22 +00:00
|
|
|
import qualified Git.Ref
|
2016-02-29 19:57:47 +00:00
|
|
|
import qualified Command.Sync
|
2012-06-22 21:01:08 +00:00
|
|
|
|
2020-11-04 18:20:37 +00:00
|
|
|
import qualified System.FilePath.ByteString as P
|
|
|
|
|
2012-09-18 01:05:50 +00:00
|
|
|
{- This thread watches for changes to .git/refs/, and handles incoming
|
|
|
|
- pushes. -}
|
2012-10-29 15:40:22 +00:00
|
|
|
mergeThread :: NamedThread
|
2013-01-26 06:09:33 +00:00
|
|
|
mergeThread = namedThread "Merger" $ do
|
2012-10-29 15:40:22 +00:00
|
|
|
g <- liftAnnex gitRepo
|
2020-11-04 18:20:37 +00:00
|
|
|
let gitd = Git.localGitDir g
|
|
|
|
let dir = gitd P.</> "refs"
|
2022-08-12 16:45:46 +00:00
|
|
|
liftIO $ createDirectoryUnder [gitd] dir
|
2012-10-29 15:40:22 +00:00
|
|
|
let hook a = Just <$> asIO2 (runHandler a)
|
2013-04-30 20:35:55 +00:00
|
|
|
changehook <- hook onChange
|
2012-10-29 15:40:22 +00:00
|
|
|
errhook <- hook onErr
|
2012-06-22 21:01:08 +00:00
|
|
|
let hooks = mkWatchHooks
|
2013-04-30 20:35:55 +00:00
|
|
|
{ addHook = changehook
|
|
|
|
, modifyHook = changehook
|
2012-10-29 15:40:22 +00:00
|
|
|
, errHook = errhook
|
2012-06-22 21:01:08 +00:00
|
|
|
}
|
2020-11-04 18:20:37 +00:00
|
|
|
void $ liftIO $ watchDir (fromRawFilePath dir) (const False) True hooks id
|
|
|
|
debug ["watching", fromRawFilePath dir]
|
2012-06-22 21:01:08 +00:00
|
|
|
|
2012-10-29 15:40:22 +00:00
|
|
|
type Handler = FilePath -> Assistant ()
|
2012-06-22 21:01:08 +00:00
|
|
|
|
|
|
|
{- Runs an action handler.
|
|
|
|
-
|
|
|
|
- Exceptions are ignored, otherwise a whole thread could be crashed.
|
|
|
|
-}
|
2012-10-29 15:40:22 +00:00
|
|
|
runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
|
|
|
|
runHandler handler file _filestatus =
|
|
|
|
either (liftIO . print) (const noop) =<< tryIO <~> handler file
|
2012-06-22 21:01:08 +00:00
|
|
|
|
|
|
|
{- Called when there's an error with inotify. -}
|
|
|
|
onErr :: Handler
|
2023-04-10 17:38:14 +00:00
|
|
|
onErr = giveup
|
2012-06-22 21:01:08 +00:00
|
|
|
|
2013-04-30 20:35:55 +00:00
|
|
|
{- Called when a new branch ref is written, or a branch ref is modified.
|
2012-06-22 21:01:08 +00:00
|
|
|
-
|
|
|
|
- At startup, synthetic add events fire, causing this to run, but that's
|
|
|
|
- ok; it ensures that any changes pushed since the last time the assistant
|
|
|
|
- ran are merged in.
|
|
|
|
-}
|
2013-04-30 20:35:55 +00:00
|
|
|
onChange :: Handler
|
|
|
|
onChange file
|
2012-06-22 21:01:08 +00:00
|
|
|
| ".lock" `isSuffixOf` file = noop
|
add ConfigMonitor thread
Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.
Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.
A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.
Also added a uuid.log cache. All other config files already had caches.
2012-10-20 20:37:06 +00:00
|
|
|
| isAnnexBranch file = do
|
2012-10-29 23:20:54 +00:00
|
|
|
branchChanged
|
merge git-annex branch in memory in read-only repository
Improved support for using git-annex in a read-only repository, git-annex
branch information from remotes that cannot be merged into the git-annex
branch will now not crash it, but will be merged in memory.
To avoid this making git-annex behave one way in a read-only repository,
and another way when it can write, it's important that Annex.Branch.get
return the same thing (modulo log file compaction) in both cases.
This manages that mostly. There are some exceptions:
- When there is a transition in one of the remote git-annex branches
that has not yet been applied to the local or other git-annex branches.
Transitions are not handled.
- `git-annex log` runs git log on the git-annex branch, and so
it will not be able to show information coming from the other, not yet
merged branches.
- Annex.Branch.files only looks at files in the git-annex branch and not
unmerged branches. This affects git-annex info output.
- Annex.Branch.hs.overBranchFileContents ditto. Affects --all and
also importfeed (but importfeed cannot work in a read-only repo
anyway).
- CmdLine.Seek.seekFilteredKeys when precaching location logs.
Note use of Annex.Branch.fullname
- Database.ContentIdentifier.needsUpdateFromLog and updateFromLog
These warts make this not suitable to be merged yet.
This readonly code path is more expensive, since it has to query several
branches. The value does get cached, but still large queries will be
slower in a read-only repository when there are unmerged git-annex
branches.
When annex.merge-annex-branches=false, updateTo skips doing anything,
and so the read-only repository code does not get triggered. So a user who
is bothered by the extra work can set that.
Other writes to the repository can still result in permissions errors.
This includes the initial creation of the git-annex branch, and of course
any writes to the git-annex branch.
Sponsored-by: Dartmouth College's Datalad project
2021-12-26 18:28:42 +00:00
|
|
|
diverged <- liftAnnex Annex.Branch.forceUpdate >>= return . \case
|
|
|
|
u@(Annex.Branch.UpdateMade {}) -> Annex.Branch.refsWereMerged u
|
|
|
|
(Annex.Branch.UpdateFailedPermissions {}) -> True
|
2017-09-20 20:34:29 +00:00
|
|
|
when diverged $ do
|
|
|
|
updateExportTreeFromLogAll
|
2016-11-14 18:26:20 +00:00
|
|
|
queueDeferredDownloads "retrying deferred download" Later
|
2017-06-07 20:16:22 +00:00
|
|
|
| otherwise = mergecurrent
|
2012-10-29 15:40:22 +00:00
|
|
|
where
|
|
|
|
changedbranch = fileToBranch file
|
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
|
|
|
|
2017-06-07 17:41:04 +00:00
|
|
|
mergecurrent =
|
2018-10-19 19:17:48 +00:00
|
|
|
mergecurrent' =<< liftAnnex getCurrentBranch
|
2017-06-07 17:41:04 +00:00
|
|
|
mergecurrent' currbranch@(Just b, _)
|
2022-03-31 17:02:16 +00:00
|
|
|
| changedbranch `isRelatedTo` b = do
|
2016-02-29 19:57:47 +00:00
|
|
|
whenM (liftAnnex $ inRepo $ Git.Branch.changed b changedbranch) $ do
|
2014-07-05 21:12:05 +00:00
|
|
|
debug
|
|
|
|
[ "merging", Git.fromRef changedbranch
|
2016-02-29 19:57:47 +00:00
|
|
|
, "into", Git.fromRef b
|
2014-07-05 21:12:05 +00:00
|
|
|
]
|
2019-11-11 20:15:05 +00:00
|
|
|
void $ liftAnnex $ do
|
2019-11-11 22:20:35 +00:00
|
|
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
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 <- Command.Sync.mergeConfig True
|
2019-11-11 20:15:05 +00:00
|
|
|
Command.Sync.merge
|
2021-07-19 15:28:31 +00:00
|
|
|
currbranch
|
|
|
|
mc
|
2019-11-11 20:15:05 +00:00
|
|
|
def
|
|
|
|
cmode
|
|
|
|
changedbranch
|
2022-03-31 17:02:16 +00:00
|
|
|
recordCommit
|
|
|
|
| changedbranch == b =
|
|
|
|
-- Record commit so the pusher pushes it out.
|
|
|
|
-- This makes sure pushes happen when
|
|
|
|
-- annex.autocommit=false
|
|
|
|
recordCommit
|
2017-06-07 17:41:04 +00:00
|
|
|
mergecurrent' _ = noop
|
2012-09-16 22:53:13 +00:00
|
|
|
|
2017-06-07 20:16:22 +00:00
|
|
|
{- Is the first branch a synced branch or remote tracking branch related
|
|
|
|
- to the second branch, which should be merged into it? -}
|
|
|
|
isRelatedTo :: Git.Ref -> Git.Ref -> Bool
|
|
|
|
isRelatedTo x y
|
|
|
|
| basex /= takeDirectory basex ++ "/" ++ basey = False
|
|
|
|
| "/synced/" `isInfixOf` Git.fromRef x = True
|
|
|
|
| "refs/remotes/" `isPrefixOf` Git.fromRef x = True
|
|
|
|
| otherwise = False
|
2012-10-31 06:34:03 +00:00
|
|
|
where
|
2017-06-07 20:16:22 +00:00
|
|
|
basex = Git.fromRef $ Git.Ref.base x
|
|
|
|
basey = Git.fromRef $ Git.Ref.base y
|
2012-06-22 21:01:08 +00:00
|
|
|
|
2012-09-16 22:53:13 +00:00
|
|
|
isAnnexBranch :: FilePath -> Bool
|
|
|
|
isAnnexBranch f = n `isSuffixOf` f
|
2012-10-31 06:34:03 +00:00
|
|
|
where
|
2014-02-19 05:09:17 +00:00
|
|
|
n = '/' : Git.fromRef Annex.Branch.name
|
2012-09-16 22:53:13 +00:00
|
|
|
|
|
|
|
fileToBranch :: FilePath -> Git.Ref
|
2021-08-11 00:45:02 +00:00
|
|
|
fileToBranch f = Git.Ref $ encodeBS $ "refs" </> base
|
2012-10-31 06:34:03 +00:00
|
|
|
where
|
|
|
|
base = Prelude.last $ split "/refs/" f
|