10b5f79e2d
Fix behavior when importing a tree from a directory remote when the
directory does not exist. An empty tree was imported, rather than the
import failing. Merging that tree would delete every file in the
branch, if those files had been exported to the directory before.
The problem was that dirContentsRecursive returned [] when the directory
did not exist. Better for it to throw an exception. But in commit
74f0d67aa3 back in 2012, I made it never
theow exceptions, because exceptions throw inside unsafeInterleaveIO become
untrappable when the list is being traversed.
So, changed it to list the contents of the directory before entering
unsafeInterleaveIO. So exceptions are thrown for the directory. But still
not if it's unable to list the contents of a subdirectory. That's less of a
problem, because the subdirectory does exist (or if not, it got removed
after being listed, and it's ok to not include it in the list). A
subdirectory that has permissions that don't allow listing it will have its
contents omitted from the list still.
(Might be better to have it return a type that includes indications of
errors listing contents of subdirectories?)
The rest of the changes are making callers of dirContentsRecursive
use emptyWhenDoesNotExist when they relied on the behavior of it not
throwing an exception when the directory does not exist. Note that
it's possible some callers of dirContentsRecursive that used to ignore
permissions problems listing a directory will now start throwing exceptions
on them.
The fix to the directory special remote consisted of not making its
call in listImportableContentsM use emptyWhenDoesNotExist. So it will
throw an exception as desired.
Sponsored-by: Joshua Antonishen on Patreon
166 lines
6.4 KiB
Haskell
166 lines
6.4 KiB
Haskell
{- adjusted branch merging
|
|
-
|
|
- Copyright 2016-2023 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE BangPatterns, OverloadedStrings #-}
|
|
|
|
module Annex.AdjustedBranch.Merge (
|
|
canMergeToAdjustedBranch,
|
|
mergeToAdjustedBranch,
|
|
) where
|
|
|
|
import Annex.Common
|
|
import Annex.AdjustedBranch
|
|
import qualified Annex
|
|
import Git
|
|
import Git.Types
|
|
import qualified Git.Branch
|
|
import qualified Git.Ref
|
|
import qualified Git.Command
|
|
import qualified Git.Merge
|
|
import Git.Sha
|
|
import Annex.CatFile
|
|
import Annex.AutoMerge
|
|
import Annex.Tmp
|
|
import Annex.GitOverlay
|
|
import Utility.Tmp.Dir
|
|
import Utility.CopyFile
|
|
import Utility.Directory.Create
|
|
|
|
import qualified Data.ByteString as S
|
|
import qualified System.FilePath.ByteString as P
|
|
|
|
canMergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Annex Bool
|
|
canMergeToAdjustedBranch tomerge (origbranch, adj) =
|
|
inRepo $ Git.Branch.changed currbranch tomerge
|
|
where
|
|
AdjBranch currbranch = originalToAdjusted origbranch adj
|
|
|
|
{- Update the currently checked out adjusted branch, merging the provided
|
|
- branch into it. Note that the provided branch should be a non-adjusted
|
|
- branch. -}
|
|
mergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Bool -> Git.Branch.CommitMode -> Annex Bool
|
|
mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge commitmode = catchBoolIO $
|
|
join $ preventCommits go
|
|
where
|
|
adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj
|
|
basis = basisBranch adjbranch
|
|
|
|
go commitsprevented = do
|
|
(updatedorig, _) <- propigateAdjustedCommits'
|
|
False origbranch adj commitsprevented
|
|
changestomerge updatedorig
|
|
|
|
{- Since the adjusted branch changes files, merging tomerge
|
|
- directly into it would likely result in unnecessary merge
|
|
- conflicts. To avoid those conflicts, instead merge tomerge into
|
|
- updatedorig. The result of the merge can the be
|
|
- adjusted to yield the final adjusted branch.
|
|
-
|
|
- In order to do a merge into a ref that is not checked out,
|
|
- set the work tree to a temp directory, and set GIT_DIR
|
|
- to another temp directory, in which HEAD contains the
|
|
- updatedorig sha. GIT_COMMON_DIR is set to point to the real
|
|
- git directory, and so git can read and write objects from there,
|
|
- but will use GIT_DIR for HEAD and index.
|
|
-
|
|
- (Doing the merge this way also lets it run even though the main
|
|
- index file is currently locked.)
|
|
-}
|
|
changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
|
|
git_dir <- fromRepo Git.localGitDir
|
|
let git_dir' = fromRawFilePath git_dir
|
|
tmpwt <- fromRepo gitAnnexMergeDir
|
|
withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
|
|
withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
|
|
liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
|
|
-- Copy in refs and packed-refs, to work
|
|
-- around bug in git 2.13.0, which
|
|
-- causes it not to look in GIT_DIR for refs.
|
|
refs <- liftIO $ emptyWhenDoesNotExist $
|
|
dirContentsRecursive $
|
|
git_dir' </> "refs"
|
|
let refs' = (git_dir' </> "packed-refs") : refs
|
|
liftIO $ forM_ refs' $ \src -> do
|
|
let src' = toRawFilePath src
|
|
whenM (doesFileExist src) $ do
|
|
dest <- relPathDirToFile git_dir src'
|
|
let dest' = toRawFilePath tmpgit P.</> dest
|
|
createDirectoryUnder [git_dir]
|
|
(P.takeDirectory dest')
|
|
void $ createLinkOrCopy src' dest'
|
|
-- This reset makes git merge not care
|
|
-- that the work tree is empty; otherwise
|
|
-- it will think that all the files have
|
|
-- been staged for deletion, and sometimes
|
|
-- the merge includes these deletions
|
|
-- (for an unknown reason).
|
|
-- http://thread.gmane.org/gmane.comp.version-control.git/297237
|
|
inRepo $ Git.Command.run [Param "reset", Param "HEAD", Param "--quiet"]
|
|
when (tomerge /= origbranch) $
|
|
showAction $ UnquotedString $ "Merging into " ++ fromRef (Git.Ref.base origbranch)
|
|
merged <- autoMergeFrom' tomerge Nothing mergeconfig commitmode True
|
|
(const $ resolveMerge (Just updatedorig) tomerge True)
|
|
if merged
|
|
then do
|
|
!mergecommit <- liftIO $ extractSha
|
|
<$> S.readFile (tmpgit </> "HEAD")
|
|
-- This is run after the commit lock is dropped.
|
|
return $ postmerge mergecommit
|
|
else return $ return False
|
|
changestomerge Nothing = return $ return False
|
|
|
|
withemptydir git_dir d a = bracketIO setup cleanup (const a)
|
|
where
|
|
setup = do
|
|
whenM (doesDirectoryExist d) $
|
|
removeDirectoryRecursive d
|
|
createDirectoryUnder [git_dir] (toRawFilePath d)
|
|
cleanup _ = removeDirectoryRecursive d
|
|
|
|
{- A merge commit has been made between the basisbranch and
|
|
- tomerge. Update the basisbranch and origbranch to point
|
|
- to that commit, adjust it to get the new adjusted branch,
|
|
- and check it out.
|
|
-
|
|
- But, there may be unstaged work tree changes that conflict,
|
|
- so the check out is done by making a normal merge of
|
|
- the new adjusted branch.
|
|
-}
|
|
postmerge (Just mergecommit) = do
|
|
setBasisBranch basis mergecommit
|
|
inRepo $ Git.Branch.update' origbranch mergecommit
|
|
adjtree <- adjustTree adj (BasisBranch mergecommit)
|
|
adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit)
|
|
-- Make currbranch be the parent, so that merging
|
|
-- this commit will be a fast-forward.
|
|
adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]
|
|
showAction "Merging into adjusted branch"
|
|
ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig commitmode canresolvemerge)
|
|
( reparent adjtree adjmergecommit =<< getcurrentcommit
|
|
, return False
|
|
)
|
|
postmerge Nothing = return False
|
|
|
|
-- Now that the merge into the adjusted branch is complete,
|
|
-- take the tree from that merge, and attach it on top of the
|
|
-- adjmergecommit, if it's different.
|
|
reparent adjtree adjmergecommit (Just currentcommit) = do
|
|
if (commitTree currentcommit /= adjtree)
|
|
then do
|
|
cmode <- annexCommitMode <$> Annex.getGitConfig
|
|
c <- inRepo $ Git.Branch.commitTree cmode
|
|
("Merged " ++ fromRef tomerge) [adjmergecommit]
|
|
(commitTree currentcommit)
|
|
inRepo $ Git.Branch.update "updating adjusted branch" currbranch c
|
|
propigateAdjustedCommits origbranch adj
|
|
else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit
|
|
return True
|
|
reparent _ _ Nothing = return False
|
|
|
|
getcurrentcommit = inRepo Git.Branch.currentUnsafe >>= \case
|
|
Nothing -> return Nothing
|
|
Just c -> catCommit c
|