From 4712882776be44628718365b165f709469827682 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 25 Feb 2016 16:10:54 -0400 Subject: [PATCH 01/54] add hashPointerFile' --- Annex/Link.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Annex/Link.hs b/Annex/Link.hs index 40e56f23ef..1f2830c40a 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -123,6 +123,9 @@ hashPointerFile :: Key -> Annex Sha hashPointerFile key = inRepo $ Git.HashObject.hashObject BlobObject $ formatPointer key +hashPointerFile' :: Git.HashObject.HashObjectHandle -> Key -> Annex Sha +hashPointerFile' h = liftIO . Git.HashObject.hashBlob h . formatPointer + {- Stages a pointer file, using a Sha of its content -} stagePointerFile :: FilePath -> Sha -> Annex () stagePointerFile file sha = From 0a1b02ce0408a37a8b2e15e431cee1d7f6866500 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 25 Feb 2016 16:11:13 -0400 Subject: [PATCH 02/54] adjusted branches, proof of concept "git annex adjust" may be a temporary interface, but works for a proof of concept. It is pretty fast at creating the adjusted branch. The main overhead is injecting pointer files. It might be worth optimising that by reusing the symlink target as the pointer file content. When I tried to do that, the problem was that the clean filter doesn't use that same format, and so git thought files had changed. Could be dealt with, perhaps make the clean filter use symlink format for pointer files when on an adjusted branch? But the real overhead is in checking out the branch, when git runs the smudge filter once per file. That is perhaps too slow to be usable, although it may only affect initial checkout of the branch, and not updates. TBD. --- Annex/AdjustedBranch.hs | 102 ++++++++++++++++++++++++++++++++++++++++ CmdLine/GitAnnex.hs | 2 + Command/Adjust.hs | 25 ++++++++++ 3 files changed, 129 insertions(+) create mode 100644 Annex/AdjustedBranch.hs create mode 100644 Command/Adjust.hs diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs new file mode 100644 index 0000000000..b80ade7c4b --- /dev/null +++ b/Annex/AdjustedBranch.hs @@ -0,0 +1,102 @@ +{- adjusted version of main branch + - + - Copyright 2016 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.AdjustedBranch where + +import Annex.Common +import qualified Annex +import Git.Types +import qualified Git.Branch +import qualified Git.Ref +import qualified Git.Command +import Git.Tree +import Git.Env +import Annex.CatFile +import Annex.Link +import Git.HashObject + +data Adjustment = UnlockAdjustment + deriving (Show) + +adjustTreeItem :: Adjustment -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) +adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s) + | toBlobType m == Just SymlinkBlob = do + mk <- catKey s + case mk of + Just k -> Just . TreeItem f (fromBlobType FileBlob) + <$> hashPointerFile' h k + Nothing -> return (Just ti) + | otherwise = return (Just ti) + +type OrigBranch = Branch +type AdjBranch = Branch + +adjustedBranchPrefix :: String +adjustedBranchPrefix = "refs/heads/adjusted/" + +originalToAdjusted :: OrigBranch -> AdjBranch +originalToAdjusted orig = Ref $ adjustedBranchPrefix ++ takeFileName (fromRef orig) + +adjustedToOriginal :: AdjBranch -> Maybe (OrigBranch) +adjustedToOriginal b + | adjustedBranchPrefix `isPrefixOf` bs = + Just $ Ref $ drop prefixlen bs + | otherwise = Nothing + where + bs = fromRef b + prefixlen = length adjustedBranchPrefix + +originalBranch :: Annex (Maybe OrigBranch) +originalBranch = fmap getorig <$> inRepo Git.Branch.current + where + getorig currbranch = fromMaybe currbranch (adjustedToOriginal currbranch) + +{- Enter an adjusted version of current branch (or, if already in an + - adjusted version of a branch, changes the adjustment of the original + - branch). + - + - Can fail, if no branch is checked out, or perhaps if staged changes + - conflict with the adjusted branch. + -} +enterAdjustedBranch :: Adjustment -> Annex () +enterAdjustedBranch adj = go =<< originalBranch + where + go (Just origbranch) = do + adjbranch <- adjustBranch adj origbranch + inRepo $ Git.Command.run + [ Param "checkout" + , Param $ fromRef $ Git.Ref.base $ adjbranch + ] + go Nothing = error "not on any branch!" + +adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch +adjustBranch adj origbranch = do + h <- inRepo hashObjectStart + treesha <- adjustTree (adjustTreeItem adj h) origbranch =<< Annex.gitRepo + liftIO $ hashObjectStop h + commitsha <- commitAdjustedTree treesha origbranch + inRepo $ Git.Branch.update adjbranch commitsha + return adjbranch + where + adjbranch = originalToAdjusted origbranch + +{- Commits a given adjusted tree, with the provided parent ref. + - + - This should always yield the same value, even if performed in different + - clones of a repo, at different times. The commit message and other + - metadata is based on the parent. + -} +commitAdjustedTree :: Sha -> Ref -> Annex Sha +commitAdjustedTree treesha parent = go =<< catCommit parent + where + go Nothing = inRepo mkcommit + go (Just parentcommit) = inRepo $ commitWithMetaData + (commitAuthorMetaData parentcommit) + (commitCommitterMetaData parentcommit) + mkcommit + mkcommit = Git.Branch.commitTree + Git.Branch.AutomaticCommit "adjusted branch" [parent] treesha diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 71a69e8614..b8c97a30aa 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -38,6 +38,7 @@ import qualified Command.SetPresentKey import qualified Command.ReadPresentKey import qualified Command.CheckPresentKey import qualified Command.ReKey +import qualified Command.Adjust import qualified Command.MetaData import qualified Command.View import qualified Command.VAdd @@ -174,6 +175,7 @@ cmds testoptparser testrunner = , Command.ReadPresentKey.cmd , Command.CheckPresentKey.cmd , Command.ReKey.cmd + , Command.Adjust.cmd , Command.MetaData.cmd , Command.View.cmd , Command.VAdd.cmd diff --git a/Command/Adjust.hs b/Command/Adjust.hs new file mode 100644 index 0000000000..b52537a648 --- /dev/null +++ b/Command/Adjust.hs @@ -0,0 +1,25 @@ +{- git-annex command + - + - Copyright 2016 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Adjust where + +import Command +import Annex.AdjustedBranch + +cmd :: Command +cmd = notBareRepo $ notDirect $ + command "adjust" SectionSetup "adjust branch" + paramNothing (withParams seek) + +seek :: CmdParams -> CommandSeek +seek = withWords start + +start :: [String] -> CommandStart +start [] = do + enterAdjustedBranch UnlockAdjustment + next $ next $ return True +start _ = error "Unknown parameter" From 9e1ebc2336794a025a549dfba795f5dfeff5fd4a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 15:04:03 -0400 Subject: [PATCH 03/54] include adjustment in the adjusted branch name Allows it to be recovered easily. --- Annex/AdjustedBranch.hs | 42 +++++++++++++++++++++++++++++++++-------- 1 file changed, 34 insertions(+), 8 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index b80ade7c4b..4c009c9ea1 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -5,7 +5,14 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Annex.AdjustedBranch where +module Annex.AdjustedBranch ( + Adjustment(..), + OrigBranch, + AdjBranch, + adjustedToOriginal, + enterAdjustedBranch, + updateAdjustedBranch, +) where import Annex.Common import qualified Annex @@ -38,22 +45,35 @@ type AdjBranch = Branch adjustedBranchPrefix :: String adjustedBranchPrefix = "refs/heads/adjusted/" -originalToAdjusted :: OrigBranch -> AdjBranch -originalToAdjusted orig = Ref $ adjustedBranchPrefix ++ takeFileName (fromRef orig) +serialize :: Adjustment -> String +serialize UnlockAdjustment = "unlock" -adjustedToOriginal :: AdjBranch -> Maybe (OrigBranch) +deserialize :: String -> Maybe Adjustment +deserialize "unlock" = Just UnlockAdjustment +deserialize _ = Nothing + +originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch +originalToAdjusted orig adj = Git.Ref.under base orig + where + base = adjustedBranchPrefix ++ serialize adj + +adjustedToOriginal :: AdjBranch -> Maybe (Adjustment, OrigBranch) adjustedToOriginal b - | adjustedBranchPrefix `isPrefixOf` bs = - Just $ Ref $ drop prefixlen bs + | adjustedBranchPrefix `isPrefixOf` bs = do + adj <- deserialize (takeWhile (/= '/') (drop prefixlen bs)) + Just (adj, Git.Ref.basename b) | otherwise = Nothing where bs = fromRef b prefixlen = length adjustedBranchPrefix +getAdjustment :: Annex (Maybe (Adjustment, OrigBranch)) +getAdjustment = maybe Nothing adjustedToOriginal <$> inRepo Git.Branch.current + originalBranch :: Annex (Maybe OrigBranch) originalBranch = fmap getorig <$> inRepo Git.Branch.current where - getorig currbranch = fromMaybe currbranch (adjustedToOriginal currbranch) + getorig currbranch = maybe currbranch snd (adjustedToOriginal currbranch) {- Enter an adjusted version of current branch (or, if already in an - adjusted version of a branch, changes the adjustment of the original @@ -82,7 +102,7 @@ adjustBranch adj origbranch = do inRepo $ Git.Branch.update adjbranch commitsha return adjbranch where - adjbranch = originalToAdjusted origbranch + adjbranch = originalToAdjusted origbranch adj {- Commits a given adjusted tree, with the provided parent ref. - @@ -100,3 +120,9 @@ commitAdjustedTree treesha parent = go =<< catCommit parent mkcommit mkcommit = Git.Branch.commitTree Git.Branch.AutomaticCommit "adjusted branch" [parent] treesha + +{- Update the currently checked out adjusted branch, merging the provided + - branch into it. -} +updateAdjustedBranch :: Adjustment -> OrigBranch -> Branch -> Annex () +updateAdjustedBranch mergebranch = do + error "updateAdjustedBranch" From 7c20bf6e7a2dbca188d4624e43063deb1b723d68 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 15:23:08 -0400 Subject: [PATCH 04/54] make sync aware of adjusted branches So, it will pull and push the original branch, not the adjusted one. And, for merging, it will use updateAdjustedBranch (not implemented yet). Note that remaining uses of Git.Branch.current need to be checked too; for things that should act on the original branch, and not the adjusted branch. --- Annex/AdjustedBranch.hs | 5 +- Assistant/Sync.hs | 25 ++++--- Assistant/Threads/Committer.hs | 2 +- Assistant/Threads/XMPPClient.hs | 4 +- Assistant/WebApp/Configurators/Local.hs | 4 +- Command/Merge.hs | 5 +- Command/Sync.hs | 90 +++++++++++++++---------- Git/Ref.hs | 7 +- 8 files changed, 81 insertions(+), 61 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 4c009c9ea1..1579a1f2f7 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -67,9 +67,6 @@ adjustedToOriginal b bs = fromRef b prefixlen = length adjustedBranchPrefix -getAdjustment :: Annex (Maybe (Adjustment, OrigBranch)) -getAdjustment = maybe Nothing adjustedToOriginal <$> inRepo Git.Branch.current - originalBranch :: Annex (Maybe OrigBranch) originalBranch = fmap getorig <$> inRepo Git.Branch.current where @@ -123,6 +120,6 @@ commitAdjustedTree treesha parent = go =<< catCommit parent {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} -updateAdjustedBranch :: Adjustment -> OrigBranch -> Branch -> Annex () +updateAdjustedBranch :: Adjustment -> OrigBranch -> Branch -> Annex Bool updateAdjustedBranch mergebranch = do error "updateAdjustedBranch" diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 7a9ea6a86c..ebdead00da 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -19,7 +19,6 @@ import Assistant.RemoteControl import qualified Command.Sync import Utility.Parallel import qualified Git -import qualified Git.Branch import qualified Git.Command import qualified Git.Ref import qualified Remote @@ -79,16 +78,16 @@ reconnectRemotes notifypushes rs = void $ do | Git.repoIsLocal r = True | Git.repoIsLocalUnknown r = True | otherwise = False - sync (Just branch) = do - (failedpull, diverged) <- manualPull (Just branch) gitremotes + sync currentbranch@(Just _, _) = do + (failedpull, diverged) <- manualPull currentbranch gitremotes now <- liftIO getCurrentTime failedpush <- pushToRemotes' now notifypushes gitremotes return (nub $ failedpull ++ failedpush, diverged) {- No local branch exists yet, but we can try pulling. -} - sync Nothing = manualPull Nothing gitremotes + sync (Nothing, _) = manualPull (Nothing, Nothing) gitremotes go = do (failed, diverged) <- sync - =<< liftAnnex (inRepo Git.Branch.current) + =<< liftAnnex (join Command.Sync.getCurrBranch) addScanRemotes diverged $ filter (not . remoteAnnexIgnore . Remote.gitconfig) nonxmppremotes @@ -133,7 +132,7 @@ pushToRemotes' now notifypushes remotes = do Annex.Branch.commit "update" (,,) <$> gitRepo - <*> inRepo Git.Branch.current + <*> join Command.Sync.getCurrBranch <*> getUUID let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes ret <- go True branch g u normalremotes @@ -145,9 +144,9 @@ pushToRemotes' now notifypushes remotes = do Pushing (getXMPPClientID r) (CanPush u shas) return ret where - go _ Nothing _ _ _ = return [] -- no branch, so nothing to do + go _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do go _ _ _ _ [] = return [] -- no remotes, so nothing to do - go shouldretry (Just branch) g u rs = do + go shouldretry currbranch@(Just branch, _) g u rs = do debug ["pushing to", show rs] (succeeded, failed) <- parallelPush g rs (push branch) updatemap succeeded [] @@ -158,7 +157,7 @@ pushToRemotes' now notifypushes remotes = do map Remote.uuid succeeded return failed else if shouldretry - then retry branch g u failed + then retry currbranch g u failed else fallback branch g u failed updatemap succeeded failed = changeFailedPushMap $ \m -> @@ -166,10 +165,10 @@ pushToRemotes' now notifypushes remotes = do M.difference m (makemap succeeded) makemap l = M.fromList $ zip l (repeat now) - retry branch g u rs = do + retry currbranch g u rs = do debug ["trying manual pull to resolve failed pushes"] - void $ manualPull (Just branch) rs - go False (Just branch) g u rs + void $ manualPull currbranch rs + go False currbranch g u rs fallback branch g u rs = do debug ["fallback pushing to", show rs] @@ -227,7 +226,7 @@ syncAction rs a - XMPP remotes. However, those pushes will run asynchronously, so their - results are not included in the return data. -} -manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Remote], Bool) +manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool) manualPull currentbranch remotes = do g <- liftAnnex gitRepo let (xmppremotes, normalremotes) = partition Remote.isXMPPRemote remotes diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index be4a0a2554..070699cb28 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -227,7 +227,7 @@ commitStaged msg = do Right _ -> do ok <- Command.Sync.commitStaged Git.Branch.AutomaticCommit msg when ok $ - Command.Sync.updateSyncBranch =<< inRepo Git.Branch.current + Command.Sync.updateSyncBranch =<< join Command.Sync.getCurrBranch return ok {- OSX needs a short delay after a file is added before locking it down, diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index da29c4ae46..2b68ecbe11 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -25,6 +25,7 @@ import Assistant.Pairing import Assistant.XMPP.Git import Annex.UUID import Logs.UUID +import qualified Command.Sync import Network.Protocol.XMPP import Control.Concurrent @@ -33,7 +34,6 @@ import Control.Concurrent.STM (atomically) import qualified Data.Text as T import qualified Data.Set as S import qualified Data.Map as M -import qualified Git.Branch import Data.Time.Clock import Control.Concurrent.Async @@ -306,7 +306,7 @@ pull [] = noop pull us = do rs <- filter matching . syncGitRemotes <$> getDaemonStatus debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs - pullone rs =<< liftAnnex (inRepo Git.Branch.current) + pullone rs =<< liftAnnex (join Command.Sync.getCurrBranch) where matching r = Remote.uuid r `S.member` s s = S.fromList us diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index a2a465b875..a800aefc4d 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -20,7 +20,7 @@ import qualified Annex import qualified Git import qualified Git.Config import qualified Git.Command -import qualified Git.Branch +import qualified Command.Sync import Config.Files import Utility.FreeDesktop import Utility.DiskFree @@ -202,7 +202,7 @@ postNewRepositoryR = page "Add another repository" (Just Configuration) $ do - immediately pulling from it. Also spawns a sync to push to it as well. -} immediateSyncRemote :: Remote -> Assistant () immediateSyncRemote r = do - currentbranch <- liftAnnex (inRepo Git.Branch.current) + currentbranch <- liftAnnex $ join Command.Sync.getCurrBranch void $ manualPull currentbranch [r] syncRemote r diff --git a/Command/Merge.hs b/Command/Merge.hs index 6ea8a68b17..908f3c1aa7 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -9,8 +9,7 @@ module Command.Merge where import Command import qualified Annex.Branch -import qualified Git.Branch -import Command.Sync (prepMerge, mergeLocal) +import Command.Sync (prepMerge, mergeLocal, getCurrBranch) cmd :: Command cmd = command "merge" SectionMaintenance @@ -34,4 +33,4 @@ mergeBranch = do mergeSynced :: CommandStart mergeSynced = do prepMerge - mergeLocal =<< inRepo Git.Branch.current + mergeLocal =<< join getCurrBranch diff --git a/Command/Sync.hs b/Command/Sync.hs index 0c12fa0908..b362d7c1ef 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -8,6 +8,8 @@ module Command.Sync ( cmd, + CurrBranch, + getCurrBranch, prepMerge, mergeLocal, mergeRemote, @@ -43,6 +45,7 @@ import Annex.Drop import Annex.UUID import Logs.UUID import Annex.AutoMerge +import Annex.AdjustedBranch import Annex.Ssh import Annex.BloomFilter import Utility.Bloom @@ -95,20 +98,7 @@ seek :: SyncOptions -> CommandSeek seek o = allowConcurrentOutput $ do prepMerge - -- There may not be a branch checked out until after the commit, - -- or perhaps after it gets merged from the remote, or perhaps - -- never. - -- So only look it up once it's needed, and once there is a - -- branch, cache it. - mvar <- liftIO newEmptyMVar - let getbranch = ifM (liftIO $ isEmptyMVar mvar) - ( do - branch <- inRepo Git.Branch.current - when (isJust branch) $ - liftIO $ putMVar mvar branch - return branch - , liftIO $ readMVar mvar - ) + getbranch <- getCurrBranch let withbranch a = a =<< getbranch remotes <- syncRemotes (syncWith o) @@ -140,6 +130,35 @@ seek o = allowConcurrentOutput $ do -- Pushes to remotes can run concurrently. mapM_ (commandAction . withbranch . pushRemote o) gitremotes +type CurrBranch = (Maybe Git.Branch, Maybe Adjustment) + +{- There may not be a branch checked out until after the commit, + - or perhaps after it gets merged from the remote, or perhaps + - never. + - + - So only look it up once it's needed, and once there is a + - branch, cache it. + - + - When on an adjusted branch, gets the original branch, and the adjustment. + -} +getCurrBranch :: Annex (Annex CurrBranch) +getCurrBranch = do + mvar <- liftIO newEmptyMVar + return $ ifM (liftIO $ isEmptyMVar mvar) + ( do + currbranch <- inRepo Git.Branch.current + case currbranch of + Nothing -> return (Nothing, Nothing) + Just b -> do + let v = case adjustedToOriginal b of + Nothing -> (Just b, Nothing) + Just (adj, origbranch) -> + (Just origbranch, Just adj) + liftIO $ putMVar mvar v + return v + , liftIO $ readMVar mvar + ) + {- Merging may delete the current directory, so go to the top - of the repo. This also means that sync always acts on all files in the - repository, not just on a subdirectory. -} @@ -216,9 +235,9 @@ commitStaged commitmode commitmessage = do void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch parents return True -mergeLocal :: Maybe Git.Ref -> CommandStart -mergeLocal Nothing = stop -mergeLocal (Just branch) = go =<< needmerge +mergeLocal :: CurrBranch -> CommandStart +mergeLocal (Nothing, _) = stop +mergeLocal (Just branch, madj) = go =<< needmerge where syncbranch = syncBranch branch needmerge = ifM isBareRepo @@ -231,16 +250,18 @@ mergeLocal (Just branch) = go =<< needmerge go False = stop go True = do showStart "merge" $ Git.Ref.describe syncbranch - next $ next $ autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit + next $ next $ case madj of + Nothing -> autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit + Just adj -> updateAdjustedBranch adj branch syncbranch -pushLocal :: Maybe Git.Ref -> CommandStart +pushLocal :: CurrBranch -> CommandStart pushLocal b = do updateSyncBranch b stop -updateSyncBranch :: Maybe Git.Ref -> Annex () -updateSyncBranch Nothing = noop -updateSyncBranch (Just branch) = do +updateSyncBranch :: CurrBranch -> Annex () +updateSyncBranch (Nothing, _) = noop +updateSyncBranch (Just branch, _) = do -- Update the sync branch to match the new state of the branch inRepo $ updateBranch $ syncBranch branch -- In direct mode, we're operating on some special direct mode @@ -249,7 +270,7 @@ updateSyncBranch (Just branch) = do whenM isDirect $ inRepo $ updateBranch $ fromDirectBranch branch -updateBranch :: Git.Ref -> Git.Repo -> IO () +updateBranch :: Git.Branch -> Git.Repo -> IO () updateBranch syncbranch g = unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch where @@ -259,7 +280,7 @@ updateBranch syncbranch g = , Param $ Git.fromRef $ Git.Ref.base syncbranch ] g -pullRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart +pullRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do showStart "pull" (Remote.name remote) next $ do @@ -276,26 +297,27 @@ pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do - were committed (or pushed changes, if this is a bare remote), - while the synced/master may have changes that some - other remote synced to this remote. So, merge them both. -} -mergeRemote :: Remote -> Maybe Git.Ref -> CommandCleanup +mergeRemote :: Remote -> CurrBranch -> CommandCleanup mergeRemote remote b = ifM isBareRepo ( return True , case b of - Nothing -> do + (Nothing, _) -> do branch <- inRepo Git.Branch.currentUnsafe - and <$> mapM (merge Nothing) (branchlist branch) - Just thisbranch -> do - inRepo $ updateBranch $ syncBranch thisbranch - and <$> (mapM (merge (Just thisbranch)) =<< tomerge (branchlist b)) + and <$> mapM (merge Nothing Nothing) (branchlist branch) + (Just currbranch, madj) -> do + inRepo $ updateBranch $ syncBranch currbranch + and <$> (mapM (merge (Just currbranch) madj) =<< tomerge (branchlist (Just currbranch))) ) where - merge thisbranch br = autoMergeFrom (remoteBranch remote br) thisbranch Git.Branch.ManualCommit + merge (Just origbranch) (Just adj) br = updateAdjustedBranch adj origbranch br + merge currbranch _ br = autoMergeFrom (remoteBranch remote br) currbranch Git.Branch.ManualCommit tomerge = filterM (changed remote) branchlist Nothing = [] branchlist (Just branch) = [branch, syncBranch branch] -pushRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart -pushRemote _o _remote Nothing = stop -pushRemote o remote (Just branch) = stopUnless (pure (pushOption o) <&&> needpush) $ do +pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart +pushRemote _o _remote (Nothing, _) = stop +pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ do showStart "push" (Remote.name remote) next $ next $ do showOutput diff --git a/Git/Ref.hs b/Git/Ref.hs index 6bc47d5ed5..7f21b0ab81 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -31,11 +31,14 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef | prefix `isPrefixOf` s = drop (length prefix) s | otherwise = s +{- Gets the basename of any qualified ref. -} +basename :: Ref -> Ref +basename = Ref . reverse . takeWhile (/= '/') . reverse . fromRef + {- Given a directory and any ref, takes the basename of the ref and puts - it under the directory. -} under :: String -> Ref -> Ref -under dir r = Ref $ dir ++ "/" ++ - (reverse $ takeWhile (/= '/') $ reverse $ fromRef r) +under dir r = Ref $ dir ++ "/" ++ fromRef (basename r) {- Given a directory such as "refs/remotes/origin", and a ref such as - refs/heads/master, yields a version of that ref under the directory, From c1d7a5b97c7aecb1188cd72cf0e006f67902cfed Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 15:29:56 -0400 Subject: [PATCH 05/54] push original branch when on adjusted branch --- Assistant/XMPP/Git.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 2841a1cf8b..9e0b9278b0 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -292,10 +292,9 @@ xmppRemotes cid theiruuid = case baseJID <$> parseJID cid of {- Returns the ClientID that it pushed to. -} runPush :: (Remote -> Assistant ()) -> NetMessage -> Assistant (Maybe ClientID) runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) = - go =<< liftAnnex (inRepo Git.Branch.current) + go =<< liftAnnex (join Command.Sync.getCurrBranch) where - go Nothing = return Nothing - go (Just branch) = do + go (Just branch, _) = do rs <- xmppRemotes cid theiruuid liftAnnex $ Annex.Branch.commit "update" (g, u) <- liftAnnex $ (,) @@ -311,6 +310,7 @@ runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) = xmppPush cid (taggedPush u selfjid branch r) checkcloudrepos r return $ Just cid + go _ = return Nothing runPush checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do rs <- xmppRemotes cid theiruuid if null rs From 048d513233a04d25f03bebc49a8192157eaf8f19 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 15:57:47 -0400 Subject: [PATCH 06/54] make assistant aware of adjusted branches when merging --- Annex/AdjustedBranch.hs | 4 ++-- Assistant/Threads/Merger.hs | 16 +++++++++------- Assistant/XMPP/Git.hs | 1 - Command/Sync.hs | 32 +++++++++++++++++++------------- 4 files changed, 30 insertions(+), 23 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 1579a1f2f7..8acaa0514c 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -120,6 +120,6 @@ commitAdjustedTree treesha parent = go =<< catCommit parent {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} -updateAdjustedBranch :: Adjustment -> OrigBranch -> Branch -> Annex Bool -updateAdjustedBranch mergebranch = do +updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool +updateAdjustedBranch tomerge (origbranch, adj) commitmode = do error "updateAdjustedBranch" diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index f1a64925da..35d02322dc 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -17,7 +17,7 @@ import Utility.DirWatcher.Types import qualified Annex.Branch import qualified Git import qualified Git.Branch -import Annex.AutoMerge +import qualified Command.Sync import Annex.TaggedPush import Remote (remoteFromUUID) @@ -72,19 +72,21 @@ onChange file unlessM handleDesynced $ queueDeferredDownloads "retrying deferred download" Later | "/synced/" `isInfixOf` file = - mergecurrent =<< liftAnnex (inRepo Git.Branch.current) + mergecurrent =<< liftAnnex (join Command.Sync.getCurrBranch) | otherwise = noop where changedbranch = fileToBranch file - mergecurrent (Just current) - | equivBranches changedbranch current = - whenM (liftAnnex $ inRepo $ Git.Branch.changed current changedbranch) $ do + mergecurrent currbranch@(Just b, _) + | equivBranches changedbranch b = + whenM (liftAnnex $ inRepo $ Git.Branch.changed b changedbranch) $ do debug [ "merging", Git.fromRef changedbranch - , "into", Git.fromRef current + , "into", Git.fromRef b ] - void $ liftAnnex $ autoMergeFrom changedbranch (Just current) Git.Branch.AutomaticCommit + void $ liftAnnex $ Command.Sync.merge + currbranch Git.Branch.AutomaticCommit + changedbranch mergecurrent _ = noop handleDesynced = case fromTaggedBranch changedbranch of diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 9e0b9278b0..286fcf8798 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -27,7 +27,6 @@ import Annex.TaggedPush import Annex.CatFile import Config import Git -import qualified Git.Branch import qualified Types.Remote as Remote import qualified Remote as Remote import Remote.List diff --git a/Command/Sync.hs b/Command/Sync.hs index b362d7c1ef..0d0358af99 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -10,6 +10,7 @@ module Command.Sync ( cmd, CurrBranch, getCurrBranch, + merge, prepMerge, mergeLocal, mergeRemote, @@ -165,6 +166,12 @@ getCurrBranch = do prepMerge :: Annex () prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath +merge :: CurrBranch -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool +merge (Just b, Just adj) commitmode tomerge = + updateAdjustedBranch tomerge (b, adj) commitmode +merge (b, _) commitmode tomerge = + autoMergeFrom tomerge b commitmode + syncBranch :: Git.Ref -> Git.Ref syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch @@ -236,8 +243,7 @@ commitStaged commitmode commitmessage = do return True mergeLocal :: CurrBranch -> CommandStart -mergeLocal (Nothing, _) = stop -mergeLocal (Just branch, madj) = go =<< needmerge +mergeLocal currbranch@(Just branch, _) = go =<< needmerge where syncbranch = syncBranch branch needmerge = ifM isBareRepo @@ -250,9 +256,9 @@ mergeLocal (Just branch, madj) = go =<< needmerge go False = stop go True = do showStart "merge" $ Git.Ref.describe syncbranch - next $ next $ case madj of - Nothing -> autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit - Just adj -> updateAdjustedBranch adj branch syncbranch + next $ next $ + merge currbranch Git.Branch.ManualCommit syncbranch +mergeLocal (Nothing, _) = stop pushLocal :: CurrBranch -> CommandStart pushLocal b = do @@ -298,19 +304,19 @@ pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do - while the synced/master may have changes that some - other remote synced to this remote. So, merge them both. -} mergeRemote :: Remote -> CurrBranch -> CommandCleanup -mergeRemote remote b = ifM isBareRepo +mergeRemote remote currbranch = ifM isBareRepo ( return True - , case b of + , case currbranch of (Nothing, _) -> do branch <- inRepo Git.Branch.currentUnsafe - and <$> mapM (merge Nothing Nothing) (branchlist branch) - (Just currbranch, madj) -> do - inRepo $ updateBranch $ syncBranch currbranch - and <$> (mapM (merge (Just currbranch) madj) =<< tomerge (branchlist (Just currbranch))) + mergelisted (pure (branchlist branch)) + (Just branch, _) -> do + inRepo $ updateBranch $ syncBranch branch + mergelisted (tomerge (branchlist (Just branch))) ) where - merge (Just origbranch) (Just adj) br = updateAdjustedBranch adj origbranch br - merge currbranch _ br = autoMergeFrom (remoteBranch remote br) currbranch Git.Branch.ManualCommit + mergelisted getlist = and <$> + (mapM (merge currbranch Git.Branch.ManualCommit) =<< getlist) tomerge = filterM (changed remote) branchlist Nothing = [] branchlist (Just branch) = [branch, syncBranch branch] From 9731514c754646f95d18c39f2b28ee3f5426ced5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 16:57:42 -0400 Subject: [PATCH 07/54] update sync branch to the orig branch when in adjusted branch --- Assistant/XMPP/Git.hs | 2 +- Command/Sync.hs | 13 +++++++------ 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 286fcf8798..612e0f2c54 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -299,7 +299,7 @@ runPush checkcloudrepos (Pushing cid (PushRequest theiruuid)) = (g, u) <- liftAnnex $ (,) <$> gitRepo <*> getUUID - liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g + liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) branch g selfjid <- ((T.unpack <$>) . xmppClientID) <$> getDaemonStatus if null rs then return Nothing diff --git a/Command/Sync.hs b/Command/Sync.hs index 0d0358af99..bebe11355e 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -269,21 +269,22 @@ updateSyncBranch :: CurrBranch -> Annex () updateSyncBranch (Nothing, _) = noop updateSyncBranch (Just branch, _) = do -- Update the sync branch to match the new state of the branch - inRepo $ updateBranch $ syncBranch branch + inRepo $ updateBranch (syncBranch branch) branch -- In direct mode, we're operating on some special direct mode - -- branch, rather than the intended branch, so update the indended + -- branch, rather than the intended branch, so update the intended -- branch. whenM isDirect $ - inRepo $ updateBranch $ fromDirectBranch branch + inRepo $ updateBranch (fromDirectBranch branch) branch -updateBranch :: Git.Branch -> Git.Repo -> IO () -updateBranch syncbranch g = +updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO () +updateBranch syncbranch updateto g = unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch where go = Git.Command.runBool [ Param "branch" , Param "-f" , Param $ Git.fromRef $ Git.Ref.base syncbranch + , Param $ Git.fromRef $ updateto ] g pullRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart @@ -311,7 +312,7 @@ mergeRemote remote currbranch = ifM isBareRepo branch <- inRepo Git.Branch.currentUnsafe mergelisted (pure (branchlist branch)) (Just branch, _) -> do - inRepo $ updateBranch $ syncBranch branch + inRepo $ updateBranch (syncBranch branch) branch mergelisted (tomerge (branchlist (Just branch))) ) where From 9e6839fd3fcf7573ca0bec150f4dcc984635be57 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 17:12:55 -0400 Subject: [PATCH 08/54] fix bug introduced in recent commit --- Command/Sync.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Command/Sync.hs b/Command/Sync.hs index bebe11355e..927ad83909 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -317,7 +317,7 @@ mergeRemote remote currbranch = ifM isBareRepo ) where mergelisted getlist = and <$> - (mapM (merge currbranch Git.Branch.ManualCommit) =<< getlist) + (mapM (merge currbranch Git.Branch.ManualCommit . remoteBranch remote) =<< getlist) tomerge = filterM (changed remote) branchlist Nothing = [] branchlist (Just branch) = [branch, syncBranch branch] From d7bd4d971d0ad56695aee1d86455835312ac05fc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 17:16:56 -0400 Subject: [PATCH 09/54] implement updateAdjustedBranch --- Annex/AdjustedBranch.hs | 53 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 47 insertions(+), 6 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 8acaa0514c..3ff8e9265d 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -25,6 +25,7 @@ import Git.Env import Annex.CatFile import Annex.Link import Git.HashObject +import Annex.AutoMerge data Adjustment = UnlockAdjustment deriving (Show) @@ -92,15 +93,19 @@ enterAdjustedBranch adj = go =<< originalBranch adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch adjustBranch adj origbranch = do - h <- inRepo hashObjectStart - treesha <- adjustTree (adjustTreeItem adj h) origbranch =<< Annex.gitRepo - liftIO $ hashObjectStop h - commitsha <- commitAdjustedTree treesha origbranch - inRepo $ Git.Branch.update adjbranch commitsha + sha <- adjust adj origbranch + inRepo $ Git.Branch.update adjbranch sha return adjbranch where adjbranch = originalToAdjusted origbranch adj +adjust :: Adjustment -> Ref -> Annex Sha +adjust adj orig = do + h <- inRepo hashObjectStart + treesha <- adjustTree (adjustTreeItem adj h) orig =<< Annex.gitRepo + liftIO $ hashObjectStop h + commitAdjustedTree treesha orig + {- Commits a given adjusted tree, with the provided parent ref. - - This should always yield the same value, even if performed in different @@ -122,4 +127,40 @@ commitAdjustedTree treesha parent = go =<< catCommit parent - branch into it. -} updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool updateAdjustedBranch tomerge (origbranch, adj) commitmode = do - error "updateAdjustedBranch" + liftIO $ print ("updateAdjustedBranch", tomerge) + go =<< (,) + <$> inRepo (Git.Ref.sha tomerge) + <*> inRepo Git.Branch.current + where + go (Just mergesha, Just currbranch) = ifM (inRepo $ Git.Branch.changed currbranch mergesha) + ( do + propigateAdjustedCommits origbranch adj + adjustedtomerge <- adjust adj mergesha + liftIO $ print ("mergesha", mergesha, "adjustedtomerge", adjustedtomerge) + ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) + ( ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) + ( recommit currbranch mergesha =<< catCommit currbranch + , return False + ) + , return True -- no changes to merge + ) + , return True -- no changes to merge + ) + go _ = return False + {- Once a merge commit has been made, re-do it, removing + - the old version of the adjusted branch as a parent, and + - making the only parent be the branch that was merged in. + - + - Doing this ensures that the same commit Sha is + - always arrived at for a given commit from the merged in branch. + -} + recommit currbranch parent (Just commit) = do + commitsha <- commitAdjustedTree (commitTree commit) parent + inRepo $ Git.Branch.update currbranch commitsha + return True + recommit _ _ Nothing = return False + +{- Check for any commits present on the adjusted branch that have not yet + - been propigated to the master branch, and propigate them. -} +propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex () +propigateAdjustedCommits originbranch adj = return () -- TODO From 70e78cc53e4969866abf398a42eaae603e3b383d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 17:27:19 -0400 Subject: [PATCH 10/54] update keys database when adjusting branches --- Annex/AdjustedBranch.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 3ff8e9265d..7ab98fc6fc 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -26,6 +26,7 @@ import Annex.CatFile import Annex.Link import Git.HashObject import Annex.AutoMerge +import qualified Database.Keys data Adjustment = UnlockAdjustment deriving (Show) @@ -35,8 +36,10 @@ adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s) | toBlobType m == Just SymlinkBlob = do mk <- catKey s case mk of - Just k -> Just . TreeItem f (fromBlobType FileBlob) - <$> hashPointerFile' h k + Just k -> do + Database.Keys.addAssociatedFile k f + Just . TreeItem f (fromBlobType FileBlob) + <$> hashPointerFile' h k Nothing -> return (Just ti) | otherwise = return (Just ti) From 70e65db75165cbc64209f41265b5b8c9bc7fa3e1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 17:30:37 -0400 Subject: [PATCH 11/54] note a bug --- doc/design/adjusted_branches.mdwn | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index ba3e784214..854e4c0e7c 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -139,6 +139,28 @@ conflict should only affect the work tree/index, so can be resolved without making a commit, but B'' may end up being made to resolve a merge conflict.) +------ + +FIXME: When an adjusted unlocked branch has gotten a file, and a new +commit is merged in, that does not touch that file, there is a false merge +conflict on the file. It's auto-resolved by creating a .variant file. +This is probably a bug in the auto-resolve code for v6 files. + +Test case: + + git clone ~/lib/tmp + cd tmp + git annex upgrade + git annex adjust + git annex get t/foo + # make change in ~/lib/tmp and commit + git annex sync + # t/foo.variant-* is there + +------ + + + Once the merge is done, we have a commit B'' on adjusted/master. To finish, adjust that commit so it does not have adjusted/master as its parent. From a97a9aaaee4111f06de4512cec043be5987ece99 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 17:36:20 -0400 Subject: [PATCH 12/54] remove debug --- Annex/AdjustedBranch.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 7ab98fc6fc..c1820417d9 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -129,8 +129,7 @@ commitAdjustedTree treesha parent = go =<< catCommit parent {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool -updateAdjustedBranch tomerge (origbranch, adj) commitmode = do - liftIO $ print ("updateAdjustedBranch", tomerge) +updateAdjustedBranch tomerge (origbranch, adj) commitmode = go =<< (,) <$> inRepo (Git.Ref.sha tomerge) <*> inRepo Git.Branch.current @@ -139,7 +138,6 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = do ( do propigateAdjustedCommits origbranch adj adjustedtomerge <- adjust adj mergesha - liftIO $ print ("mergesha", mergesha, "adjustedtomerge", adjustedtomerge) ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) ( ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) ( recommit currbranch mergesha =<< catCommit currbranch From 102229fc67ae03ff3840a5d0bcba2d28494d1956 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Feb 2016 17:39:06 -0400 Subject: [PATCH 13/54] need to update master --- doc/design/adjusted_branches.mdwn | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 854e4c0e7c..f98bff00b2 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -174,7 +174,7 @@ adjust that commit so it does not have adjusted/master as its parent. |--------------->B'' | | -Finally, update master to point to B''. +Finally, update master, by reverse filtering B''. TODO Notice how similar this is to the commit graph. So, "fast-forward" merging the same B commit from origin/master will lead to an identical From de4bd97c9d9a165c83c29051ef7bc2028e3bb729 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 12:49:54 -0400 Subject: [PATCH 14/54] support for git-style lock files, on unix and windows --- Git/LockFile.hs | 63 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 Git/LockFile.hs diff --git a/Git/LockFile.hs b/Git/LockFile.hs new file mode 100644 index 0000000000..ce04ec90a0 --- /dev/null +++ b/Git/LockFile.hs @@ -0,0 +1,63 @@ +{- git lock files + - + - Copyright 2016 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Git.LockFile where + +import Common + +#ifndef mingw32_HOST_OS +import System.Posix.Types +#else +import System.Win32.Types +import System.Win32.File +#endif + +#ifndef mingw32_HOST_OS +data LockHandle = LockHandle FilePath Fd +#else +data LockHandle = LockHandle FilePath HANDLE +#endif + +{- Uses the same exclusive locking that git does. + - Throws an IO exception if the file is already locked. + - + - Note that git's locking method suffers from the problem that + - a dangling lock can be left if a process is terminated at the wrong + - time. + -} +openLock :: FilePath -> IO LockHandle +openLock lck = do +#ifndef mingw32_HOST_OS + -- On unix, git simply uses O_EXCL + h <- openFd lck ReadWrite (Just 0O666) + (defaultFileFlags { exclusive = True }) + setFdOption h CloseOnExec True +#else + -- It's not entirely clear how git manages locking on Windows, + -- since it's buried in the portability layer, and different + -- versions of git for windows use different portability layers. + -- But, we can be fairly sure that holding the lock file open on + -- windows is enough to prevent another process from opening it. + -- + -- So, all that's needed is a way to open the file, that fails + -- if the file already exists. Using CreateFile with CREATE_NEW + -- accomplishes that. + h <- createFile lck gENERIC_WRITE fILE_SHARE_NONE Nothing + cREATE_NEW fILE_ATTRIBUTE_NORMAL Nothing +#endif + return (LockHandle lck h) + +closeLock :: LockHandle -> IO () +closeLock (LockHandle lck h) = do +#ifndef mingw32_HOST_OS + closeFd h +#else + closeHandle h +#endif + removeFile lck From ef1abda78b83394771b03363658b661d4f8eeaad Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 12:55:00 -0400 Subject: [PATCH 15/54] lock index while making index-less commits Avoids race with another git commit at the same time adjusted branch is being updated. --- Annex/AdjustedBranch.hs | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index c1820417d9..5a015e9863 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -22,6 +22,8 @@ import qualified Git.Ref import qualified Git.Command import Git.Tree import Git.Env +import Git.Index +import qualified Git.LockFile import Annex.CatFile import Annex.Link import Git.HashObject @@ -86,7 +88,7 @@ originalBranch = fmap getorig <$> inRepo Git.Branch.current enterAdjustedBranch :: Adjustment -> Annex () enterAdjustedBranch adj = go =<< originalBranch where - go (Just origbranch) = do + go (Just origbranch) = preventCommits $ do adjbranch <- adjustBranch adj origbranch inRepo $ Git.Command.run [ Param "checkout" @@ -109,6 +111,19 @@ adjust adj orig = do liftIO $ hashObjectStop h commitAdjustedTree treesha orig +{- Locks git's index file, preventing git from making a commit, merge, + - or otherwise changing the HEAD ref while the action is run. + - + - Throws an IO exception if the index file is already locked. + -} +preventCommits :: Annex a -> Annex a +preventCommits = bracket setup cleanup . const + where + setup = do + lck <- fromRepo indexFileLock + liftIO $ Git.LockFile.openLock lck + cleanup lckhandle = liftIO $ Git.LockFile.closeLock lckhandle + {- Commits a given adjusted tree, with the provided parent ref. - - This should always yield the same value, even if performed in different @@ -129,8 +144,8 @@ commitAdjustedTree treesha parent = go =<< catCommit parent {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool -updateAdjustedBranch tomerge (origbranch, adj) commitmode = - go =<< (,) +updateAdjustedBranch tomerge (origbranch, adj) commitmode = + catchBoolIO $ preventCommits $ go =<< (,) <$> inRepo (Git.Ref.sha tomerge) <*> inRepo Git.Branch.current where From 730b249477a3484e214cf980db6735e5cc683a64 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 13:05:00 -0400 Subject: [PATCH 16/54] replicate git's message about an existing lock file --- Git/LockFile.hs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/Git/LockFile.hs b/Git/LockFile.hs index ce04ec90a0..a7a1441144 100644 --- a/Git/LockFile.hs +++ b/Git/LockFile.hs @@ -32,7 +32,22 @@ data LockHandle = LockHandle FilePath HANDLE - time. -} openLock :: FilePath -> IO LockHandle -openLock lck = do +openLock lck = openLock' lck `catchNonAsync` lckerr + where + lckerr e = do + -- Same error message displayed by git. + whenM (doesFileExist lck) $ + hPutStrLn stderr $ unlines + [ "fatal: Unable to create '" ++ lck ++ "': " ++ show e + , "" + , "If no other git process is currently running, this probably means a" + , "git process crashed in this repository earlier. Make sure no other git" + , "process is running and remove the file manually to continue." + ] + throwM e + +openLock' :: FilePath -> IO LockHandle +openLock' lck = do #ifndef mingw32_HOST_OS -- On unix, git simply uses O_EXCL h <- openFd lck ReadWrite (Just 0O666) From 6024108ab28e6a04cf8c85dd7ff116f86294a505 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 14:13:54 -0400 Subject: [PATCH 17/54] push original branch, not adjusted branch --- Annex/AdjustedBranch.hs | 12 ++++++++---- Command/Sync.hs | 21 ++++++++++++++------- 2 files changed, 22 insertions(+), 11 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 5a015e9863..cea138f55b 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -10,8 +10,10 @@ module Annex.AdjustedBranch ( OrigBranch, AdjBranch, adjustedToOriginal, + fromAdjustedBranch, enterAdjustedBranch, updateAdjustedBranch, + propigateAdjustedCommits, ) where import Annex.Common @@ -73,10 +75,11 @@ adjustedToOriginal b bs = fromRef b prefixlen = length adjustedBranchPrefix +fromAdjustedBranch :: Branch -> OrigBranch +fromAdjustedBranch b = maybe b snd (adjustedToOriginal b) + originalBranch :: Annex (Maybe OrigBranch) -originalBranch = fmap getorig <$> inRepo Git.Branch.current - where - getorig currbranch = maybe currbranch snd (adjustedToOriginal currbranch) +originalBranch = fmap fromAdjustedBranch <$> inRepo Git.Branch.current {- Enter an adjusted version of current branch (or, if already in an - adjusted version of a branch, changes the adjustment of the original @@ -173,10 +176,11 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = recommit currbranch parent (Just commit) = do commitsha <- commitAdjustedTree (commitTree commit) parent inRepo $ Git.Branch.update currbranch commitsha + propigateAdjustedCommits origbranch adj return True recommit _ _ Nothing = return False {- Check for any commits present on the adjusted branch that have not yet - - been propigated to the master branch, and propigate them. -} + - been propigated to the orig branch, and propigate them. -} propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex () propigateAdjustedCommits originbranch adj = return () -- TODO diff --git a/Command/Sync.hs b/Command/Sync.hs index 927ad83909..355f71d1d0 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -172,8 +172,8 @@ merge (Just b, Just adj) commitmode tomerge = merge (b, _) commitmode tomerge = autoMergeFrom tomerge b commitmode -syncBranch :: Git.Ref -> Git.Ref -syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch +syncBranch :: Git.Branch -> Git.Branch +syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch . fromAdjustedBranch remoteBranch :: Remote -> Git.Ref -> Git.Ref remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote @@ -268,13 +268,20 @@ pushLocal b = do updateSyncBranch :: CurrBranch -> Annex () updateSyncBranch (Nothing, _) = noop updateSyncBranch (Just branch, _) = do + -- When in an adjusted branch, propigate any changes to it back to + -- the original branch. + branch' <- case adjustedToOriginal branch of + Just (adj, origbranch) -> do + propigateAdjustedCommits origbranch adj + return origbranch + Nothing -> return branch -- Update the sync branch to match the new state of the branch - inRepo $ updateBranch (syncBranch branch) branch + inRepo $ updateBranch (syncBranch branch') branch' -- In direct mode, we're operating on some special direct mode -- branch, rather than the intended branch, so update the intended -- branch. whenM isDirect $ - inRepo $ updateBranch (fromDirectBranch branch) branch + inRepo $ updateBranch (fromDirectBranch branch') branch' updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO () updateBranch syncbranch updateto g = @@ -368,16 +375,16 @@ pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> need - The sync push will fail to overwrite if receive.denyNonFastforwards is - set on the remote. -} -pushBranch :: Remote -> Git.Ref -> Git.Repo -> IO Bool +pushBranch :: Remote -> Git.Branch -> Git.Repo -> IO Bool pushBranch remote branch g = tryIO (directpush g) `after` syncpush g where syncpush = Git.Command.runBool $ pushparams [ Git.Branch.forcePush $ refspec Annex.Branch.name - , refspec branch + , refspec $ fromAdjustedBranch branch ] directpush = Git.Command.runQuiet $ pushparams [ Git.fromRef $ Git.Ref.base $ Annex.Branch.name - , Git.fromRef $ Git.Ref.base $ fromDirectBranch branch + , Git.fromRef $ Git.Ref.base $ fromDirectBranch $ fromAdjustedBranch branch ] pushparams branches = [ Param "push" From 91f37673df5bbdb7319e6970c574e50befc53124 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 14:17:37 -0400 Subject: [PATCH 18/54] can't checkout adjusted branch while index is still locked There's a race here, but entering an adjusted branch for the first time is not something to do when a commit is being made at the same time. Although, may want to prevent the assistant from committing while entering the adjusted branch. --- Annex/AdjustedBranch.hs | 4 ++-- doc/design/adjusted_branches.mdwn | 9 +++++++++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index cea138f55b..5762c6b300 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -91,8 +91,8 @@ originalBranch = fmap fromAdjustedBranch <$> inRepo Git.Branch.current enterAdjustedBranch :: Adjustment -> Annex () enterAdjustedBranch adj = go =<< originalBranch where - go (Just origbranch) = preventCommits $ do - adjbranch <- adjustBranch adj origbranch + go (Just origbranch) = do + adjbranch <- preventCommits $ adjustBranch adj origbranch inRepo $ Git.Command.run [ Param "checkout" , Param $ fromRef $ Git.Ref.base $ adjbranch diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index f98bff00b2..9213158f40 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -342,3 +342,12 @@ like this, at its most simple: -- Generate a version of the commit made on the filter branch -- with the filtering of modified files reversed. unfilteredCommit :: Filter -> Git.Commit -> Git.Commit + +## TODOs + +* Need a better command-line interface than `git annex adjust`, + that allows picking adjustments. +* Interface in webapp to enable adjustments. +* Entering an adjusted branch can race with commits to the current branch, + and so the assistant should not be running, or at least should have + commits disabled when entering it. From cf24e9b892221f6c0b2fec3da9fd2ec2afb188df Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 16:19:09 -0400 Subject: [PATCH 19/54] working toward adjusted commit propigation --- Annex/AdjustedBranch.hs | 109 ++++++++++++++++++++++++------ Command/Sync.hs | 15 ++-- Git/Branch.hs | 18 +++-- doc/design/adjusted_branches.mdwn | 2 + 4 files changed, 112 insertions(+), 32 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 5762c6b300..30d4e7c093 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -9,6 +9,7 @@ module Annex.AdjustedBranch ( Adjustment(..), OrigBranch, AdjBranch, + originalToAdjusted, adjustedToOriginal, fromAdjustedBranch, enterAdjustedBranch, @@ -18,13 +19,16 @@ module Annex.AdjustedBranch ( import Annex.Common import qualified Annex +import Git import Git.Types import qualified Git.Branch import qualified Git.Ref import qualified Git.Command -import Git.Tree +import qualified Git.Tree +import Git.Tree (TreeItem(..)) import Git.Env import Git.Index +import Git.FilePath import qualified Git.LockFile import Annex.CatFile import Annex.Link @@ -35,8 +39,10 @@ import qualified Database.Keys data Adjustment = UnlockAdjustment deriving (Show) -adjustTreeItem :: Adjustment -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) -adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s) +data Direction = Forward | Reverse + +adjustTreeItem :: Adjustment -> Direction -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) +adjustTreeItem UnlockAdjustment Forward h ti@(TreeItem f m s) | toBlobType m == Just SymlinkBlob = do mk <- catKey s case mk of @@ -46,6 +52,20 @@ adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s) <$> hashPointerFile' h k Nothing -> return (Just ti) | otherwise = return (Just ti) +adjustTreeItem UnlockAdjustment Reverse h ti@(TreeItem f m s) + -- XXX does not remember when files were originally unlocked; locks + -- everything + | toBlobType m /= Just SymlinkBlob = do + mk <- catKey s + case mk of + Just k -> do + absf <- inRepo $ \r -> absPath $ + repoPath r <> fromTopFilePath f r + linktarget <- calcRepo $ gitAnnexLink absf k + Just . TreeItem f (fromBlobType SymlinkBlob) + <$> hashSymlink' h linktarget + Nothing -> return (Just ti) + | otherwise = return (Just ti) type OrigBranch = Branch type AdjBranch = Branch @@ -92,28 +112,34 @@ enterAdjustedBranch :: Adjustment -> Annex () enterAdjustedBranch adj = go =<< originalBranch where go (Just origbranch) = do - adjbranch <- preventCommits $ adjustBranch adj origbranch + adjbranch <- preventCommits $ adjustBranch adj Forward origbranch inRepo $ Git.Command.run [ Param "checkout" , Param $ fromRef $ Git.Ref.base $ adjbranch ] go Nothing = error "not on any branch!" -adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch -adjustBranch adj origbranch = do - sha <- adjust adj origbranch +adjustBranch :: Adjustment -> Direction -> OrigBranch -> Annex AdjBranch +adjustBranch adj direction origbranch = do + sha <- adjust adj direction origbranch inRepo $ Git.Branch.update adjbranch sha return adjbranch where adjbranch = originalToAdjusted origbranch adj -adjust :: Adjustment -> Ref -> Annex Sha -adjust adj orig = do - h <- inRepo hashObjectStart - treesha <- adjustTree (adjustTreeItem adj h) orig =<< Annex.gitRepo - liftIO $ hashObjectStop h +adjust :: Adjustment -> Direction -> Ref -> Annex Sha +adjust adj direction orig = do + treesha <- adjustTree adj direction orig commitAdjustedTree treesha orig +adjustTree :: Adjustment -> Direction -> Ref -> Annex Sha +adjustTree adj direction orig = do + h <- inRepo hashObjectStart + treesha <- Git.Tree.adjustTree (adjustTreeItem adj direction h) orig + =<< Annex.gitRepo + liftIO $ hashObjectStop h + return treesha + {- Locks git's index file, preventing git from making a commit, merge, - or otherwise changing the HEAD ref while the action is run. - @@ -141,8 +167,11 @@ commitAdjustedTree treesha parent = go =<< catCommit parent (commitAuthorMetaData parentcommit) (commitCommitterMetaData parentcommit) mkcommit - mkcommit = Git.Branch.commitTree - Git.Branch.AutomaticCommit "adjusted branch" [parent] treesha + mkcommit = Git.Branch.commitTree Git.Branch.AutomaticCommit + adjustedBranchCommitMessage [parent] treesha + +adjustedBranchCommitMessage :: String +adjustedBranchCommitMessage = "git-annex adjusted branch" {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} @@ -154,8 +183,8 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = where go (Just mergesha, Just currbranch) = ifM (inRepo $ Git.Branch.changed currbranch mergesha) ( do - propigateAdjustedCommits origbranch adj - adjustedtomerge <- adjust adj mergesha + propigateAdjustedCommits origbranch (adj, currbranch) + adjustedtomerge <- adjust adj Forward mergesha ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) ( ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) ( recommit currbranch mergesha =<< catCommit currbranch @@ -176,11 +205,51 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = recommit currbranch parent (Just commit) = do commitsha <- commitAdjustedTree (commitTree commit) parent inRepo $ Git.Branch.update currbranch commitsha - propigateAdjustedCommits origbranch adj + propigateAdjustedCommits origbranch (adj, currbranch) return True recommit _ _ Nothing = return False {- Check for any commits present on the adjusted branch that have not yet - - been propigated to the orig branch, and propigate them. -} -propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex () -propigateAdjustedCommits originbranch adj = return () -- TODO + - been propigated to the orig branch, and propigate them. + - + - After propigating the commits back to the orig banch, + - rebase the adjusted branch on top of the updated orig branch. + -} +propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () +propigateAdjustedCommits origbranch (adj, currbranch) = do + v <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads/" origbranch) + case v of + Just origsha -> go origsha False =<< newcommits + Nothing -> return () + where + newcommits = inRepo $ Git.Branch.changedCommits origbranch currbranch + -- Get commits oldest first, so they can be processed + -- in order made. + [Param "--reverse"] + go newhead _ [] = do + inRepo $ Git.Branch.update origbranch newhead + -- TODO rebase adjusted branch + go parent pastadjcommit (sha:l) = do + mc <- catCommit sha + case mc of + Just c + | commitMessage c == adjustedBranchCommitMessage -> + go parent True l + | pastadjcommit -> do + commit <- reverseAdjustedCommit parent adj c + go commit pastadjcommit l + _ -> go parent pastadjcommit l + +{- Reverses an adjusted commit, yielding a commit sha. + - + - Note that the commit message, and the author and committer metadata are + - copied over. However, any gpg signature will be lost, and any other + - headers are not copied either. -} +reverseAdjustedCommit :: Sha -> Adjustment -> Commit -> Annex Sha +reverseAdjustedCommit parent adj c = do + treesha <- adjustTree adj Reverse (commitTree c) + inRepo $ commitWithMetaData + (commitAuthorMetaData c) + (commitCommitterMetaData c) $ + Git.Branch.commitTree Git.Branch.AutomaticCommit + (commitMessage c) [parent] treesha diff --git a/Command/Sync.hs b/Command/Sync.hs index 355f71d1d0..e6a8373cee 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -267,21 +267,20 @@ pushLocal b = do updateSyncBranch :: CurrBranch -> Annex () updateSyncBranch (Nothing, _) = noop -updateSyncBranch (Just branch, _) = do +updateSyncBranch (Just branch, madj) = do -- When in an adjusted branch, propigate any changes to it back to -- the original branch. - branch' <- case adjustedToOriginal branch of - Just (adj, origbranch) -> do - propigateAdjustedCommits origbranch adj - return origbranch - Nothing -> return branch + case madj of + Just adj -> propigateAdjustedCommits branch + (adj, originalToAdjusted branch adj) + Nothing -> return () -- Update the sync branch to match the new state of the branch - inRepo $ updateBranch (syncBranch branch') branch' + inRepo $ updateBranch (syncBranch branch) branch -- In direct mode, we're operating on some special direct mode -- branch, rather than the intended branch, so update the intended -- branch. whenM isDirect $ - inRepo $ updateBranch (fromDirectBranch branch') branch' + inRepo $ updateBranch (fromDirectBranch branch) branch updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO () updateBranch syncbranch updateto g = diff --git a/Git/Branch.hs b/Git/Branch.hs index ff209d44df..a0c15d1714 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -48,15 +48,25 @@ currentUnsafe r = parse . firstLine changed :: Branch -> Branch -> Repo -> IO Bool changed origbranch newbranch repo | origbranch == newbranch = return False - | otherwise = not . null <$> diffs + | otherwise = not . null + <$> changed' origbranch newbranch [Param "-n1"] repo where - diffs = pipeReadStrict + +changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String +changed' origbranch newbranch extraps repo = pipeReadStrict ps repo + where + ps = [ Param "log" , Param (fromRef origbranch ++ ".." ++ fromRef newbranch) - , Param "-n1" , Param "--pretty=%H" - ] repo + ] ++ extraps +{- Lists commits that are in the second branch and not in the first branch. -} +changedCommits :: Branch -> Branch -> [CommandParam] -> Repo -> IO [Sha] +changedCommits origbranch newbranch extraps repo = + catMaybes . map extractSha . lines + <$> changed' origbranch newbranch extraps repo + {- Check if it's possible to fast-forward from the old - ref to the new ref. - diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 9213158f40..63af169729 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -351,3 +351,5 @@ like this, at its most simple: * Entering an adjusted branch can race with commits to the current branch, and so the assistant should not be running, or at least should have commits disabled when entering it. +* When the adjusted branch unlocks files, behave as if annex.addunlocked is + set, so git annex add will add files unlocked. From 40509e20e54d78aa3bde3e5ad81311c78b7eb66c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 16:38:56 -0400 Subject: [PATCH 20/54] change name of adjusted branches to eg adjusted/master(unlocked) Using adjusted/unlocked/master made lots of git stuff dealing with "master" complain that it was ambiguous. This new appoach is more like view branch names, and shows the adjustment right there in the branch display even if only the basename of the branch is shown. --- Annex/AdjustedBranch.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 30d4e7c093..6ba229b9c2 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -74,22 +74,24 @@ adjustedBranchPrefix :: String adjustedBranchPrefix = "refs/heads/adjusted/" serialize :: Adjustment -> String -serialize UnlockAdjustment = "unlock" +serialize UnlockAdjustment = "unlocked" deserialize :: String -> Maybe Adjustment -deserialize "unlock" = Just UnlockAdjustment +deserialize "unlocked" = Just UnlockAdjustment deserialize _ = Nothing originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch -originalToAdjusted orig adj = Git.Ref.under base orig +originalToAdjusted orig adj = Ref $ + adjustedBranchPrefix ++ base ++ '(' : serialize adj ++ ")" where - base = adjustedBranchPrefix ++ serialize adj + base = fromRef (Git.Ref.basename orig) adjustedToOriginal :: AdjBranch -> Maybe (Adjustment, OrigBranch) adjustedToOriginal b | adjustedBranchPrefix `isPrefixOf` bs = do - adj <- deserialize (takeWhile (/= '/') (drop prefixlen bs)) - Just (adj, Git.Ref.basename b) + let (base, as) = separate (== '(') (drop prefixlen bs) + adj <- deserialize (takeWhile (/= ')') as) + Just (adj, Git.Ref.under "refs/heads" (Ref base)) | otherwise = Nothing where bs = fromRef b @@ -217,7 +219,7 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = -} propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () propigateAdjustedCommits origbranch (adj, currbranch) = do - v <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads/" origbranch) + v <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch) case v of Just origsha -> go origsha False =<< newcommits Nothing -> return () From ac08f6580ec10ab6708d1d7e3e9d7ff86a17437a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 16:47:51 -0400 Subject: [PATCH 21/54] fix abs filepath generation --- Annex/AdjustedBranch.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 6ba229b9c2..3c53ea9245 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -60,7 +60,7 @@ adjustTreeItem UnlockAdjustment Reverse h ti@(TreeItem f m s) case mk of Just k -> do absf <- inRepo $ \r -> absPath $ - repoPath r <> fromTopFilePath f r + fromTopFilePath f r linktarget <- calcRepo $ gitAnnexLink absf k Just . TreeItem f (fromBlobType SymlinkBlob) <$> hashSymlink' h linktarget @@ -221,7 +221,8 @@ propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () propigateAdjustedCommits origbranch (adj, currbranch) = do v <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch) case v of - Just origsha -> go origsha False =<< newcommits + Just origsha -> preventCommits $ + go origsha False =<< newcommits Nothing -> return () where newcommits = inRepo $ Git.Branch.changedCommits origbranch currbranch From 5e3f707c34d1b1f073593b63d5ffbd2084805eb4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Mar 2016 17:00:48 -0400 Subject: [PATCH 22/54] rebase on top of updated original branch --- Annex/AdjustedBranch.hs | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 3c53ea9245..208b976cda 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -219,19 +219,25 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = -} propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () propigateAdjustedCommits origbranch (adj, currbranch) = do - v <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch) - case v of - Just origsha -> preventCommits $ - go origsha False =<< newcommits + ov <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch) + case ov of + Just origsha -> preventCommits $ do + cv <- catCommit currbranch + case cv of + Just currcommit -> + newcommits + >>= go origsha False + >>= rebase currcommit + Nothing -> return () Nothing -> return () where newcommits = inRepo $ Git.Branch.changedCommits origbranch currbranch -- Get commits oldest first, so they can be processed -- in order made. [Param "--reverse"] - go newhead _ [] = do - inRepo $ Git.Branch.update origbranch newhead - -- TODO rebase adjusted branch + go parent _ [] = do + inRepo $ Git.Branch.update origbranch parent + return parent go parent pastadjcommit (sha:l) = do mc <- catCommit sha case mc of @@ -242,6 +248,12 @@ propigateAdjustedCommits origbranch (adj, currbranch) = do commit <- reverseAdjustedCommit parent adj c go commit pastadjcommit l _ -> go parent pastadjcommit l + rebase currcommit newparent = do + -- Reuse the current adjusted tree, + -- and reparent it on top of the new + -- version of the origbranch. + commitAdjustedTree (commitTree currcommit) newparent + >>= inRepo . Git.Branch.update currbranch {- Reverses an adjusted commit, yielding a commit sha. - From fbf4d89e8285e6f92ef2f752f7f87f81c3c70033 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 12:47:14 -0400 Subject: [PATCH 23/54] extract commit parent(s) --- Git/CatFile.hs | 8 +++++--- Git/Types.hs | 1 + 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/Git/CatFile.hs b/Git/CatFile.hs index 455f192a02..d6f7707bca 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -125,15 +125,17 @@ catCommit h commitref = go <$> catObjectDetails h commitref parseCommit :: L.ByteString -> Maybe Commit parseCommit b = Commit <$> (extractSha . L8.unpack =<< field "tree") + <*> (mapMaybe (extractSha . L8.unpack) <$> fields "parent") <*> (parsemetadata <$> field "author") <*> (parsemetadata <$> field "committer") <*> Just (L8.unpack $ L.intercalate (L.singleton nl) message) where - field n = M.lookup (fromString n) fields - fields = M.fromList ((map breakfield) header) + field n = headMaybe =<< fields n + fields n = M.lookup (fromString n) fieldmap + fieldmap = M.fromListWith (++) ((map breakfield) header) breakfield l = let (k, sp_v) = L.break (== sp) l - in (k, L.drop 1 sp_v) + in (k, [L.drop 1 sp_v]) (header, message) = separate L.null ls ls = L.split nl b diff --git a/Git/Types.hs b/Git/Types.hs index 4fa49be5c0..44135738da 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -105,6 +105,7 @@ fromBlobType SymlinkBlob = 0o120000 data Commit = Commit { commitTree :: Sha + , commitParent :: [Sha] , commitAuthorMetaData :: CommitMetaData , commitCommitterMetaData :: CommitMetaData , commitMessage :: String From 8d124beba83d2192d64e2a9271c390f94e505da5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 13:15:49 -0400 Subject: [PATCH 24/54] add commitDiff, and clean up partial function --- Git/DiffTree.hs | 41 +++++++++++++++++++++++++---------------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs index 8381148726..0dac607e5c 100644 --- a/Git/DiffTree.hs +++ b/Git/DiffTree.hs @@ -14,6 +14,7 @@ module Git.DiffTree ( diffWorkTree, diffFiles, diffLog, + commitDiff, ) where import Numeric @@ -72,16 +73,23 @@ diffFiles :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool) diffFiles = getdiff (Param "diff-files") {- Runs git log in --raw mode to get the changes that were made in - - a particular commit. The output format is adjusted to be the same - - as diff-tree --raw._-} + - a particular commit to particular files. The output format + - is adjusted to be the same as diff-tree --raw._-} diffLog :: [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool) diffLog params = getdiff (Param "log") (Param "-n1" : Param "--abbrev=40" : Param "--pretty=format:" : params) +{- Uses git show to get the changes made by a commit. + - + - Does not support merge commits, and will fail on them. -} +commitDiff :: Sha -> Repo -> IO ([DiffTreeItem], IO Bool) +commitDiff ref = getdiff (Param "show") + [ Param "--abbrev=40", Param "--pretty=", Param "--raw", Param (fromRef ref) ] + getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool) getdiff command params repo = do (diff, cleanup) <- pipeNullSplit ps repo - return (parseDiffRaw diff, cleanup) + return (fromMaybe (error $ "git " ++ show (toCommand ps) ++ " parse failed") (parseDiffRaw diff), cleanup) where ps = command : @@ -92,23 +100,24 @@ getdiff command params repo = do params {- Parses --raw output used by diff-tree and git-log. -} -parseDiffRaw :: [String] -> [DiffTreeItem] +parseDiffRaw :: [String] -> Maybe [DiffTreeItem] parseDiffRaw l = go l [] where - go [] c = c - go (info:f:rest) c = go rest (mk info f : c) - go (s:[]) _ = error $ "diff-tree parse error " ++ s + go [] c = Just c + go (info:f:rest) c = case mk info f of + Nothing -> Nothing + Just i -> go rest (i:c) + go (s:[]) _ = Nothing - mk info f = DiffTreeItem - { srcmode = readmode srcm - , dstmode = readmode dstm - , srcsha = fromMaybe (error "bad srcsha") $ extractSha ssha - , dstsha = fromMaybe (error "bad dstsha") $ extractSha dsha - , status = s - , file = asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f - } + mk info f = DiffTreeItem + <$> readmode srcm + <*> readmode dstm + <*> extractSha ssha + <*> extractSha dsha + <*> pure s + <*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f) where - readmode = fst . Prelude.head . readOct + readmode = fst <$$> headMaybe . readOct -- info = : SP SP SP SP -- All fields are fixed, so we can pull them out of From fed8fcb99f66039545ac06503999044d769dcfa3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 14:08:06 -0400 Subject: [PATCH 25/54] allow adding new items via adjustTree --- Git/Tree.hs | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) diff --git a/Git/Tree.hs b/Git/Tree.hs index 5cc72ec8ae..1c878f2d6d 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -109,15 +109,19 @@ mkTreeOutput fm ot s f = concat data TreeItem = TreeItem TopFilePath FileMode Sha deriving (Eq) +treeItemToTreeContent :: TreeItem -> TreeContent +treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s + {- Applies an adjustment to items in a tree. + - Can also add new items to the tree. - - While less flexible than using getTree and recordTree, this avoids - buffering the whole tree in memory. -} -adjustTree :: (MonadIO m, MonadMask m) => (TreeItem -> m (Maybe TreeItem)) -> Ref -> Repo -> m Sha -adjustTree adjust r repo = withMkTreeHandle repo $ \h -> do +adjustTree :: (MonadIO m, MonadMask m) => (TreeItem -> m (Maybe TreeItem)) -> [TreeItem] -> Ref -> Repo -> m Sha +adjustTree adjusttreeitem addtreeitems r repo = withMkTreeHandle repo $ \h -> do (l, cleanup) <- liftIO $ lsTreeWithObjects r repo - (l', _, _) <- go h False [] topTree l + (l', _, _) <- go h False [] inTopTree l sha <- liftIO $ mkTree h l' void $ liftIO cleanup return sha @@ -128,7 +132,7 @@ adjustTree adjust r repo = withMkTreeHandle repo $ \h -> do case readObjectType (LsTree.typeobj i) of Just BlobObject -> do let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i) - v <- adjust ti + v <- adjusttreeitem ti case v of Nothing -> go h True c intree is Just ti'@(TreeItem f m s) -> @@ -136,9 +140,11 @@ adjustTree adjust r repo = withMkTreeHandle repo $ \h -> do blob = TreeBlob f m s in go h modified (blob:c) intree is Just TreeObject -> do - (sl, modified, is') <- go h False [] (subTree i) is - subtree <- if modified - then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl + (sl, modified, is') <- go h False [] (beneathSubTree i) is + let added = filter (inSubTree i) addtreeitems + subtree <- if modified || not (null added) + then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) + (map treeItemToTreeContent added ++ sl) else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] let !modified' = modified || wasmodified go h modified' (subtree : c) intree is' @@ -148,7 +154,7 @@ adjustTree adjust r repo = withMkTreeHandle repo $ \h -> do {- Assumes the list is ordered, with tree objects coming right before their - contents. -} extractTree :: [LsTree.TreeItem] -> Either String Tree -extractTree l = case go [] topTree l of +extractTree l = case go [] inTopTree l of Right (t, []) -> Right (Tree t) Right _ -> parseerr "unexpected tree form" Left e -> parseerr e @@ -160,7 +166,7 @@ extractTree l = case go [] topTree l of Just BlobObject -> let b = TreeBlob (LsTree.file i) (LsTree.mode i) (LsTree.sha i) in go (b:t) intree is - Just TreeObject -> case go [] (subTree i) is of + Just TreeObject -> case go [] (beneathSubTree i) is of Right (subtree, is') -> let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree in go (st:t) intree is' @@ -171,10 +177,13 @@ extractTree l = case go [] topTree l of type InTree = LsTree.TreeItem -> Bool -topTree :: InTree -topTree = notElem '/' . getTopFilePath . LsTree.file +inTopTree :: InTree +inTopTree = notElem '/' . getTopFilePath . LsTree.file -subTree :: LsTree.TreeItem -> InTree -subTree t = +beneathSubTree :: LsTree.TreeItem -> InTree +beneathSubTree t = let prefix = getTopFilePath (LsTree.file t) ++ "/" in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i)) + +inSubTree :: LsTree.TreeItem -> TreeItem -> Bool +inSubTree t (TreeItem f _ _) = takeDirectory (getTopFilePath f) == takeDirectory (getTopFilePath (LsTree.file t)) From ec8eba18ad9481c8941eadb529aa938a64dafb9a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 14:33:38 -0400 Subject: [PATCH 26/54] fix warning --- Git/DiffTree.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs index 0dac607e5c..645d18d35d 100644 --- a/Git/DiffTree.hs +++ b/Git/DiffTree.hs @@ -107,7 +107,7 @@ parseDiffRaw l = go l [] go (info:f:rest) c = case mk info f of Nothing -> Nothing Just i -> go rest (i:c) - go (s:[]) _ = Nothing + go (_:[]) _ = Nothing mk info f = DiffTreeItem <$> readmode srcm From 3c4ad3eecac4ddb725a4ff743f32a63c9d787e80 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 14:46:54 -0400 Subject: [PATCH 27/54] indent --- Git/Tree.hs | 66 ++++++++++++++++++++++++++--------------------------- 1 file changed, 32 insertions(+), 34 deletions(-) diff --git a/Git/Tree.hs b/Git/Tree.hs index 1c878f2d6d..9515dfc8b8 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -128,27 +128,26 @@ adjustTree adjusttreeitem addtreeitems r repo = withMkTreeHandle repo $ \h -> do where go _ wasmodified c _ [] = return (c, wasmodified, []) go h wasmodified c intree (i:is) - | intree i = - case readObjectType (LsTree.typeobj i) of - Just BlobObject -> do - let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i) - v <- adjusttreeitem ti - case v of - Nothing -> go h True c intree is - Just ti'@(TreeItem f m s) -> - let !modified = wasmodified || ti' /= ti - blob = TreeBlob f m s - in go h modified (blob:c) intree is - Just TreeObject -> do - (sl, modified, is') <- go h False [] (beneathSubTree i) is - let added = filter (inSubTree i) addtreeitems - subtree <- if modified || not (null added) - then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) - (map treeItemToTreeContent added ++ sl) - else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] - let !modified' = modified || wasmodified - go h modified' (subtree : c) intree is' - _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") + | intree i = case readObjectType (LsTree.typeobj i) of + Just BlobObject -> do + let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i) + v <- adjusttreeitem ti + case v of + Nothing -> go h True c intree is + Just ti'@(TreeItem f m s) -> + let !modified = wasmodified || ti' /= ti + blob = TreeBlob f m s + in go h modified (blob:c) intree is + Just TreeObject -> do + (sl, modified, is') <- go h False [] (beneathSubTree i) is + let added = filter (inTree i) addtreeitems + subtree <- if modified || not (null added) + then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) + (map treeItemToTreeContent added ++ sl) + else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] + let !modified' = modified || wasmodified + go h modified' (subtree : c) intree is' + _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") | otherwise = return (c, wasmodified, i:is) {- Assumes the list is ordered, with tree objects coming right before their @@ -161,17 +160,16 @@ extractTree l = case go [] inTopTree l of where go t _ [] = Right (t, []) go t intree (i:is) - | intree i = - case readObjectType (LsTree.typeobj i) of - Just BlobObject -> - let b = TreeBlob (LsTree.file i) (LsTree.mode i) (LsTree.sha i) - in go (b:t) intree is - Just TreeObject -> case go [] (beneathSubTree i) is of - Right (subtree, is') -> - let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree - in go (st:t) intree is' - Left e -> Left e - _ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") + | intree i = case readObjectType (LsTree.typeobj i) of + Just BlobObject -> + let b = TreeBlob (LsTree.file i) (LsTree.mode i) (LsTree.sha i) + in go (b:t) intree is + Just TreeObject -> case go [] (beneathSubTree i) is of + Right (subtree, is') -> + let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree + in go (st:t) intree is' + Left e -> Left e + _ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") | otherwise = Right (t, i:is) parseerr = Left @@ -185,5 +183,5 @@ beneathSubTree t = let prefix = getTopFilePath (LsTree.file t) ++ "/" in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i)) -inSubTree :: LsTree.TreeItem -> TreeItem -> Bool -inSubTree t (TreeItem f _ _) = takeDirectory (getTopFilePath f) == takeDirectory (getTopFilePath (LsTree.file t)) +inTree :: LsTree.TreeItem -> TreeItem -> Bool +inTree t (TreeItem f _ _) = takeDirectory (getTopFilePath f) == takeDirectory (getTopFilePath (LsTree.file t)) From b9184f69a7ca5f5a37f482a2e41af874e14ad66c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 16:00:14 -0400 Subject: [PATCH 28/54] improve propigation of commits from adjusted branches Only reverse adjust the changes in the commit, which means that adjustments do not need to be generally cleanly reversable. For example, an adjustment can unlock all locked files, but does not need to worry about files that were originally unlocked when reversing, because it will only ever be run on files that have been changed. So, it's ok if it locks all files when reversed, or even leaves all files as-is when reversed. --- Annex/AdjustedBranch.hs | 150 ++++++++++++++++++++---------- Git/FilePath.hs | 2 +- Git/Tree.hs | 10 +- doc/design/adjusted_branches.mdwn | 2 +- 4 files changed, 110 insertions(+), 54 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 208b976cda..ce565a7546 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -1,4 +1,4 @@ -{- adjusted version of main branch +{- adjusted branch - - Copyright 2016 Joey Hess - @@ -25,7 +25,9 @@ import qualified Git.Branch import qualified Git.Ref import qualified Git.Command import qualified Git.Tree +import qualified Git.DiffTree import Git.Tree (TreeItem(..)) +import Git.Sha import Git.Env import Git.Index import Git.FilePath @@ -36,11 +38,14 @@ import Git.HashObject import Annex.AutoMerge import qualified Database.Keys +import qualified Data.Map as M + data Adjustment = UnlockAdjustment deriving (Show) data Direction = Forward | Reverse +{- How to perform various adjustments to a TreeItem. -} adjustTreeItem :: Adjustment -> Direction -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) adjustTreeItem UnlockAdjustment Forward h ti@(TreeItem f m s) | toBlobType m == Just SymlinkBlob = do @@ -53,8 +58,6 @@ adjustTreeItem UnlockAdjustment Forward h ti@(TreeItem f m s) Nothing -> return (Just ti) | otherwise = return (Just ti) adjustTreeItem UnlockAdjustment Reverse h ti@(TreeItem f m s) - -- XXX does not remember when files were originally unlocked; locks - -- everything | toBlobType m /= Just SymlinkBlob = do mk <- catKey s case mk of @@ -114,7 +117,8 @@ enterAdjustedBranch :: Adjustment -> Annex () enterAdjustedBranch adj = go =<< originalBranch where go (Just origbranch) = do - adjbranch <- preventCommits $ adjustBranch adj Forward origbranch + adjbranch <- preventCommits $ const $ + adjustBranch adj Forward origbranch inRepo $ Git.Command.run [ Param "checkout" , Param $ fromRef $ Git.Ref.base $ adjbranch @@ -137,23 +141,25 @@ adjust adj direction orig = do adjustTree :: Adjustment -> Direction -> Ref -> Annex Sha adjustTree adj direction orig = do h <- inRepo hashObjectStart - treesha <- Git.Tree.adjustTree (adjustTreeItem adj direction h) orig - =<< Annex.gitRepo + let toadj = adjustTreeItem adj direction h + treesha <- Git.Tree.adjustTree toadj [] orig =<< Annex.gitRepo liftIO $ hashObjectStop h return treesha +type CommitsPrevented = Git.LockFile.LockHandle + {- Locks git's index file, preventing git from making a commit, merge, - or otherwise changing the HEAD ref while the action is run. - - Throws an IO exception if the index file is already locked. -} -preventCommits :: Annex a -> Annex a -preventCommits = bracket setup cleanup . const +preventCommits :: (CommitsPrevented -> Annex a) -> Annex a +preventCommits = bracket setup cleanup where setup = do lck <- fromRepo indexFileLock liftIO $ Git.LockFile.openLock lck - cleanup lckhandle = liftIO $ Git.LockFile.closeLock lckhandle + cleanup = liftIO . Git.LockFile.closeLock {- Commits a given adjusted tree, with the provided parent ref. - @@ -178,25 +184,29 @@ adjustedBranchCommitMessage = "git-annex adjusted branch" {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool -updateAdjustedBranch tomerge (origbranch, adj) commitmode = - catchBoolIO $ preventCommits $ go =<< (,) +updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ do + preventCommits $ \commitsprevented -> go commitsprevented =<< (,) <$> inRepo (Git.Ref.sha tomerge) <*> inRepo Git.Branch.current where - go (Just mergesha, Just currbranch) = ifM (inRepo $ Git.Branch.changed currbranch mergesha) - ( do - propigateAdjustedCommits origbranch (adj, currbranch) - adjustedtomerge <- adjust adj Forward mergesha - ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) - ( ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) - ( recommit currbranch mergesha =<< catCommit currbranch - , return False + go commitsprevented (Just mergesha, Just currbranch) = + ifM (inRepo $ Git.Branch.changed currbranch mergesha) + ( do + propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented + adjustedtomerge <- adjust adj Forward mergesha + ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) + ( do + liftIO $ Git.LockFile.closeLock commitsprevented + ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) + ( preventCommits $ \commitsprevented' -> + recommit commitsprevented' currbranch mergesha =<< catCommit currbranch + , return False + ) + , return True -- no changes to merge ) - , return True -- no changes to merge - ) - , return True -- no changes to merge - ) - go _ = return False + , return True -- no changes to merge + ) + go _ _ = return False {- Once a merge commit has been made, re-do it, removing - the old version of the adjusted branch as a parent, and - making the only parent be the branch that was merged in. @@ -204,12 +214,12 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = - Doing this ensures that the same commit Sha is - always arrived at for a given commit from the merged in branch. -} - recommit currbranch parent (Just commit) = do + recommit commitsprevented currbranch parent (Just commit) = do commitsha <- commitAdjustedTree (commitTree commit) parent inRepo $ Git.Branch.update currbranch commitsha - propigateAdjustedCommits origbranch (adj, currbranch) + propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented return True - recommit _ _ Nothing = return False + recommit _ _ _ Nothing = return False {- Check for any commits present on the adjusted branch that have not yet - been propigated to the orig branch, and propigate them. @@ -218,16 +228,26 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = - rebase the adjusted branch on top of the updated orig branch. -} propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () -propigateAdjustedCommits origbranch (adj, currbranch) = do +propigateAdjustedCommits origbranch (adj, currbranch) = + preventCommits $ propigateAdjustedCommits' origbranch (adj, currbranch) + +propigateAdjustedCommits' :: OrigBranch -> (Adjustment, AdjBranch) -> CommitsPrevented -> Annex () +propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do ov <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch) case ov of - Just origsha -> preventCommits $ do + Just origsha -> do cv <- catCommit currbranch case cv of - Just currcommit -> - newcommits - >>= go origsha False - >>= rebase currcommit + Just currcommit -> do + h <- inRepo hashObjectStart + v <- newcommits >>= go h origsha False + liftIO $ hashObjectStop h + case v of + Left e -> do + warning e + return () + Right newparent -> + rebase currcommit newparent Nothing -> return () Nothing -> return () where @@ -235,19 +255,21 @@ propigateAdjustedCommits origbranch (adj, currbranch) = do -- Get commits oldest first, so they can be processed -- in order made. [Param "--reverse"] - go parent _ [] = do + go _ parent _ [] = do inRepo $ Git.Branch.update origbranch parent - return parent - go parent pastadjcommit (sha:l) = do + return (Right parent) + go h parent pastadjcommit (sha:l) = do mc <- catCommit sha case mc of Just c | commitMessage c == adjustedBranchCommitMessage -> - go parent True l + go h parent True l | pastadjcommit -> do - commit <- reverseAdjustedCommit parent adj c - go commit pastadjcommit l - _ -> go parent pastadjcommit l + v <- reverseAdjustedCommit h parent adj (sha, c) origbranch + case v of + Left e -> return (Left e) + Right commit -> go h commit pastadjcommit l + _ -> go h parent pastadjcommit l rebase currcommit newparent = do -- Reuse the current adjusted tree, -- and reparent it on top of the new @@ -255,16 +277,46 @@ propigateAdjustedCommits origbranch (adj, currbranch) = do commitAdjustedTree (commitTree currcommit) newparent >>= inRepo . Git.Branch.update currbranch -{- Reverses an adjusted commit, yielding a commit sha. +{- Reverses an adjusted commit, and commit on top of the provided newparent, + - yielding a commit sha. + - + - Adjust the tree of the newparent, changing only the files that the + - commit changed, and reverse adjusting those changes. - - Note that the commit message, and the author and committer metadata are - copied over. However, any gpg signature will be lost, and any other - headers are not copied either. -} -reverseAdjustedCommit :: Sha -> Adjustment -> Commit -> Annex Sha -reverseAdjustedCommit parent adj c = do - treesha <- adjustTree adj Reverse (commitTree c) - inRepo $ commitWithMetaData - (commitAuthorMetaData c) - (commitCommitterMetaData c) $ - Git.Branch.commitTree Git.Branch.AutomaticCommit - (commitMessage c) [parent] treesha +reverseAdjustedCommit :: HashObjectHandle -> Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha) +reverseAdjustedCommit h newparent adj (csha, c) origbranch + -- commitDiff does not support merge commits + | length (commitParent c) > 1 = return $ + Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch + | otherwise = do + (diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha) + let (adds, changes) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff + adds' <- catMaybes <$> + mapM (adjustTreeItem adj Reverse h) (map diffTreeToTreeItem adds) + treesha <- Git.Tree.adjustTree (propchanges changes) + adds' newparent + =<< Annex.gitRepo + void $ liftIO cleanup + revadjcommit <- inRepo $ commitWithMetaData + (commitAuthorMetaData c) + (commitCommitterMetaData c) $ + Git.Branch.commitTree Git.Branch.AutomaticCommit + (commitMessage c) [newparent] treesha + return (Right revadjcommit) + where + propchanges changes ti@(TreeItem f _ _) = + case M.lookup f m of + Nothing -> return (Just ti) -- not changed + Just change -> adjustTreeItem adj Reverse h change + where + m = M.fromList $ map (\i@(TreeItem f' _ _) -> (f', i)) $ + map diffTreeToTreeItem changes + +diffTreeToTreeItem :: Git.DiffTree.DiffTreeItem -> TreeItem +diffTreeToTreeItem dti = TreeItem + (Git.DiffTree.file dti) + (Git.DiffTree.dstmode dti) + (Git.DiffTree.dstsha dti) diff --git a/Git/FilePath.hs b/Git/FilePath.hs index 5af74c0675..db576fc8ea 100644 --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -31,7 +31,7 @@ import qualified System.FilePath.Posix {- A FilePath, relative to the top of the git repository. -} newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath } - deriving (Show, Eq) + deriving (Show, Eq, Ord) {- Path to a TopFilePath, within the provided git repo. -} fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath diff --git a/Git/Tree.hs b/Git/Tree.hs index 9515dfc8b8..7f28bcb6c1 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -107,7 +107,7 @@ mkTreeOutput fm ot s f = concat ] data TreeItem = TreeItem TopFilePath FileMode Sha - deriving (Eq) + deriving (Show, Eq) treeItemToTreeContent :: TreeItem -> TreeContent treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s @@ -122,7 +122,7 @@ adjustTree :: (MonadIO m, MonadMask m) => (TreeItem -> m (Maybe TreeItem)) -> [T adjustTree adjusttreeitem addtreeitems r repo = withMkTreeHandle repo $ \h -> do (l, cleanup) <- liftIO $ lsTreeWithObjects r repo (l', _, _) <- go h False [] inTopTree l - sha <- liftIO $ mkTree h l' + sha <- liftIO $ mkTree h (map treeItemToTreeContent addedtotop ++ l') void $ liftIO cleanup return sha where @@ -149,6 +149,7 @@ adjustTree adjusttreeitem addtreeitems r repo = withMkTreeHandle repo $ \h -> do go h modified' (subtree : c) intree is' _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") | otherwise = return (c, wasmodified, i:is) + addedtotop = filter (\(TreeItem f _ _) -> inTopTree' f) addtreeitems {- Assumes the list is ordered, with tree objects coming right before their - contents. -} @@ -176,7 +177,10 @@ extractTree l = case go [] inTopTree l of type InTree = LsTree.TreeItem -> Bool inTopTree :: InTree -inTopTree = notElem '/' . getTopFilePath . LsTree.file +inTopTree = inTopTree' . LsTree.file + +inTopTree' :: TopFilePath -> Bool +inTopTree' f = takeDirectory (getTopFilePath f) == "." beneathSubTree :: LsTree.TreeItem -> InTree beneathSubTree t = diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index a031fef92a..7216fcbc4a 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -67,7 +67,7 @@ and updates the branches. And/or `git-annex sync` could do it. There may be multiple commits made to the adjusted branch before any get applied back to the original branch. This is handled by reverse filtering -one at a time and rebasing the others on top. +commits one at a time and rebasing the others on top. master adjusted/master A From ba1ef156a28894be502504e5bf75f7eb4cdd4ddf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 16:30:06 -0400 Subject: [PATCH 29/54] fix deletion of files in adjustTree --- Annex/AdjustedBranch.hs | 12 ++++++---- Git/Tree.hs | 49 +++++++++++++++++++++++++++++------------ 2 files changed, 43 insertions(+), 18 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index ce565a7546..030bdb99e8 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -142,7 +142,7 @@ adjustTree :: Adjustment -> Direction -> Ref -> Annex Sha adjustTree adj direction orig = do h <- inRepo hashObjectStart let toadj = adjustTreeItem adj direction h - treesha <- Git.Tree.adjustTree toadj [] orig =<< Annex.gitRepo + treesha <- Git.Tree.adjustTree toadj [] [] orig =<< Annex.gitRepo liftIO $ hashObjectStop h return treesha @@ -293,11 +293,15 @@ reverseAdjustedCommit h newparent adj (csha, c) origbranch Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch | otherwise = do (diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha) - let (adds, changes) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff + let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff + let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others adds' <- catMaybes <$> mapM (adjustTreeItem adj Reverse h) (map diffTreeToTreeItem adds) - treesha <- Git.Tree.adjustTree (propchanges changes) - adds' newparent + treesha <- Git.Tree.adjustTree + (propchanges changes) + adds' + (map Git.DiffTree.file removes) + newparent =<< Annex.gitRepo void $ liftIO cleanup revadjcommit <- inRepo $ commitWithMetaData diff --git a/Git/Tree.hs b/Git/Tree.hs index 7f28bcb6c1..91d81844ba 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -28,6 +28,7 @@ import qualified Utility.CoProcess as CoProcess import Numeric import System.Posix.Types import Control.Monad.IO.Class +import qualified Data.Set as S newtype Tree = Tree [TreeContent] deriving (Show) @@ -38,7 +39,7 @@ data TreeContent | RecordedSubTree TopFilePath Sha [TreeContent] -- A subtree that has not yet been recorded in git. | NewSubTree TopFilePath [TreeContent] - deriving (Show) + deriving (Show, Eq) {- Gets the Tree for a Ref. -} getTree :: Ref -> Repo -> IO Tree @@ -113,18 +114,31 @@ treeItemToTreeContent :: TreeItem -> TreeContent treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s {- Applies an adjustment to items in a tree. - - Can also add new items to the tree. - - While less flexible than using getTree and recordTree, this avoids - buffering the whole tree in memory. -} -adjustTree :: (MonadIO m, MonadMask m) => (TreeItem -> m (Maybe TreeItem)) -> [TreeItem] -> Ref -> Repo -> m Sha -adjustTree adjusttreeitem addtreeitems r repo = withMkTreeHandle repo $ \h -> do - (l, cleanup) <- liftIO $ lsTreeWithObjects r repo - (l', _, _) <- go h False [] inTopTree l - sha <- liftIO $ mkTree h (map treeItemToTreeContent addedtotop ++ l') - void $ liftIO cleanup - return sha +adjustTree + :: (MonadIO m, MonadMask m) + => (TreeItem -> m (Maybe TreeItem)) + -- ^ Adjust an item in the tree. Nothing deletes the item. + -- Cannot move the item to a different tree. + -> [TreeItem] + -- ^ New items to add to the tree. + -> [TopFilePath] + -- ^ Files to remove from the tree. + -> Ref + -> Repo + -> m Sha +adjustTree adjusttreeitem addtreeitems removefiles r repo = + withMkTreeHandle repo $ \h -> do + (l, cleanup) <- liftIO $ lsTreeWithObjects r repo + (l', _, _) <- go h False [] inTopTree l + sha <- liftIO $ mkTree h $ + filter (not . removed) $ + map treeItemToTreeContent (filter topitem addtreeitems) ++ l' + void $ liftIO cleanup + return sha where go _ wasmodified c _ [] = return (c, wasmodified, []) go h wasmodified c intree (i:is) @@ -141,15 +155,19 @@ adjustTree adjusttreeitem addtreeitems r repo = withMkTreeHandle repo $ \h -> do Just TreeObject -> do (sl, modified, is') <- go h False [] (beneathSubTree i) is let added = filter (inTree i) addtreeitems - subtree <- if modified || not (null added) - then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) - (map treeItemToTreeContent added ++ sl) + let sl' = map treeItemToTreeContent added ++ sl + let sl'' = filter (not . removed) sl' + subtree <- if modified || sl'' /= sl + then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl'' else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] let !modified' = modified || wasmodified go h modified' (subtree : c) intree is' _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") | otherwise = return (c, wasmodified, i:is) - addedtotop = filter (\(TreeItem f _ _) -> inTopTree' f) addtreeitems + topitem (TreeItem f _ _) = inTopTree' f + removeset = S.fromList removefiles + removed (TreeBlob f _ _) = S.member f removeset + removed _ = False {- Assumes the list is ordered, with tree objects coming right before their - contents. -} @@ -188,4 +206,7 @@ beneathSubTree t = in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i)) inTree :: LsTree.TreeItem -> TreeItem -> Bool -inTree t (TreeItem f _ _) = takeDirectory (getTopFilePath f) == takeDirectory (getTopFilePath (LsTree.file t)) +inTree = inTree' . LsTree.file + +inTree' :: TopFilePath -> TreeItem -> Bool +inTree' f (TreeItem f' _ _) = takeDirectory (getTopFilePath f') == takeDirectory (getTopFilePath f) From f3b9c48a0988f9b1202145d7349c7d6d89045923 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 16:37:11 -0400 Subject: [PATCH 30/54] fixme --- Git/Tree.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Git/Tree.hs b/Git/Tree.hs index 91d81844ba..1ed862869b 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -112,6 +112,11 @@ data TreeItem = TreeItem TopFilePath FileMode Sha treeItemToTreeContent :: TreeItem -> TreeContent treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s + +-- FIXME: When addtreeitems has an item in a new +-- subdirectory, no subtree contains it. We need to add a +-- new subtree in this case, but not in the case where the +-- subdirectory already exists in the tree. {- Applies an adjustment to items in a tree. - From ad0455005533aeb42b6c743e8826240d15895987 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 16:45:40 -0400 Subject: [PATCH 31/54] refactor --- Git/Tree.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/Git/Tree.hs b/Git/Tree.hs index 1ed862869b..3560c095ea 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -120,8 +120,8 @@ treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s {- Applies an adjustment to items in a tree. - - - While less flexible than using getTree and recordTree, this avoids - - buffering the whole tree in memory. + - While less flexible than using getTree and recordTree, + - this avoids buffering the whole tree in memory. -} adjustTree :: (MonadIO m, MonadMask m) @@ -139,9 +139,8 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo = withMkTreeHandle repo $ \h -> do (l, cleanup) <- liftIO $ lsTreeWithObjects r repo (l', _, _) <- go h False [] inTopTree l - sha <- liftIO $ mkTree h $ - filter (not . removed) $ - map treeItemToTreeContent (filter topitem addtreeitems) ++ l' + l'' <- adjustlist topitem l' + sha <- liftIO $ mkTree h l'' void $ liftIO cleanup return sha where @@ -159,16 +158,19 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo = in go h modified (blob:c) intree is Just TreeObject -> do (sl, modified, is') <- go h False [] (beneathSubTree i) is - let added = filter (inTree i) addtreeitems - let sl' = map treeItemToTreeContent added ++ sl - let sl'' = filter (not . removed) sl' - subtree <- if modified || sl'' /= sl - then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl'' + sl' <- adjustlist (inTree i) sl + subtree <- if modified || sl' /= sl + then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl' else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] let !modified' = modified || wasmodified go h modified' (subtree : c) intree is' _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") | otherwise = return (c, wasmodified, i:is) + adjustlist ishere l = do + let added = filter ishere addtreeitems + let l' = map treeItemToTreeContent added ++ l + let l'' = filter (not . removed) l' + return l'' topitem (TreeItem f _ _) = inTopTree' f removeset = S.fromList removefiles removed (TreeBlob f _ _) = S.member f removeset From 6c023e14efd7777f32724f5283aae60207c97f37 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 19:29:43 -0400 Subject: [PATCH 32/54] grafting new items into existing tree --- Git/Tree.hs | 99 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 71 insertions(+), 28 deletions(-) diff --git a/Git/Tree.hs b/Git/Tree.hs index 3560c095ea..ea48a1f124 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-} module Git.Tree ( Tree(..), @@ -29,6 +29,7 @@ import Numeric import System.Posix.Types import Control.Monad.IO.Class import qualified Data.Set as S +import qualified Data.Map as M newtype Tree = Tree [TreeContent] deriving (Show) @@ -39,7 +40,7 @@ data TreeContent | RecordedSubTree TopFilePath Sha [TreeContent] -- A subtree that has not yet been recorded in git. | NewSubTree TopFilePath [TreeContent] - deriving (Show, Eq) + deriving (Show, Eq, Ord) {- Gets the Tree for a Ref. -} getTree :: Ref -> Repo -> IO Tree @@ -112,11 +113,35 @@ data TreeItem = TreeItem TopFilePath FileMode Sha treeItemToTreeContent :: TreeItem -> TreeContent treeItemToTreeContent (TreeItem f m s) = TreeBlob f m s - --- FIXME: When addtreeitems has an item in a new --- subdirectory, no subtree contains it. We need to add a --- new subtree in this case, but not in the case where the --- subdirectory already exists in the tree. + +treeItemsToTree :: [TreeItem] -> Tree +treeItemsToTree = go M.empty + where + go m [] = Tree $ filter (notElem '/' . gitPath) (M.elems m) + go m (i:is) + | '/' `notElem` p = + go (M.insert p (treeItemToTreeContent i) m) is + | otherwise = case M.lookup idir m of + Just (NewSubTree d l) -> + go (addsubtree idir m (NewSubTree d (c:l))) is + _ -> + go (addsubtree idir m (NewSubTree (asTopFilePath idir) [c])) is + where + p = gitPath i + idir = takeDirectory p + c = treeItemToTreeContent i + + addsubtree d m t + | elem '/' d = + let m' = M.insert d t m + in case M.lookup parent m' of + Just (NewSubTree d' l) -> + let l' = filter (\ti -> gitPath ti /= d) l + in addsubtree parent m' (NewSubTree d' (t:l')) + _ -> addsubtree parent m' (NewSubTree (asTopFilePath parent) [t]) + | otherwise = M.insert d t m + where + parent = takeDirectory d {- Applies an adjustment to items in a tree. - @@ -139,7 +164,7 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo = withMkTreeHandle repo $ \h -> do (l, cleanup) <- liftIO $ lsTreeWithObjects r repo (l', _, _) <- go h False [] inTopTree l - l'' <- adjustlist topitem l' + l'' <- adjustlist h inTopTree (const True) l' sha <- liftIO $ mkTree h l'' void $ liftIO cleanup return sha @@ -158,7 +183,7 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo = in go h modified (blob:c) intree is Just TreeObject -> do (sl, modified, is') <- go h False [] (beneathSubTree i) is - sl' <- adjustlist (inTree i) sl + sl' <- adjustlist h (inTree i) (beneathSubTree i) sl subtree <- if modified || sl' /= sl then liftIO $ recordSubTree h $ NewSubTree (LsTree.file i) sl' else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] @@ -166,12 +191,17 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo = go h modified' (subtree : c) intree is' _ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"") | otherwise = return (c, wasmodified, i:is) - adjustlist ishere l = do - let added = filter ishere addtreeitems - let l' = map treeItemToTreeContent added ++ l - let l'' = filter (not . removed) l' - return l'' - topitem (TreeItem f _ _) = inTopTree' f + + adjustlist h ishere underhere l = do + let (addhere, rest) = partition ishere addtreeitems + let l' = filter (not . removed) $ + map treeItemToTreeContent addhere ++ l + let inl i = any (\t -> beneathSubTree t i) l' + let (Tree addunderhere) = treeItemsToTree $ + filter (\i -> underhere i && not (inl i)) rest + addunderhere' <- liftIO $ mapM (recordSubTree h) addunderhere + return (addunderhere'++l') + removeset = S.fromList removefiles removed (TreeBlob f _ _) = S.member f removeset removed _ = False @@ -199,21 +229,34 @@ extractTree l = case go [] inTopTree l of | otherwise = Right (t, i:is) parseerr = Left -type InTree = LsTree.TreeItem -> Bool +class GitPath t where + gitPath :: t -> FilePath -inTopTree :: InTree -inTopTree = inTopTree' . LsTree.file +instance GitPath FilePath where + gitPath = id -inTopTree' :: TopFilePath -> Bool -inTopTree' f = takeDirectory (getTopFilePath f) == "." +instance GitPath TopFilePath where + gitPath = getTopFilePath -beneathSubTree :: LsTree.TreeItem -> InTree -beneathSubTree t = - let prefix = getTopFilePath (LsTree.file t) ++ "/" - in (\i -> prefix `isPrefixOf` getTopFilePath (LsTree.file i)) +instance GitPath TreeItem where + gitPath (TreeItem f _ _) = gitPath f -inTree :: LsTree.TreeItem -> TreeItem -> Bool -inTree = inTree' . LsTree.file +instance GitPath LsTree.TreeItem where + gitPath = gitPath . LsTree.file -inTree' :: TopFilePath -> TreeItem -> Bool -inTree' f (TreeItem f' _ _) = takeDirectory (getTopFilePath f') == takeDirectory (getTopFilePath f) +instance GitPath TreeContent where + gitPath (TreeBlob f _ _) = gitPath f + gitPath (RecordedSubTree f _ _) = gitPath f + gitPath (NewSubTree f _) = gitPath f + +inTopTree :: GitPath t => t -> Bool +inTopTree = inTree "." + +inTree :: (GitPath t, GitPath f) => t -> f -> Bool +inTree t f = gitPath t == takeDirectory (gitPath f) + +beneathSubTree :: (GitPath t, GitPath f) => t -> f -> Bool +beneathSubTree t f = prefix `isPrefixOf` gitPath f + where + tp = gitPath t + prefix = if null tp then tp else tp ++ "/" From a85196bd4ef0582888845b6c6d82330e0d23f235 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 19:41:11 -0400 Subject: [PATCH 33/54] simplify adjustment reversal --- Annex/AdjustedBranch.hs | 49 ++++++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 18 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 030bdb99e8..0b9b73fa34 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -40,14 +40,22 @@ import qualified Database.Keys import qualified Data.Map as M -data Adjustment = UnlockAdjustment +data Adjustment + = NoneAdjustment + | UnlockAdjustment + | LockAdjustment deriving (Show) -data Direction = Forward | Reverse +{- Note that adjustments can only be reversed once; reversing a reversal + - does not always get back to the original. -} +reverseAdjustment :: Adjustment -> Adjustment +reverseAdjustment NoneAdjustment = NoneAdjustment +reverseAdjustment UnlockAdjustment = LockAdjustment +reverseAdjustment LockAdjustment = UnlockAdjustment {- How to perform various adjustments to a TreeItem. -} -adjustTreeItem :: Adjustment -> Direction -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) -adjustTreeItem UnlockAdjustment Forward h ti@(TreeItem f m s) +adjustTreeItem :: Adjustment -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) +adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s) | toBlobType m == Just SymlinkBlob = do mk <- catKey s case mk of @@ -57,7 +65,7 @@ adjustTreeItem UnlockAdjustment Forward h ti@(TreeItem f m s) <$> hashPointerFile' h k Nothing -> return (Just ti) | otherwise = return (Just ti) -adjustTreeItem UnlockAdjustment Reverse h ti@(TreeItem f m s) +adjustTreeItem LockAdjustment h ti@(TreeItem f m s) | toBlobType m /= Just SymlinkBlob = do mk <- catKey s case mk of @@ -69,6 +77,7 @@ adjustTreeItem UnlockAdjustment Reverse h ti@(TreeItem f m s) <$> hashSymlink' h linktarget Nothing -> return (Just ti) | otherwise = return (Just ti) +adjustTreeItem NoneAdjustment _ ti = return (Just ti) type OrigBranch = Branch type AdjBranch = Branch @@ -78,9 +87,12 @@ adjustedBranchPrefix = "refs/heads/adjusted/" serialize :: Adjustment -> String serialize UnlockAdjustment = "unlocked" +serialize LockAdjustment = "locked" +serialize NoneAdjustment = "none" deserialize :: String -> Maybe Adjustment deserialize "unlocked" = Just UnlockAdjustment +deserialize "locked" = Just UnlockAdjustment deserialize _ = Nothing originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch @@ -118,30 +130,30 @@ enterAdjustedBranch adj = go =<< originalBranch where go (Just origbranch) = do adjbranch <- preventCommits $ const $ - adjustBranch adj Forward origbranch + adjustBranch adj origbranch inRepo $ Git.Command.run [ Param "checkout" , Param $ fromRef $ Git.Ref.base $ adjbranch ] go Nothing = error "not on any branch!" -adjustBranch :: Adjustment -> Direction -> OrigBranch -> Annex AdjBranch -adjustBranch adj direction origbranch = do - sha <- adjust adj direction origbranch +adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch +adjustBranch adj origbranch = do + sha <- adjust adj origbranch inRepo $ Git.Branch.update adjbranch sha return adjbranch where adjbranch = originalToAdjusted origbranch adj -adjust :: Adjustment -> Direction -> Ref -> Annex Sha -adjust adj direction orig = do - treesha <- adjustTree adj direction orig +adjust :: Adjustment -> Ref -> Annex Sha +adjust adj orig = do + treesha <- adjustTree adj orig commitAdjustedTree treesha orig -adjustTree :: Adjustment -> Direction -> Ref -> Annex Sha -adjustTree adj direction orig = do +adjustTree :: Adjustment -> Ref -> Annex Sha +adjustTree adj orig = do h <- inRepo hashObjectStart - let toadj = adjustTreeItem adj direction h + let toadj = adjustTreeItem adj h treesha <- Git.Tree.adjustTree toadj [] [] orig =<< Annex.gitRepo liftIO $ hashObjectStop h return treesha @@ -193,7 +205,7 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ do ifM (inRepo $ Git.Branch.changed currbranch mergesha) ( do propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented - adjustedtomerge <- adjust adj Forward mergesha + adjustedtomerge <- adjust adj mergesha ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) ( do liftIO $ Git.LockFile.closeLock commitsprevented @@ -296,7 +308,7 @@ reverseAdjustedCommit h newparent adj (csha, c) origbranch let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others adds' <- catMaybes <$> - mapM (adjustTreeItem adj Reverse h) (map diffTreeToTreeItem adds) + mapM (adjustTreeItem reverseadj h) (map diffTreeToTreeItem adds) treesha <- Git.Tree.adjustTree (propchanges changes) adds' @@ -311,10 +323,11 @@ reverseAdjustedCommit h newparent adj (csha, c) origbranch (commitMessage c) [newparent] treesha return (Right revadjcommit) where + reverseadj = reverseAdjustment adj propchanges changes ti@(TreeItem f _ _) = case M.lookup f m of Nothing -> return (Just ti) -- not changed - Just change -> adjustTreeItem adj Reverse h change + Just change -> adjustTreeItem reverseadj h change where m = M.fromList $ map (\i@(TreeItem f' _ _) -> (f', i)) $ map diffTreeToTreeItem changes From 41b7c5f6aa49ebfc060b0892219c00cf84916c2f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 19:53:18 -0400 Subject: [PATCH 34/54] implement another adjustment -- easy to do now! --- Annex/AdjustedBranch.hs | 25 ++++++++++++++++++------- Command/Adjust.hs | 2 +- 2 files changed, 19 insertions(+), 8 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 0b9b73fa34..669455ef97 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -36,22 +36,23 @@ import Annex.CatFile import Annex.Link import Git.HashObject import Annex.AutoMerge +import Annex.Content import qualified Database.Keys import qualified Data.Map as M data Adjustment - = NoneAdjustment - | UnlockAdjustment + = UnlockAdjustment | LockAdjustment + | HideMissingAdjustment + | ShowMissingAdjustment deriving (Show) -{- Note that adjustments can only be reversed once; reversing a reversal - - does not always get back to the original. -} reverseAdjustment :: Adjustment -> Adjustment -reverseAdjustment NoneAdjustment = NoneAdjustment reverseAdjustment UnlockAdjustment = LockAdjustment reverseAdjustment LockAdjustment = UnlockAdjustment +reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment +reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment {- How to perform various adjustments to a TreeItem. -} adjustTreeItem :: Adjustment -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) @@ -77,7 +78,15 @@ adjustTreeItem LockAdjustment h ti@(TreeItem f m s) <$> hashSymlink' h linktarget Nothing -> return (Just ti) | otherwise = return (Just ti) -adjustTreeItem NoneAdjustment _ ti = return (Just ti) +adjustTreeItem HideMissingAdjustment h ti@(TreeItem _ _ s) = do + mk <- catKey s + case mk of + Just k -> ifM (inAnnex k) + ( return (Just ti) + , return Nothing + ) + Nothing -> return (Just ti) +adjustTreeItem ShowMissingAdjustment _ ti = return (Just ti) type OrigBranch = Branch type AdjBranch = Branch @@ -88,11 +97,13 @@ adjustedBranchPrefix = "refs/heads/adjusted/" serialize :: Adjustment -> String serialize UnlockAdjustment = "unlocked" serialize LockAdjustment = "locked" -serialize NoneAdjustment = "none" +serialize HideMissingAdjustment = "present" +serialize ShowMissingAdjustment = "showmissing" deserialize :: String -> Maybe Adjustment deserialize "unlocked" = Just UnlockAdjustment deserialize "locked" = Just UnlockAdjustment +deserialize "present" = Just HideMissingAdjustment deserialize _ = Nothing originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch diff --git a/Command/Adjust.hs b/Command/Adjust.hs index b52537a648..766f608f89 100644 --- a/Command/Adjust.hs +++ b/Command/Adjust.hs @@ -20,6 +20,6 @@ seek = withWords start start :: [String] -> CommandStart start [] = do - enterAdjustedBranch UnlockAdjustment + enterAdjustedBranch HideMissingAdjustment next $ next $ return True start _ = error "Unknown parameter" From cc4481355008b947c6b0506001f22c5596131013 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 20:12:31 -0400 Subject: [PATCH 35/54] simplify --- doc/design/adjusted_branches.mdwn | 84 ++++++------------------------- 1 file changed, 14 insertions(+), 70 deletions(-) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 7216fcbc4a..442cbae60a 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -207,35 +207,17 @@ These changes would need to be committed to the adjusted branch, otherwise [WORKTREE: Simply adjust the work tree (and index) per the filter.] -## reverse filtering +## reverse filtering commits -Reversing filter #1 would mean only converting pointer files to -symlinks when the file was originally a symlink. This is problimatic when a -file is renamed. Would it be ok, if foo is renamed to bar and bar is -committed, for it to be committed as an unlocked file, even if foo was -originally locked? Probably. +A user's commits on the adjusted branch have to be reverse filtered +to get changes to apply to the master branch. -Reversing filter #2 would mean not deleting removed files whose content was -not present. When the commit includes deletion of files that were removed -due to their content not being present, those deletions are not propigated. -When the user deletes an unlocked file, the content is still -present in annex, so reversing the filter should propigate the file -deletion. +This reversal of one filter can be done as just another filter. +Since only files touched by the commit will be reverse filtered, it doesn't +need to reverse all changes made by the original filter. -What if an object was sent to the annex (or removed from the annex) -after the commit and before the reverse filtering? This would cause the -reverse filter to draw the wrong conclusion. Maybe look at a list of what -objects were not present when applying the filter, and use that to decide -which to not delete when reversing it? - -So, a reverse filter may need some state that was collected when running -the filter forwards, in order to decide what to do. - -Alternatively, instead of reverse filtering the whole adjusted tree, -look at just the new commit that's being propigated back from the -adjusted to master branch. Get the diff from it to the previous -commit; the changes that were made. Then de-adjust those changes, -and apply the changes to the master branch. +For example, reversing the unlock filter might lock the file. Or, it might +do nothing, which would make all committed files remain unlocked. ## push @@ -304,58 +286,20 @@ adjusting filter, albeit an extreme one. This might improve view branches. For example, it's not currently possible to update a view branch with changes fetched from a remote, and this could get us there. -This would need the reverse filter to be able to change metadata. +This would need the reverse filter to be able to change metadata, +so that a commit that moved files in the view updates their metadata. [WORKTREE: Wouldn't be able to integrate, unless view branches are changed into adjusted view worktrees.] -## filter interface - -Distilling all of the above, the filter interface needs to be something -like this, at its most simple: - - data Filter = UnlockFilter | HideMissingFilter | UnlockHideMissingFilter - - getFilter :: Annex Filter - - setFilter :: Filter -> Annex () - - data FilterAction - = UnchangedFile FilePath - | UnlockFile FilePath - | HideFile FilePath - - data FileInfo = FileInfo - { originalBranchFile :: FileStatus - , isContentPresent :: Bool - } - - data FileStatus = IsAnnexSymlink | IsAnnexPointer - deriving (Eq) - - filterAction :: Filter -> FilePath -> FileInfo -> FilterAction - filterAction UnlockFilter f fi - | originalBranchFile fi == IsAnnexSymlink = UnlockFile f - filterAction HideMissingFilter f fi - | not (isContentPresent fi) = HideFile f - filterAction UnlockHideMissingFilter f fi - | not (isContentPresent fi) = HideFile f - | otherwise = filterAction UnlockFilter f fi - filterAction _ f _ = UnchangedFile f - - filteredCommit :: Filter -> Git.Commit -> Git.Commit - - -- Generate a version of the commit made on the filter branch - -- with the filtering of modified files reversed. - unfilteredCommit :: Filter -> Git.Commit -> Git.Commit - ## TODOs * Need a better command-line interface than `git annex adjust`, that allows picking adjustments. * Interface in webapp to enable adjustments. -* Entering an adjusted branch can race with commits to the current branch, - and so the assistant should not be running, or at least should have - commits disabled when entering it. +* Entering an adjusted branch can prevent commits to the current branch + (locking will cause the commits to fail) and so the assistant + should not be running, or at least should have commits disabled + when entering it. * When the adjusted branch unlocks files, behave as if annex.addunlocked is set, so git annex add will add files unlocked. From 7a01f60eed2b6e0c401fa604e417b9c4825ec9d0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Mar 2016 20:16:02 -0400 Subject: [PATCH 36/54] update --- doc/design/adjusted_branches.mdwn | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 442cbae60a..d226e5304d 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -62,9 +62,6 @@ it, so C does not remain in the adjusted branch history either. This will make other checkouts that are in the same adjusted branch end up with the same B' commit when they pull B. -It might be useful to have a post-commit hook that generates B and B' -and updates the branches. And/or `git-annex sync` could do it. - There may be multiple commits made to the adjusted branch before any get applied back to the original branch. This is handled by reverse filtering commits one at a time and rebasing the others on top. @@ -261,6 +258,11 @@ non-adjusted branch would then be checked out. But, we can just say, if you want to get into an adjusted branch, you have to run some command. Or, could make a post-checkout hook. +After a commit to an adjusted branch, `git push` won't do anything. The +user has to know to git-annex sync. (Even if a pre-commit hook propigated +the commit back to the master branch, `git push` wouldn't push it with the +default "matching" push strategy.) + Tags are bit of a problem. If the user tags an ajusted branch, the tag includes the local adjustments. [WORKTREE: not a problem] From 1df62b43d1356e9ee1fa2123f1ac24b774ffc350 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 11:15:21 -0400 Subject: [PATCH 37/54] remove hashPointerFile' no longer needed now that hashPointerFile uses a long-running git hash-object handle --- Annex/AdjustedBranch.hs | 43 ++++++++++++++++++----------------------- Annex/Link.hs | 3 --- 2 files changed, 19 insertions(+), 27 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 669455ef97..357e70e2ff 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -34,7 +34,6 @@ import Git.FilePath import qualified Git.LockFile import Annex.CatFile import Annex.Link -import Git.HashObject import Annex.AutoMerge import Annex.Content import qualified Database.Keys @@ -55,18 +54,18 @@ reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment {- How to perform various adjustments to a TreeItem. -} -adjustTreeItem :: Adjustment -> HashObjectHandle -> TreeItem -> Annex (Maybe TreeItem) -adjustTreeItem UnlockAdjustment h ti@(TreeItem f m s) +adjustTreeItem :: Adjustment -> TreeItem -> Annex (Maybe TreeItem) +adjustTreeItem UnlockAdjustment ti@(TreeItem f m s) | toBlobType m == Just SymlinkBlob = do mk <- catKey s case mk of Just k -> do Database.Keys.addAssociatedFile k f Just . TreeItem f (fromBlobType FileBlob) - <$> hashPointerFile' h k + <$> hashPointerFile k Nothing -> return (Just ti) | otherwise = return (Just ti) -adjustTreeItem LockAdjustment h ti@(TreeItem f m s) +adjustTreeItem LockAdjustment ti@(TreeItem f m s) | toBlobType m /= Just SymlinkBlob = do mk <- catKey s case mk of @@ -75,10 +74,10 @@ adjustTreeItem LockAdjustment h ti@(TreeItem f m s) fromTopFilePath f r linktarget <- calcRepo $ gitAnnexLink absf k Just . TreeItem f (fromBlobType SymlinkBlob) - <$> hashSymlink' h linktarget + <$> hashSymlink linktarget Nothing -> return (Just ti) | otherwise = return (Just ti) -adjustTreeItem HideMissingAdjustment h ti@(TreeItem _ _ s) = do +adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do mk <- catKey s case mk of Just k -> ifM (inAnnex k) @@ -86,7 +85,7 @@ adjustTreeItem HideMissingAdjustment h ti@(TreeItem _ _ s) = do , return Nothing ) Nothing -> return (Just ti) -adjustTreeItem ShowMissingAdjustment _ ti = return (Just ti) +adjustTreeItem ShowMissingAdjustment ti = return (Just ti) type OrigBranch = Branch type AdjBranch = Branch @@ -163,10 +162,8 @@ adjust adj orig = do adjustTree :: Adjustment -> Ref -> Annex Sha adjustTree adj orig = do - h <- inRepo hashObjectStart - let toadj = adjustTreeItem adj h + let toadj = adjustTreeItem adj treesha <- Git.Tree.adjustTree toadj [] [] orig =<< Annex.gitRepo - liftIO $ hashObjectStop h return treesha type CommitsPrevented = Git.LockFile.LockHandle @@ -262,9 +259,7 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do cv <- catCommit currbranch case cv of Just currcommit -> do - h <- inRepo hashObjectStart - v <- newcommits >>= go h origsha False - liftIO $ hashObjectStop h + v <- newcommits >>= go origsha False case v of Left e -> do warning e @@ -278,21 +273,21 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do -- Get commits oldest first, so they can be processed -- in order made. [Param "--reverse"] - go _ parent _ [] = do + go parent _ [] = do inRepo $ Git.Branch.update origbranch parent return (Right parent) - go h parent pastadjcommit (sha:l) = do + go parent pastadjcommit (sha:l) = do mc <- catCommit sha case mc of Just c | commitMessage c == adjustedBranchCommitMessage -> - go h parent True l + go parent True l | pastadjcommit -> do - v <- reverseAdjustedCommit h parent adj (sha, c) origbranch + v <- reverseAdjustedCommit parent adj (sha, c) origbranch case v of Left e -> return (Left e) - Right commit -> go h commit pastadjcommit l - _ -> go h parent pastadjcommit l + Right commit -> go commit pastadjcommit l + _ -> go parent pastadjcommit l rebase currcommit newparent = do -- Reuse the current adjusted tree, -- and reparent it on top of the new @@ -309,8 +304,8 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do - Note that the commit message, and the author and committer metadata are - copied over. However, any gpg signature will be lost, and any other - headers are not copied either. -} -reverseAdjustedCommit :: HashObjectHandle -> Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha) -reverseAdjustedCommit h newparent adj (csha, c) origbranch +reverseAdjustedCommit :: Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha) +reverseAdjustedCommit newparent adj (csha, c) origbranch -- commitDiff does not support merge commits | length (commitParent c) > 1 = return $ Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch @@ -319,7 +314,7 @@ reverseAdjustedCommit h newparent adj (csha, c) origbranch let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others adds' <- catMaybes <$> - mapM (adjustTreeItem reverseadj h) (map diffTreeToTreeItem adds) + mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds) treesha <- Git.Tree.adjustTree (propchanges changes) adds' @@ -338,7 +333,7 @@ reverseAdjustedCommit h newparent adj (csha, c) origbranch propchanges changes ti@(TreeItem f _ _) = case M.lookup f m of Nothing -> return (Just ti) -- not changed - Just change -> adjustTreeItem reverseadj h change + Just change -> adjustTreeItem reverseadj change where m = M.fromList $ map (\i@(TreeItem f' _ _) -> (f', i)) $ map diffTreeToTreeItem changes diff --git a/Annex/Link.hs b/Annex/Link.hs index 4ee85aac9c..b191bce6fe 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -117,9 +117,6 @@ stageSymlink file sha = hashPointerFile :: Key -> Annex Sha hashPointerFile key = hashBlob (formatPointer key) -hashPointerFile' :: Git.HashObject.HashObjectHandle -> Key -> Annex Sha -hashPointerFile' h = liftIO . Git.HashObject.hashBlob h . formatPointer - {- Stages a pointer file, using a Sha of its content -} stagePointerFile :: FilePath -> Sha -> Annex () stagePointerFile file sha = From 4c9ca987690cbfc1c535d43f913fca14d09f2f9f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 11:33:26 -0400 Subject: [PATCH 38/54] docs for git-annex adjust --- debian/changelog | 2 ++ doc/git-annex-adjust.mdwn | 50 ++++++++++++++++++++++++++++++++++++ doc/git-annex-direct.mdwn | 4 +++ doc/git-annex.mdwn | 7 +++++ doc/tips/unlocked_files.mdwn | 8 ++++++ 5 files changed, 71 insertions(+) create mode 100644 doc/git-annex-adjust.mdwn diff --git a/debian/changelog b/debian/changelog index eed11e4f8e..62caa20d14 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,5 +1,7 @@ git-annex (6.20160319) UNRELEASED; urgency=medium + * adjust --unlock: Enters an adjusted branch in which all annexed files + are unlocked. The v6 equivilant of direct mode, but much cleaner! * ddar remote: fix ssh calls Thanks, Robie Basak diff --git a/doc/git-annex-adjust.mdwn b/doc/git-annex-adjust.mdwn new file mode 100644 index 0000000000..551eabe012 --- /dev/null +++ b/doc/git-annex-adjust.mdwn @@ -0,0 +1,50 @@ +# NAME + +git-annex adjust - enter an adjusted branch + +# SYNOPSIS + +git annex adjust --unlock` + +# DESCRIPTION + +Enters an adjusted form of the current branch. The annexed files will +be treated differently. For example with --unlock all annexed files will +be unlocked. + +The adjusted branch will have a name like "adjusted/master(unlocked)". +Since it's a regular git branch, you can use `git checkout` to switch +back to the original branch at any time. + +While in the adjusted branch, you can use git-annex and git commands as +usual. Any commits that you make will initially only be made to the +adjusted branch. + +To propigate changes from the adjusted branch back to the original branch, +and to other repositories, as well as to merge in changes from other +repositories, use `git annex sync`. + +This command can only be used in a v6 git-annex repository. + +# OPTIONS + +* `--unlock` + + Unlock all annexed files in the adjusted branch. This allows + annexed files to be modified. + +# SEE ALSO + +[[git-annex]](1) + +[[git-annex-unlock]](1) + +[[git-annex-upgrade]](1) + +[[git-annex-sync]](1) + +# AUTHOR + +Joey Hess + +Warning: Automatically converted into a man page by mdwn2man. Edit with care. diff --git a/doc/git-annex-direct.mdwn b/doc/git-annex-direct.mdwn index 3cade1a8c9..c3d7dfadc2 100644 --- a/doc/git-annex-direct.mdwn +++ b/doc/git-annex-direct.mdwn @@ -20,6 +20,8 @@ commands. Note that the direct mode/indirect mode distinction is removed in v6 git-annex repositories. In such a repository, you can use [[git-annex-unlock]](1) to make a file's content be directly present. +You can also use [[git-annex-adjust]](1) to enter a branch where all +annexed files are unlocked, which is similar to the old direct mode. # SEE ALSO @@ -29,6 +31,8 @@ use [[git-annex-unlock]](1) to make a file's content be directly present. [[git-annex-unlock]](1) +[[git-annex-adjust]](1) + # AUTHOR Joey Hess diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 6830f741f4..e9698c1695 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -295,6 +295,13 @@ subdirectories). See [[git-annex-indirect]](1) for details. +* `adjust` + + Switches a repository to use an adjusted branch, which can automatically + unlock all files, etc. + + See [[git-annex-adjust]](1) for details. + # REPOSITORY MAINTENANCE COMMANDS * `fsck [path ...]` diff --git a/doc/tips/unlocked_files.mdwn b/doc/tips/unlocked_files.mdwn index fd103940ed..cc9972f9e0 100644 --- a/doc/tips/unlocked_files.mdwn +++ b/doc/tips/unlocked_files.mdwn @@ -95,6 +95,8 @@ mode is used. To make them always use unlocked mode, run: `git config annex.addunlocked true` """]] +## mixing locked and unlocked files + A v6 repository can contain both locked and unlocked files. You can switch a file back and forth using the `git annex lock` and `git annex unlock` commands. This changes what's stored in git between a git-annex symlink @@ -102,6 +104,12 @@ commands. This changes what's stored in git between a git-annex symlink the repository in locked mode, use `git annex add`; to add a file in unlocked mode, use `git add`. +If you want to mostly keep files locked, but be able to locally switch +to having them all unlocked, you can do so using `git annex adjust +--unlock`. See [[git-annex-adjust]] for details. This is particularly +useful when using filesystems like FAT, and OS's like Windows that don't +support symlinks. + ## using less disk space Unlocked files are handy, but they have one significant disadvantage From f4dd3fbb684c5151642b4c1d2f5130f7c255abe5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 11:54:18 -0400 Subject: [PATCH 39/54] option parser for adjust command --- Command/Adjust.hs | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/Command/Adjust.hs b/Command/Adjust.hs index 766f608f89..7646cfa576 100644 --- a/Command/Adjust.hs +++ b/Command/Adjust.hs @@ -12,14 +12,26 @@ import Annex.AdjustedBranch cmd :: Command cmd = notBareRepo $ notDirect $ - command "adjust" SectionSetup "adjust branch" - paramNothing (withParams seek) + command "adjust" SectionSetup "enter adjusted branch" + paramNothing (seek <$$> optParser) -seek :: CmdParams -> CommandSeek -seek = withWords start +optParser :: CmdParamsDesc -> Parser Adjustment +optParser _ = + flag' UnlockAdjustment + ( long "unlock" + <> help "unlock annexed files" + ) + {- Not ready yet + <|> flag' HideMissingAdjustment + ( long "hide-missing" + <> help "omit annexed files whose content is not present" + ) + -} -start :: [String] -> CommandStart -start [] = do - enterAdjustedBranch HideMissingAdjustment +seek :: Adjustment -> CommandSeek +seek = commandAction . start + +start :: Adjustment -> CommandStart +start adj = do + enterAdjustedBranch adj next $ next $ return True -start _ = error "Unknown parameter" From 5e1d7bbc005c4fbd3244ea84834e02d0062c972b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 12:05:02 -0400 Subject: [PATCH 40/54] limit git annex adjust to v6 mode doesn't work in v5 --- Annex/Version.hs | 3 +++ Command/Adjust.hs | 3 +++ 2 files changed, 6 insertions(+) diff --git a/Annex/Version.hs b/Annex/Version.hs index f294f8cd3b..b5f038c0d0 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -52,6 +52,9 @@ versionSupportsUnlockedPointers = go <$> getVersion go (Just "6") = True go _ = False +versionSupportsAdjustedBranch :: Annex Bool +versionSupportsAdjustedBranch = versionSupportsUnlockedPointers + setVersion :: Version -> Annex () setVersion = setConfig versionField diff --git a/Command/Adjust.hs b/Command/Adjust.hs index 7646cfa576..2ea39edd24 100644 --- a/Command/Adjust.hs +++ b/Command/Adjust.hs @@ -9,6 +9,7 @@ module Command.Adjust where import Command import Annex.AdjustedBranch +import Annex.Version cmd :: Command cmd = notBareRepo $ notDirect $ @@ -33,5 +34,7 @@ seek = commandAction . start start :: Adjustment -> CommandStart start adj = do + unlessM versionSupportsAdjustedBranch $ + error "Adjusted branches are only supported in v6 or newer repositories." enterAdjustedBranch adj next $ next $ return True From 4226ae104031e48fc31cf307560017e38417d1bb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 12:50:25 -0400 Subject: [PATCH 41/54] updae --- doc/design/adjusted_branches.mdwn | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index d226e5304d..4ef229e1d9 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -138,7 +138,7 @@ conflict.) ------ -FIXME: When an adjusted unlocked branch has gotten a file, and a new +TODO FIXME: When an adjusted unlocked branch has gotten a file, and a new commit is merged in, that does not touch that file, there is a false merge conflict on the file. It's auto-resolved by creating a .variant file. This is probably a bug in the auto-resolve code for v6 files. @@ -296,8 +296,6 @@ into adjusted view worktrees.] ## TODOs -* Need a better command-line interface than `git annex adjust`, - that allows picking adjustments. * Interface in webapp to enable adjustments. * Entering an adjusted branch can prevent commits to the current branch (locking will cause the commits to fail) and so the assistant From 42b7ccc89fd3416444eeb780efbd1036956958fd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 13:26:06 -0400 Subject: [PATCH 42/54] git annex add in adjusted unlocked branch Cached the current branch lookup just because it seems unnecessary overhead to run an extra git command per add to query the current branch. --- Annex.hs | 2 ++ Annex/AdjustedBranch.hs | 6 +++++- Annex/Ingest.hs | 24 ++++++++++++++++++++++-- doc/design/adjusted_branches.mdwn | 2 -- 4 files changed, 29 insertions(+), 5 deletions(-) diff --git a/Annex.hs b/Annex.hs index fe68027769..5ab2b748d2 100644 --- a/Annex.hs +++ b/Annex.hs @@ -136,6 +136,7 @@ data AnnexState = AnnexState , workers :: [Either AnnexState (Async AnnexState)] , concurrentjobs :: Maybe Int , keysdbhandle :: Maybe Keys.DbHandle + , cachedcurrentbranch :: Maybe Git.Branch } newState :: GitConfig -> Git.Repo -> AnnexState @@ -182,6 +183,7 @@ newState c r = AnnexState , workers = [] , concurrentjobs = Nothing , keysdbhandle = Nothing + , cachedcurrentbranch = Nothing } {- Makes an Annex state object for the specified git repo. diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 357e70e2ff..b2ca7dbf64 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -12,6 +12,7 @@ module Annex.AdjustedBranch ( originalToAdjusted, adjustedToOriginal, fromAdjustedBranch, + getAdjustment, enterAdjustedBranch, updateAdjustedBranch, propigateAdjustedCommits, @@ -45,7 +46,7 @@ data Adjustment | LockAdjustment | HideMissingAdjustment | ShowMissingAdjustment - deriving (Show) + deriving (Show, Eq) reverseAdjustment :: Adjustment -> Adjustment reverseAdjustment UnlockAdjustment = LockAdjustment @@ -122,6 +123,9 @@ adjustedToOriginal b bs = fromRef b prefixlen = length adjustedBranchPrefix +getAdjustment :: Branch -> Maybe Adjustment +getAdjustment = fmap fst . adjustedToOriginal + fromAdjustedBranch :: Branch -> OrigBranch fromAdjustedBranch b = maybe b snd (adjustedToOriginal b) diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index b80f0e1e03..1bf1db146e 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -35,6 +35,8 @@ import Logs.Location import qualified Annex import qualified Annex.Queue import qualified Database.Keys +import qualified Git +import qualified Git.Branch import Config import Utility.InodeCache import Annex.ReplaceFile @@ -43,6 +45,7 @@ import Utility.CopyFile import Utility.Touch import Git.FilePath import Annex.InodeSentinal +import Annex.AdjustedBranch import Control.Exception (IOException) @@ -309,15 +312,32 @@ forceParams = ifM (Annex.getState Annex.force) ) {- Whether a file should be added unlocked or not. Default is to not, - - unless symlinks are not supported. annex.addunlocked can override that. -} + - unless symlinks are not supported. annex.addunlocked can override that. + - Also, when in an adjusted unlocked branch, always add files unlocked. + -} addUnlocked :: Annex Bool addUnlocked = isDirect <||> (versionSupportsUnlockedPointers <&&> ((not . coreSymlinks <$> Annex.getGitConfig) <||> - (annexAddUnlocked <$> Annex.getGitConfig) + (annexAddUnlocked <$> Annex.getGitConfig) <||> + (maybe False (\b -> getAdjustment b == Just UnlockAdjustment) <$> cachedCurrentBranch) ) ) +cachedCurrentBranch :: Annex (Maybe Git.Branch) +cachedCurrentBranch = maybe cache (return . Just) + =<< Annex.getState Annex.cachedcurrentbranch + where + cache :: Annex (Maybe Git.Branch) + cache = do + mb <- inRepo Git.Branch.currentUnsafe + case mb of + Nothing -> return Nothing + Just b -> do + Annex.changeState $ \s -> + s { Annex.cachedcurrentbranch = Just b } + return (Just b) + {- Adds a file to the work tree for the key, and stages it in the index. - The content of the key may be provided in a temp file, which will be - moved into place. -} diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 4ef229e1d9..3cf55d1dec 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -301,5 +301,3 @@ into adjusted view worktrees.] (locking will cause the commits to fail) and so the assistant should not be running, or at least should have commits disabled when entering it. -* When the adjusted branch unlocks files, behave as if annex.addunlocked is - set, so git annex add will add files unlocked. From bcd2350fc7a889808c81186d5158cbd3a4ee733e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 13:30:29 -0400 Subject: [PATCH 43/54] update --- doc/design/adjusted_branches.mdwn | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 3cf55d1dec..d718cd342c 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -197,7 +197,7 @@ When objects are added/removed from the annex, the associated file has to be looked up, and the filter applied to it. So, dropping a file with the missing file filter would cause it to be removed from the adjusted branch, and receiving a file's content would cause it to appear in the adjusted -branch. +branch. TODO These changes would need to be committed to the adjusted branch, otherwise `git diff` would show them. @@ -255,8 +255,10 @@ index in that case. Using `git checkout` when in an adjusted branch is problimatic, because a non-adjusted branch would then be checked out. But, we can just say, if -you want to get into an adjusted branch, you have to run some command. -Or, could make a post-checkout hook. +you want to get into an adjusted branch, you have to run git annex adjust +Or, could make a post-checkout hook. This is would mostly be confusing when +git-annex init switched into the adjusted branch due to lack of symlink +support. After a commit to an adjusted branch, `git push` won't do anything. The user has to know to git-annex sync. (Even if a pre-commit hook propigated From 8a69298bf228fb12a7dc1da8e1ad2f6699a5e17e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 13:52:13 -0400 Subject: [PATCH 44/54] init: Automatically enter the adjusted unlocked branch when in a v6 repo on a filesystem not supporting symlinks. --- Annex/AdjustedBranch.hs | 13 +++++++++++++ Annex/Init.hs | 12 ++++++++---- Command/Adjust.hs | 1 + debian/changelog | 2 ++ doc/todo/smudge.mdwn | 6 ------ 5 files changed, 24 insertions(+), 10 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index b2ca7dbf64..8b4712db10 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -14,6 +14,7 @@ module Annex.AdjustedBranch ( fromAdjustedBranch, getAdjustment, enterAdjustedBranch, + adjustToCrippledFileSystem, updateAdjustedBranch, propigateAdjustedCommits, ) where @@ -151,6 +152,18 @@ enterAdjustedBranch adj = go =<< originalBranch ] go Nothing = error "not on any branch!" +adjustToCrippledFileSystem :: Annex () +adjustToCrippledFileSystem = do + warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files." + whenM (isNothing <$> originalBranch) $ + void $ inRepo $ Git.Branch.commitCommand Git.Branch.AutomaticCommit + [ Param "--quiet" + , Param "--allow-empty" + , Param "-m" + , Param "commit before entering adjusted unlocked branch" + ] + enterAdjustedBranch UnlockAdjustment + adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch adjustBranch adj origbranch = do sha <- adjust adj origbranch diff --git a/Annex/Init.hs b/Annex/Init.hs index 7501d9b8fe..99f8ece2c2 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -33,6 +33,7 @@ import Annex.UUID import Annex.Link import Config import Annex.Direct +import Annex.AdjustedBranch import Annex.Environment import Annex.Hook import Annex.InodeSentinal @@ -92,10 +93,13 @@ initialize' mversion = do whenM versionSupportsUnlockedPointers $ do configureSmudgeFilter Database.Keys.scanAssociatedFiles - ifM (crippledFileSystem <&&> (not <$> isBare) <&&> (not <$> versionSupportsUnlockedPointers)) - ( do - enableDirectMode - setDirect True + ifM (crippledFileSystem <&&> (not <$> isBare)) + ( ifM versionSupportsUnlockedPointers + ( adjustToCrippledFileSystem + , do + enableDirectMode + setDirect True + ) -- Handle case where this repo was cloned from a -- direct mode repo , unlessM isBare diff --git a/Command/Adjust.hs b/Command/Adjust.hs index 2ea39edd24..3f3fd0d825 100644 --- a/Command/Adjust.hs +++ b/Command/Adjust.hs @@ -36,5 +36,6 @@ start :: Adjustment -> CommandStart start adj = do unlessM versionSupportsAdjustedBranch $ error "Adjusted branches are only supported in v6 or newer repositories." + showStart "adjust" "" enterAdjustedBranch adj next $ next $ return True diff --git a/debian/changelog b/debian/changelog index 62caa20d14..f8cd5020c2 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,8 @@ git-annex (6.20160319) UNRELEASED; urgency=medium * adjust --unlock: Enters an adjusted branch in which all annexed files are unlocked. The v6 equivilant of direct mode, but much cleaner! + * init --version=6: Automatically enter the adjusted unlocked branch + when filesystem doesn't support symlinks. * ddar remote: fix ssh calls Thanks, Robie Basak diff --git a/doc/todo/smudge.mdwn b/doc/todo/smudge.mdwn index c615f8f140..a80869dc0f 100644 --- a/doc/todo/smudge.mdwn +++ b/doc/todo/smudge.mdwn @@ -23,12 +23,6 @@ git-annex should use smudge/clean filters. (May need to use libgit2 to do this efficiently, cannot find any plumbing except git-update-index, which is very inneficient for smudged files.) -* Crippled filesystem should cause all files to be transparently unlocked. - Note that this presents problems when dealing with merge conflicts and - when pushing changes committed in such a repo. Ideally, should avoid - committing implicit unlocks, or should prevent such commits leaking out - in pushes. See [[design/adjusted_branches]]. - * Eventually (but not yet), make v6 the default for new repositories. Note that the assistant forces repos into direct mode; that will need to be changed then, and it should enable annex.thin instead. From 6301543c00d10351320670b81626bddac33f9c84 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 13:57:48 -0400 Subject: [PATCH 45/54] prevent git-annex adjust changing things out from under the daemon --- Command/Adjust.hs | 2 +- doc/design/adjusted_branches.mdwn | 4 ---- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/Command/Adjust.hs b/Command/Adjust.hs index 3f3fd0d825..e2850a3610 100644 --- a/Command/Adjust.hs +++ b/Command/Adjust.hs @@ -12,7 +12,7 @@ import Annex.AdjustedBranch import Annex.Version cmd :: Command -cmd = notBareRepo $ notDirect $ +cmd = notBareRepo $ notDirect $ noDaemonRunning $ command "adjust" SectionSetup "enter adjusted branch" paramNothing (seek <$$> optParser) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index d718cd342c..187617f675 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -299,7 +299,3 @@ into adjusted view worktrees.] ## TODOs * Interface in webapp to enable adjustments. -* Entering an adjusted branch can prevent commits to the current branch - (locking will cause the commits to fail) and so the assistant - should not be running, or at least should have commits disabled - when entering it. From 4b4a3b01525d332c540e7b69872367caaf87b363 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 16:44:09 -0400 Subject: [PATCH 46/54] todo --- doc/design/adjusted_branches.mdwn | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 187617f675..ae4151cfc4 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -299,3 +299,4 @@ into adjusted view worktrees.] ## TODOs * Interface in webapp to enable adjustments. +* Upgrade from direct mode to v6 in unlocked branch. From f63b8397632ab266211a2646f79b352b8096990b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2016 18:03:02 -0400 Subject: [PATCH 47/54] todo --- doc/design/adjusted_branches.mdwn | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index ae4151cfc4..6bc55a1772 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -300,3 +300,4 @@ into adjusted view worktrees.] * Interface in webapp to enable adjustments. * Upgrade from direct mode to v6 in unlocked branch. +* Honor annex.thin when entering an adjusted branch. From 02ce75c87de636eaf80f4ddf5bb1a46aa32af544 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 31 Mar 2016 12:04:05 -0400 Subject: [PATCH 48/54] clean up handling of commit lock Closing the lock manually caused a later exception when the bracket tried to close it again. --- Annex/AdjustedBranch.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 8b4712db10..551263ccac 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -221,8 +221,8 @@ adjustedBranchCommitMessage = "git-annex adjusted branch" {- Update the currently checked out adjusted branch, merging the provided - branch into it. -} updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool -updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ do - preventCommits $ \commitsprevented -> go commitsprevented =<< (,) +updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ + join $ preventCommits $ \commitsprevented -> go commitsprevented =<< (,) <$> inRepo (Git.Ref.sha tomerge) <*> inRepo Git.Branch.current where @@ -232,18 +232,19 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ do propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented adjustedtomerge <- adjust adj mergesha ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) - ( do - liftIO $ Git.LockFile.closeLock commitsprevented + ( return $ do + -- Run after commit lock is dropped. ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) ( preventCommits $ \commitsprevented' -> recommit commitsprevented' currbranch mergesha =<< catCommit currbranch , return False ) - , return True -- no changes to merge + , nochangestomerge ) - , return True -- no changes to merge + , nochangestomerge ) - go _ _ = return False + go _ _ = return $ return False + nochangestomerge = return $ return True {- Once a merge commit has been made, re-do it, removing - the old version of the adjusted branch as a parent, and - making the only parent be the branch that was merged in. From a5857319359af2fd8a177e97b711385f90d4deb1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 31 Mar 2016 12:27:48 -0400 Subject: [PATCH 49/54] add reflog messages --- Annex/AdjustedBranch.hs | 8 ++++---- Annex/Direct.hs | 6 +++--- Git/Branch.hs | 17 +++++++++++++---- 3 files changed, 20 insertions(+), 11 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 551263ccac..ef6d873df9 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -167,7 +167,7 @@ adjustToCrippledFileSystem = do adjustBranch :: Adjustment -> OrigBranch -> Annex AdjBranch adjustBranch adj origbranch = do sha <- adjust adj origbranch - inRepo $ Git.Branch.update adjbranch sha + inRepo $ Git.Branch.update "entering adjusted branch" adjbranch sha return adjbranch where adjbranch = originalToAdjusted origbranch adj @@ -254,7 +254,7 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ -} recommit commitsprevented currbranch parent (Just commit) = do commitsha <- commitAdjustedTree (commitTree commit) parent - inRepo $ Git.Branch.update currbranch commitsha + inRepo $ Git.Branch.update "merging into adjusted branch" currbranch commitsha propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented return True recommit _ _ _ Nothing = return False @@ -292,7 +292,7 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do -- in order made. [Param "--reverse"] go parent _ [] = do - inRepo $ Git.Branch.update origbranch parent + inRepo $ Git.Branch.update "updating adjusted branch" origbranch parent return (Right parent) go parent pastadjcommit (sha:l) = do mc <- catCommit sha @@ -311,7 +311,7 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do -- and reparent it on top of the new -- version of the origbranch. commitAdjustedTree (commitTree currcommit) newparent - >>= inRepo . Git.Branch.update currbranch + >>= inRepo . Git.Branch.update "rebasing adjusted branch on top of updated original branch" currbranch {- Reverses an adjusted commit, and commit on top of the provided newparent, - yielding a commit sha. diff --git a/Annex/Direct.hs b/Annex/Direct.hs index e85d8f447b..d16692226d 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -225,7 +225,7 @@ mergeDirectCommit allowff old branch commitmode = do let merge_msg = d "MERGE_MSG" let merge_mode = d "MERGE_MODE" ifM (pure allowff <&&> canff) - ( inRepo $ Git.Branch.update Git.Ref.headRef branch -- fast forward + ( inRepo $ Git.Branch.update "merge" Git.Ref.headRef branch -- fast forward , do msg <- liftIO $ catchDefaultIO ("merge " ++ fromRef branch) $ @@ -462,7 +462,7 @@ switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe where switch orighead = do let newhead = directBranch orighead - maybe noop (inRepo . Git.Branch.update newhead) + maybe noop (inRepo . Git.Branch.update "entering direct mode" newhead) =<< inRepo (Git.Ref.sha orighead) inRepo $ Git.Branch.checkout newhead @@ -475,7 +475,7 @@ switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe case v of Just headsha | orighead /= currhead -> do - inRepo $ Git.Branch.update orighead headsha + inRepo $ Git.Branch.update "leaving direct mode" orighead headsha inRepo $ Git.Branch.checkout orighead inRepo $ Git.Branch.delete currhead _ -> inRepo $ Git.Branch.checkout orighead diff --git a/Git/Branch.hs b/Git/Branch.hs index a0c15d1714..6258939cb1 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -100,7 +100,7 @@ fastForward branch (first:rest) repo = where no_ff = return False do_ff to = do - update branch to repo + update' branch to repo return True findbest c [] = return $ Just c findbest c (r:rs) @@ -155,7 +155,7 @@ commit commitmode allowempty message branch parentrefs repo = do ifM (cancommit tree) ( do sha <- commitTree commitmode message parentrefs tree repo - update branch sha repo + update' branch sha repo return $ Just sha , return Nothing ) @@ -185,8 +185,17 @@ forcePush :: String -> String forcePush b = "+" ++ b {- Updates a branch (or other ref) to a new Sha. -} -update :: Branch -> Sha -> Repo -> IO () -update branch sha = run +update :: String -> Branch -> Sha -> Repo -> IO () +update message branch sha = run + [ Param "update-ref" + , Param "-m" + , Param message + , Param $ fromRef branch + , Param $ fromRef sha + ] + +update' :: Branch -> Sha -> Repo -> IO () +update' branch sha = run [ Param "update-ref" , Param $ fromRef branch , Param $ fromRef sha From 860602a1e695d1cf24218c8b4ae5a9f7eec1d602 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 31 Mar 2016 14:56:10 -0400 Subject: [PATCH 50/54] made some progress on syncing adjusted branches, but still buggy --- Annex/AdjustedBranch.hs | 23 ++++++++++++----------- Command/Sync.hs | 25 +++++++++++++------------ doc/design/adjusted_branches.mdwn | 21 ++++++++++++++++++++- 3 files changed, 45 insertions(+), 24 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index ef6d873df9..65f95a13f1 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -222,28 +222,27 @@ adjustedBranchCommitMessage = "git-annex adjusted branch" - branch into it. -} updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ - join $ preventCommits $ \commitsprevented -> go commitsprevented =<< (,) + join $ preventCommits $ \_ -> go =<< (,) <$> inRepo (Git.Ref.sha tomerge) <*> inRepo Git.Branch.current where - go commitsprevented (Just mergesha, Just currbranch) = + go (Just mergesha, Just currbranch) = ifM (inRepo $ Git.Branch.changed currbranch mergesha) ( do - propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented adjustedtomerge <- adjust adj mergesha ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) - ( return $ do + ( return $ -- Run after commit lock is dropped. ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode) - ( preventCommits $ \commitsprevented' -> - recommit commitsprevented' currbranch mergesha =<< catCommit currbranch + ( preventCommits $ \_ -> + recommit currbranch mergesha =<< catCommit currbranch , return False ) , nochangestomerge ) , nochangestomerge ) - go _ _ = return $ return False + go _ = return $ return False nochangestomerge = return $ return True {- Once a merge commit has been made, re-do it, removing - the old version of the adjusted branch as a parent, and @@ -251,13 +250,15 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ - - Doing this ensures that the same commit Sha is - always arrived at for a given commit from the merged in branch. + + - Also, update the origbranch. -} - recommit commitsprevented currbranch parent (Just commit) = do + recommit currbranch parent (Just commit) = do commitsha <- commitAdjustedTree (commitTree commit) parent - inRepo $ Git.Branch.update "merging into adjusted branch" currbranch commitsha - propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented + inRepo $ Git.Branch.update "updating original branch" origbranch parent + inRepo $ Git.Branch.update "rebasing adjusted branch on top of updated original branch after merge" currbranch commitsha return True - recommit _ _ _ Nothing = return False + recommit _ _ Nothing = return False {- Check for any commits present on the adjusted branch that have not yet - been propigated to the orig branch, and propigate them. diff --git a/Command/Sync.hs b/Command/Sync.hs index 4753a8fdce..42484e3bae 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -1,7 +1,7 @@ {- git-annex command - - Copyright 2011 Joachim Breitner - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2016 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -243,21 +243,28 @@ commitStaged commitmode commitmessage = do return True mergeLocal :: CurrBranch -> CommandStart -mergeLocal currbranch@(Just branch, _) = go =<< needmerge +mergeLocal currbranch@(Just branch, madj) = do + proptoorig + go =<< needmerge where syncbranch = syncBranch branch needmerge = ifM isBareRepo ( return False , ifM (inRepo $ Git.Ref.exists syncbranch) - ( inRepo $ Git.Branch.changed branch syncbranch + ( inRepo $ Git.Branch.changed branch' syncbranch , return False ) ) go False = stop go True = do showStart "merge" $ Git.Ref.describe syncbranch - next $ next $ - merge currbranch Git.Branch.ManualCommit syncbranch + next $ next $ merge currbranch Git.Branch.ManualCommit syncbranch + branch' = maybe branch (originalToAdjusted branch) madj + -- When in an adjusted branch, propigate any changes made to it + -- back to the original branch. + proptoorig = case madj of + Just adj -> propigateAdjustedCommits branch (adj, branch') + Nothing -> return () mergeLocal (Nothing, _) = stop pushLocal :: CurrBranch -> CommandStart @@ -267,13 +274,7 @@ pushLocal b = do updateSyncBranch :: CurrBranch -> Annex () updateSyncBranch (Nothing, _) = noop -updateSyncBranch (Just branch, madj) = do - -- When in an adjusted branch, propigate any changes to it back to - -- the original branch. - case madj of - Just adj -> propigateAdjustedCommits branch - (adj, originalToAdjusted branch adj) - Nothing -> return () +updateSyncBranch (Just branch, _) = do -- Update the sync branch to match the new state of the branch inRepo $ updateBranch (syncBranch branch) branch -- In direct mode, we're operating on some special direct mode diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 6bc55a1772..4d5e409298 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -171,7 +171,7 @@ adjust that commit so it does not have adjusted/master as its parent. |--------------->B'' | | -Finally, update master, by reverse filtering B''. TODO +Finally, update master, by reverse filtering B''. Notice how similar this is to the commit graph. So, "fast-forward" merging the same B commit from origin/master will lead to an identical @@ -301,3 +301,22 @@ into adjusted view worktrees.] * Interface in webapp to enable adjustments. * Upgrade from direct mode to v6 in unlocked branch. * Honor annex.thin when entering an adjusted branch. +* Cloning a repo that has an adjusted branch checked out gets into an ugly + state. + +Bug running git-annex sync in adjusted branch when there is a local change +that gets committed (or already has been), and remote changes available. +Both propigateAdjustedCommits and updateAdjustedBranch +get called in this scenario. Neither order of calling the two works entirely. + +The reflog has: + +d585d7f HEAD@{1}: rebasing adjusted branch on top of updated original branch +e51daec HEAD@{2}: merge f7f2b9f3b1d1c97a1ab24f4a94d4a27d84898992: Merge made by the 'recursive' strategy. +9504e7b HEAD@{3}: rebasing adjusted branch on top of updated original branch +6c6fd41 HEAD@{4}: commit: add + +e51daec has ok correct history; it gets messed up in d585d7f + +Problem is just, that the commit made to the adjusted branch +is left out of the history. From 11935c4d6f93146084111fee3f97cb4667f4f618 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 31 Mar 2016 17:12:01 -0400 Subject: [PATCH 51/54] fix parsing of commit with no parents --- Git/CatFile.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Git/CatFile.hs b/Git/CatFile.hs index d6f7707bca..dc96730ab6 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -125,7 +125,7 @@ catCommit h commitref = go <$> catObjectDetails h commitref parseCommit :: L.ByteString -> Maybe Commit parseCommit b = Commit <$> (extractSha . L8.unpack =<< field "tree") - <*> (mapMaybe (extractSha . L8.unpack) <$> fields "parent") + <*> Just (maybe [] (mapMaybe (extractSha . L8.unpack)) (fields "parent")) <*> (parsemetadata <$> field "author") <*> (parsemetadata <$> field "committer") <*> Just (L8.unpack $ L.intercalate (L.singleton nl) message) From f08149207c89676f09eaedf6fd33ed2f49cd719f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 31 Mar 2016 17:20:43 -0400 Subject: [PATCH 52/54] autoinit on upgrade --- Command/Upgrade.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 432250a1ab..223be581d9 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -9,6 +9,8 @@ module Command.Upgrade where import Command import Upgrade +import Annex.Version +import Annex.Init cmd :: Command cmd = dontCheck repoExists $ -- because an old version may not seem to exist @@ -22,5 +24,7 @@ seek = withNothing start start :: CommandStart start = do showStart "upgrade" "." + whenM (isNothing <$> getVersion) $ do + initialize Nothing Nothing r <- upgrade False next $ next $ return r From 12ddb6e8b237f2fc32e58310f6c3ee18cc312fa4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 31 Mar 2016 18:54:35 -0400 Subject: [PATCH 53/54] fixed merging of changes from adjusted branch + a remote --- Annex/AdjustedBranch.hs | 157 ++++++++++++++++++++---------- Command/Sync.hs | 17 ++-- doc/design/adjusted_branches.mdwn | 156 ++++++++++++++++++++--------- 3 files changed, 222 insertions(+), 108 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 65f95a13f1..c757eae1dd 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -205,15 +205,18 @@ preventCommits = bracket setup cleanup - metadata is based on the parent. -} commitAdjustedTree :: Sha -> Ref -> Annex Sha -commitAdjustedTree treesha parent = go =<< catCommit parent +commitAdjustedTree treesha parent = commitAdjustedTree' treesha parent [parent] + +commitAdjustedTree' :: Sha -> Ref -> [Ref] -> Annex Sha +commitAdjustedTree' treesha basis parents = go =<< catCommit basis where go Nothing = inRepo mkcommit - go (Just parentcommit) = inRepo $ commitWithMetaData - (commitAuthorMetaData parentcommit) - (commitCommitterMetaData parentcommit) + go (Just basiscommit) = inRepo $ commitWithMetaData + (commitAuthorMetaData basiscommit) + (commitCommitterMetaData basiscommit) mkcommit mkcommit = Git.Branch.commitTree Git.Branch.AutomaticCommit - adjustedBranchCommitMessage [parent] treesha + adjustedBranchCommitMessage parents treesha adjustedBranchCommitMessage :: String adjustedBranchCommitMessage = "git-annex adjusted branch" @@ -222,13 +225,14 @@ adjustedBranchCommitMessage = "git-annex adjusted branch" - branch into it. -} updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ - join $ preventCommits $ \_ -> go =<< (,) + join $ preventCommits $ \commitsprevented -> go commitsprevented =<< (,) <$> inRepo (Git.Ref.sha tomerge) <*> inRepo Git.Branch.current where - go (Just mergesha, Just currbranch) = + go commitsprevented (Just mergesha, Just currbranch) = ifM (inRepo $ Git.Branch.changed currbranch mergesha) ( do + void $ propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented adjustedtomerge <- adjust adj mergesha ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge) ( return $ @@ -242,24 +246,56 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ ) , nochangestomerge ) - go _ = return $ return False + go _ _ = return $ return False nochangestomerge = return $ return True - {- Once a merge commit has been made, re-do it, removing - - the old version of the adjusted branch as a parent, and - - making the only parent be the branch that was merged in. + + {- A merge commit has been made on the adjusted branch. + - Now, re-do it, removing the old version of the adjusted branch + - from its history. - - - Doing this ensures that the same commit Sha is - - always arrived at for a given commit from the merged in branch. - - - Also, update the origbranch. + - There are two possible scenarios; either some commits + - were made on top of the adjusted branch's adjusting commit, + - or not. Those commits have already been propigated to the + - orig branch, so we can just check if there are commits in the + - orig branch that are not present in tomerge. -} - recommit currbranch parent (Just commit) = do - commitsha <- commitAdjustedTree (commitTree commit) parent - inRepo $ Git.Branch.update "updating original branch" origbranch parent - inRepo $ Git.Branch.update "rebasing adjusted branch on top of updated original branch after merge" currbranch commitsha - return True + recommit currbranch mergedsha (Just mergecommit) = + ifM (inRepo $ Git.Branch.changed tomerge origbranch) + ( remerge currbranch mergedsha mergecommit + =<< inRepo (Git.Ref.sha origbranch) + , fastforward currbranch mergedsha mergecommit + ) recommit _ _ Nothing = return False + {- Fast-forward scenario. The mergecommit is changed to a non-merge + - commit, with its parent being the mergedsha. + - The orig branch can simply be pointed at the mergedsha. + -} + fastforward currbranch mergedsha mergecommit = do + commitsha <- commitAdjustedTree (commitTree mergecommit) mergedsha + inRepo $ Git.Branch.update "fast-forward update of adjusted branch" currbranch commitsha + inRepo $ Git.Branch.update "updating original branch" origbranch mergedsha + return True + + {- True merge scenario. -} + remerge currbranch mergedsha mergecommit (Just origsha) = do + -- Update origbranch by reverse adjusting the mergecommit, + -- yielding a merge between orig and tomerge. + treesha <- reverseAdjustedTree origsha adj + -- get 1-parent commit because + -- reverseAdjustedTree does not support merges + =<< commitAdjustedTree (commitTree mergecommit) origsha + revadjcommit <- inRepo $ + Git.Branch.commitTree Git.Branch.AutomaticCommit + ("Merge branch " ++ fromRef tomerge) [origsha, mergedsha] treesha + inRepo $ Git.Branch.update "updating original branch" origbranch revadjcommit + -- Update currbranch, reusing mergedsha, but making its + -- parent be the updated origbranch. + adjcommit <- commitAdjustedTree' (commitTree mergecommit) revadjcommit [revadjcommit] + inRepo $ Git.Branch.update rebaseOnTopMsg currbranch adjcommit + return True + remerge _ _ _ Nothing = return False + {- Check for any commits present on the adjusted branch that have not yet - been propigated to the orig branch, and propigate them. - @@ -268,9 +304,16 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $ -} propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex () propigateAdjustedCommits origbranch (adj, currbranch) = - preventCommits $ propigateAdjustedCommits' origbranch (adj, currbranch) - -propigateAdjustedCommits' :: OrigBranch -> (Adjustment, AdjBranch) -> CommitsPrevented -> Annex () + preventCommits $ \commitsprevented -> do + join $ propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented + +{- Returns action which will rebase the adjusted branch on top of the + - updated orig branch. -} +propigateAdjustedCommits' + :: OrigBranch + -> (Adjustment, AdjBranch) + -> CommitsPrevented + -> Annex (Annex ()) propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do ov <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch) case ov of @@ -282,11 +325,11 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do case v of Left e -> do warning e - return () - Right newparent -> + return $ return () + Right newparent -> return $ rebase currcommit newparent - Nothing -> return () - Nothing -> return () + Nothing -> return $ return () + Nothing -> return $ return () where newcommits = inRepo $ Git.Branch.changedCommits origbranch currbranch -- Get commits oldest first, so they can be processed @@ -312,41 +355,53 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do -- and reparent it on top of the new -- version of the origbranch. commitAdjustedTree (commitTree currcommit) newparent - >>= inRepo . Git.Branch.update "rebasing adjusted branch on top of updated original branch" currbranch + >>= inRepo . Git.Branch.update rebaseOnTopMsg currbranch -{- Reverses an adjusted commit, and commit on top of the provided newparent, +rebaseOnTopMsg :: String +rebaseOnTopMsg = "rebasing adjusted branch on top of updated original branch" + +{- Reverses an adjusted commit, and commit with provided commitparent, - yielding a commit sha. - - - Adjust the tree of the newparent, changing only the files that the + - Adjusts the tree of the commitparent, changing only the files that the - commit changed, and reverse adjusting those changes. - - - Note that the commit message, and the author and committer metadata are - - copied over. However, any gpg signature will be lost, and any other - - headers are not copied either. -} + - The commit message, and the author and committer metadata are + - copied over from the basiscommit. However, any gpg signature + - will be lost, and any other headers are not copied either. -} reverseAdjustedCommit :: Sha -> Adjustment -> (Sha, Commit) -> OrigBranch -> Annex (Either String Sha) -reverseAdjustedCommit newparent adj (csha, c) origbranch - -- commitDiff does not support merge commits - | length (commitParent c) > 1 = return $ +reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch + | length (commitParent basiscommit) > 1 = return $ Left $ "unable to propigate merge commit " ++ show csha ++ " back to " ++ show origbranch | otherwise = do - (diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha) - let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff - let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others - adds' <- catMaybes <$> - mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds) - treesha <- Git.Tree.adjustTree - (propchanges changes) - adds' - (map Git.DiffTree.file removes) - newparent - =<< Annex.gitRepo - void $ liftIO cleanup + treesha <- reverseAdjustedTree commitparent adj csha revadjcommit <- inRepo $ commitWithMetaData - (commitAuthorMetaData c) - (commitCommitterMetaData c) $ + (commitAuthorMetaData basiscommit) + (commitCommitterMetaData basiscommit) $ Git.Branch.commitTree Git.Branch.AutomaticCommit - (commitMessage c) [newparent] treesha + (commitMessage basiscommit) [commitparent] treesha return (Right revadjcommit) + +{- Adjusts the tree of the basis, changing only the files that the + - commit changed, and reverse adjusting those changes. + - + - commitDiff does not support merge commits, so the csha must not be a + - merge commit. -} +reverseAdjustedTree :: Sha -> Adjustment -> Sha -> Annex Sha +reverseAdjustedTree basis adj csha = do + (diff, cleanup) <- inRepo (Git.DiffTree.commitDiff csha) + let (adds, others) = partition (\dti -> Git.DiffTree.srcsha dti == nullSha) diff + let (removes, changes) = partition (\dti -> Git.DiffTree.dstsha dti == nullSha) others + adds' <- catMaybes <$> + mapM (adjustTreeItem reverseadj) (map diffTreeToTreeItem adds) + treesha <- Git.Tree.adjustTree + (propchanges changes) + adds' + (map Git.DiffTree.file removes) + basis + =<< Annex.gitRepo + void $ liftIO cleanup + return treesha where reverseadj = reverseAdjustment adj propchanges changes ti@(TreeItem f _ _) = diff --git a/Command/Sync.hs b/Command/Sync.hs index 42484e3bae..135f8b42d3 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -243,9 +243,7 @@ commitStaged commitmode commitmessage = do return True mergeLocal :: CurrBranch -> CommandStart -mergeLocal currbranch@(Just branch, madj) = do - proptoorig - go =<< needmerge +mergeLocal currbranch@(Just branch, madj) = go =<< needmerge where syncbranch = syncBranch branch needmerge = ifM isBareRepo @@ -260,11 +258,6 @@ mergeLocal currbranch@(Just branch, madj) = do showStart "merge" $ Git.Ref.describe syncbranch next $ next $ merge currbranch Git.Branch.ManualCommit syncbranch branch' = maybe branch (originalToAdjusted branch) madj - -- When in an adjusted branch, propigate any changes made to it - -- back to the original branch. - proptoorig = case madj of - Just adj -> propigateAdjustedCommits branch (adj, branch') - Nothing -> return () mergeLocal (Nothing, _) = stop pushLocal :: CurrBranch -> CommandStart @@ -274,7 +267,13 @@ pushLocal b = do updateSyncBranch :: CurrBranch -> Annex () updateSyncBranch (Nothing, _) = noop -updateSyncBranch (Just branch, _) = do +updateSyncBranch (Just branch, madj) = do + -- When in an adjusted branch, propigate any changes made to it + -- back to the original branch. + case madj of + Just adj -> propigateAdjustedCommits branch + (adj, originalToAdjusted branch adj) + Nothing -> return () -- Update the sync branch to match the new state of the branch inRepo $ updateBranch (syncBranch branch) branch -- In direct mode, we're operating on some special direct mode diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index 4d5e409298..f790469c8d 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -109,10 +109,10 @@ beginning the merge. There may be staged changes, or changes in the work tree. First filter the new commit: - origin/master adjusted/master - A - |--------------->A' - | | + origin/master adjusted/master master + A A + |--------------->A' | + | | | | | B | @@ -120,10 +120,10 @@ First filter the new commit: Then, merge that into adjusted/master: - origin/master adjusted/master - A - |--------------->A' - | | + origin/master adjusted/master master + A A + |--------------->A' | + | | | | | B | | | @@ -136,35 +136,13 @@ conflict should only affect the work tree/index, so can be resolved without making a commit, but B'' may end up being made to resolve a merge conflict.) ------- +Once the merge is done, we have a merge commit B'' on adjusted/master. +To finish, redo that commit so it does not have A' as its parent. -TODO FIXME: When an adjusted unlocked branch has gotten a file, and a new -commit is merged in, that does not touch that file, there is a false merge -conflict on the file. It's auto-resolved by creating a .variant file. -This is probably a bug in the auto-resolve code for v6 files. - -Test case: - - git clone ~/lib/tmp - cd tmp - git annex upgrade - git annex adjust - git annex get t/foo - # make change in ~/lib/tmp and commit - git annex sync - # t/foo.variant-* is there - ------- - - - -Once the merge is done, we have a commit B'' on adjusted/master. To finish, -adjust that commit so it does not have adjusted/master as its parent. - - origin/master adjusted/master - A - |--------------->A' - | | + origin/master adjusted/master master + A A + |--------------->A' | + | | | | | B | @@ -172,6 +150,16 @@ adjust that commit so it does not have adjusted/master as its parent. | | Finally, update master, by reverse filtering B''. + + origin/master adjusted/master master + A A + |--------------->A' | + | | | + | | | + B | + | | + |--------------->B'' - - - - - - -> B + | | Notice how similar this is to the commit graph. So, "fast-forward" merging the same B commit from origin/master will lead to an identical @@ -191,6 +179,66 @@ between the adjusted work tree and pulled changes. A post-merge hook would be needed to re-adjust the work tree, and there would be a window where eg, not present files would appear in the work tree.] +## another merge scenario + +Another merge scenario is when there's a new commit C on adjusted/master, +and also a new commit B on origin/master. + +Start by adjusting B': + + origin/master adjusted/master master + A A + |--------------->A' | + | | | + | C' + B + | + |---------->B' + +Then, merge B' into adjusted/master: + + origin/master adjusted/master master + A A + |--------------->A' | + | | | + | C' + B | + | | + |----------->B'->M' + +Here M' is the correct tree, but it has A' as its grandparent, +which is the adjusted branch commit, so needs to be dropped in order to +get a commit that can be put on master. + +We don't want to lose commit C', but it's an adjusted +commit, so needs to be de-adjusted. + + origin/master adjusted/master master + A A + |--------------->A' | + | | | + | C'- - - - - - - - > C + B | + | | + |----------->B'->M' + | + +Now, we generate a merge commit, between B and C, with known result M' +(so no actual merging done here). + + origin/master adjusted/master master + A A + |--------------->A' | + | | | + | C'- - - - - - - - > C + B | + | | + |--------------->M'<-----------------| + | + +Finally, update master, by reverse filtering M'. The resulting commit +on master will also be a merge between B and C. + ## annex object add/remove When objects are added/removed from the annex, the associated file has to @@ -303,20 +351,32 @@ into adjusted view worktrees.] * Honor annex.thin when entering an adjusted branch. * Cloning a repo that has an adjusted branch checked out gets into an ugly state. +* There are potentially races in code that assumes a branch like + master is not being changed by someone else. In particular, + propigateAdjustedCommits rebases the adjusted branch on top of master. + That is called by sync. The assumption is that any changes in master + have already been handled by updateAdjustedBranch. But, if another remote + pushed a new master at just the right time, the adjusted branch could be + rebased on top of a master that it doesn't incorporate, which is wrong. -Bug running git-annex sync in adjusted branch when there is a local change -that gets committed (or already has been), and remote changes available. -Both propigateAdjustedCommits and updateAdjustedBranch -get called in this scenario. Neither order of calling the two works entirely. +------ -The reflog has: +TODO FIXME: When an adjusted unlocked branch has gotten a file, and a new +commit is merged in, that does not touch that file, there is a false merge +conflict on the file. It's auto-resolved by creating a .variant file. +This is probably a bug in the auto-resolve code for v6 files. -d585d7f HEAD@{1}: rebasing adjusted branch on top of updated original branch -e51daec HEAD@{2}: merge f7f2b9f3b1d1c97a1ab24f4a94d4a27d84898992: Merge made by the 'recursive' strategy. -9504e7b HEAD@{3}: rebasing adjusted branch on top of updated original branch -6c6fd41 HEAD@{4}: commit: add +Test case: + + git clone ~/lib/tmp + cd tmp + git annex upgrade + git annex adjust + git annex get t/foo + # make change in ~/lib/tmp and commit + git annex sync + # t/foo.variant-* is there + +------ -e51daec has ok correct history; it gets messed up in d585d7f -Problem is just, that the commit made to the adjusted branch -is left out of the history. From b7d7cc858e416219e328c658af94418027ea15de Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 31 Mar 2016 18:56:30 -0400 Subject: [PATCH 54/54] remove old bug I just fixed this one today; it was not the problem I thought it was. --- doc/design/adjusted_branches.mdwn | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/doc/design/adjusted_branches.mdwn b/doc/design/adjusted_branches.mdwn index f790469c8d..a4fd406507 100644 --- a/doc/design/adjusted_branches.mdwn +++ b/doc/design/adjusted_branches.mdwn @@ -358,25 +358,3 @@ into adjusted view worktrees.] have already been handled by updateAdjustedBranch. But, if another remote pushed a new master at just the right time, the adjusted branch could be rebased on top of a master that it doesn't incorporate, which is wrong. - ------- - -TODO FIXME: When an adjusted unlocked branch has gotten a file, and a new -commit is merged in, that does not touch that file, there is a false merge -conflict on the file. It's auto-resolved by creating a .variant file. -This is probably a bug in the auto-resolve code for v6 files. - -Test case: - - git clone ~/lib/tmp - cd tmp - git annex upgrade - git annex adjust - git annex get t/foo - # make change in ~/lib/tmp and commit - git annex sync - # t/foo.variant-* is there - ------- - -