diff options
-rw-r--r-- | Annex/AutoMerge.hs | 19 | ||||
-rw-r--r-- | Annex/Branch.hs | 6 | ||||
-rw-r--r-- | Annex/Direct.hs | 20 | ||||
-rw-r--r-- | Annex/MakeRepo.hs | 6 | ||||
-rw-r--r-- | Annex/View.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/Committer.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/Merger.hs | 2 | ||||
-rw-r--r-- | Command/Direct.hs | 7 | ||||
-rw-r--r-- | Command/Indirect.hs | 7 | ||||
-rw-r--r-- | Command/Sync.hs | 18 | ||||
-rw-r--r-- | Command/Unannex.hs | 6 | ||||
-rw-r--r-- | Git/Branch.hs | 36 | ||||
-rw-r--r-- | Git/Merge.hs | 13 | ||||
-rw-r--r-- | Test.hs | 5 | ||||
-rw-r--r-- | debian/changelog | 2 |
15 files changed, 90 insertions, 61 deletions
diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index 71b28c1d4..cc27f6b28 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -12,12 +12,12 @@ import qualified Annex.Queue import Annex.Direct import Annex.CatFile import Annex.Link -import qualified Git.Command import qualified Git.LsFiles as LsFiles import qualified Git.UpdateIndex as UpdateIndex import qualified Git.Merge import qualified Git.Ref import qualified Git +import qualified Git.Branch import Git.Types (BlobType(..)) import Config import Annex.ReplaceFile @@ -29,17 +29,17 @@ import qualified Data.Set as S {- Merges from a branch into the current branch - (which may not exist yet), - with automatic merge conflict resolution. -} -autoMergeFrom :: Git.Ref -> (Maybe Git.Ref) -> Annex Bool -autoMergeFrom branch currbranch = do +autoMergeFrom :: Git.Ref -> (Maybe Git.Ref) -> Git.Branch.CommitMode -> Annex Bool +autoMergeFrom branch currbranch commitmode = do showOutput case currbranch of Nothing -> go Nothing Just b -> go =<< inRepo (Git.Ref.sha b) where go old = ifM isDirect - ( mergeDirect currbranch old branch (resolveMerge old branch) - , inRepo (Git.Merge.mergeNonInteractive branch) - <||> (resolveMerge old branch <&&> commitResolvedMerge) + ( mergeDirect currbranch old branch (resolveMerge old branch) commitmode + , inRepo (Git.Merge.mergeNonInteractive branch commitmode) + <||> (resolveMerge old branch <&&> commitResolvedMerge commitmode) ) {- Resolves a conflicted merge. It's important that any conflicts be @@ -166,10 +166,9 @@ cleanConflictCruft resolvedfs top = do matchesresolved f = S.member (base f) s base f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f -commitResolvedMerge :: Annex Bool -commitResolvedMerge = inRepo $ Git.Command.runBool - [ Param "commit" - , Param "--no-verify" +commitResolvedMerge :: Git.Branch.CommitMode -> Annex Bool +commitResolvedMerge commitmode = inRepo $ Git.Branch.commitCommand commitmode + [ Param "--no-verify" , Param "-m" , Param "git-annex automatic merge conflict fix" ] diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 108f97b14..3443730d2 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -92,7 +92,7 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha fromMaybe (error $ "failed to create " ++ fromRef name) <$> branchsha go False = withIndex' True $ - inRepo $ Git.Branch.commitAlways "branch created" fullname [] + inRepo $ Git.Branch.commitAlways Git.Branch.AutomaticCommit "branch created" fullname [] use sha = do setIndexSha sha return sha @@ -252,7 +252,7 @@ commitIndex jl branchref message parents = do commitIndex' :: JournalLocked -> Git.Ref -> String -> [Git.Ref] -> Annex () commitIndex' jl branchref message parents = do updateIndex jl branchref - committedref <- inRepo $ Git.Branch.commitAlways message fullname parents + committedref <- inRepo $ Git.Branch.commitAlways Git.Branch.AutomaticCommit message fullname parents setIndexSha committedref parentrefs <- commitparents <$> catObject committedref when (racedetected branchref parentrefs) $ @@ -471,7 +471,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do Annex.Queue.flush if neednewlocalbranch then do - committedref <- inRepo $ Git.Branch.commitAlways message fullname transitionedrefs + committedref <- inRepo $ Git.Branch.commitAlways Git.Branch.AutomaticCommit message fullname transitionedrefs setIndexSha committedref else do ref <- getBranch diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 6e14c6b9b..356354aa9 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -151,8 +151,8 @@ addDirect file cache = do - Then the work tree is updated to reflect the merge, and - finally, the merge is committed and the real index updated. -} -mergeDirect :: Maybe Git.Ref -> Maybe Git.Ref -> Git.Branch -> Annex Bool -> Annex Bool -mergeDirect startbranch oldref branch resolvemerge = do +mergeDirect :: Maybe Git.Ref -> Maybe Git.Ref -> Git.Branch -> Annex Bool -> Git.Branch.CommitMode -> Annex Bool +mergeDirect startbranch oldref branch resolvemerge commitmode = do -- Use the index lock file as the temp index file. -- This is actually what git does when updating the index, -- and so it will prevent other git processes from making @@ -168,19 +168,19 @@ mergeDirect startbranch oldref branch resolvemerge = do createDirectoryIfMissing True d withIndexFile tmpi $ do - merged <- stageMerge d branch + merged <- stageMerge d branch commitmode r <- if merged then return True else resolvemerge mergeDirectCleanup d (fromMaybe Git.Sha.emptyTree oldref) - mergeDirectCommit merged startbranch branch + mergeDirectCommit merged startbranch branch commitmode liftIO $ rename tmpi reali return r {- Stage a merge into the index, avoiding changing HEAD or the current - branch. -} -stageMerge :: FilePath -> Git.Branch -> Annex Bool -stageMerge d branch = do +stageMerge :: FilePath -> Git.Branch -> Git.Branch.CommitMode -> Annex Bool +stageMerge d branch commitmode = do -- XXX A bug in git makes stageMerge unsafe to use if the git repo -- is configured with core.symlinks=false -- Using mergeNonInteractive is not ideal though, since it will @@ -190,7 +190,7 @@ stageMerge d branch = do -- <http://marc.info/?l=git&m=140262402204212&w=2> merger <- ifM (coreSymlinks <$> Annex.getGitConfig) ( return Git.Merge.stageMerge - , return Git.Merge.mergeNonInteractive + , return $ \ref -> Git.Merge.mergeNonInteractive ref commitmode ) inRepo $ \g -> merger branch $ g { location = Local { gitdir = Git.localGitDir g, worktree = Just d } } @@ -198,8 +198,8 @@ stageMerge d branch = do {- Commits after a direct mode merge is complete, and after the work - tree has been updated by mergeDirectCleanup. -} -mergeDirectCommit :: Bool -> Maybe Git.Ref -> Git.Branch -> Annex () -mergeDirectCommit allowff old branch = do +mergeDirectCommit :: Bool -> Maybe Git.Ref -> Git.Branch -> Git.Branch.CommitMode -> Annex () +mergeDirectCommit allowff old branch commitmode = do void preCommitDirect d <- fromRepo Git.localGitDir let merge_head = d </> "MERGE_HEAD" @@ -211,7 +211,7 @@ mergeDirectCommit allowff old branch = do msg <- liftIO $ catchDefaultIO ("merge " ++ fromRef branch) $ readFile merge_msg - void $ inRepo $ Git.Branch.commit False msg + void $ inRepo $ Git.Branch.commit commitmode False msg Git.Ref.headRef [Git.Ref.headRef, branch] ) liftIO $ mapM_ nukeFile [merge_head, merge_msg, merge_mode] diff --git a/Annex/MakeRepo.hs b/Annex/MakeRepo.hs index 695edd5f8..a1f797a76 100644 --- a/Annex/MakeRepo.hs +++ b/Annex/MakeRepo.hs @@ -12,6 +12,7 @@ import Annex.Init import qualified Git.Construct import qualified Git.Config import qualified Git.Command +import qualified Git.Branch import qualified Annex import Annex.UUID import Annex.Direct @@ -50,9 +51,8 @@ initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do {- Initialize the master branch, so things that expect - to have it will work, before any files are added. -} unlessM (Git.Config.isBare <$> gitRepo) $ - void $ inRepo $ Git.Command.runBool - [ Param "commit" - , Param "--quiet" + void $ inRepo $ Git.Branch.commitCommand Git.Branch.AutomaticCommit + [ Param "--quiet" , Param "--allow-empty" , Param "-m" , Param "created repository" diff --git a/Annex/View.hs b/Annex/View.hs index 5cf21cdfe..b96981612 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -433,7 +433,7 @@ genViewBranch :: View -> Annex () -> Annex Git.Branch genViewBranch view a = withIndex $ do a let branch = branchView view - void $ inRepo $ Git.Branch.commit True (fromRef branch) branch [] + void $ inRepo $ Git.Branch.commit Git.Branch.AutomaticCommit True (fromRef branch) branch [] return branch {- Runs an action using the view index file. diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 2b60e42f3..afe4aa144 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -221,7 +221,7 @@ commitStaged = do case v of Left _ -> return False Right _ -> do - ok <- Command.Sync.commitStaged "" + ok <- Command.Sync.commitStaged Git.Branch.AutomaticCommit "" when ok $ Command.Sync.updateSyncBranch =<< inRepo Git.Branch.current return ok diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index 03bcf0aad..8d660da06 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -83,7 +83,7 @@ onChange file [ "merging", Git.fromRef changedbranch , "into", Git.fromRef current ] - void $ liftAnnex $ autoMergeFrom changedbranch (Just current) + void $ liftAnnex $ autoMergeFrom changedbranch (Just current) Git.Branch.AutomaticCommit mergecurrent _ = noop handleDesynced = case fromTaggedBranch changedbranch of diff --git a/Command/Direct.hs b/Command/Direct.hs index 9727549b6..a5165a4a2 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -12,8 +12,8 @@ import Control.Exception.Extensible import Common.Annex import Command import qualified Git -import qualified Git.Command import qualified Git.LsFiles +import qualified Git.Branch import Config import Annex.Direct import Annex.Exception @@ -33,9 +33,8 @@ perform :: CommandPerform perform = do showStart "commit" "" showOutput - _ <- inRepo $ Git.Command.runBool - [ Param "commit" - , Param "-a" + _ <- inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit + [ Param "-a" , Param "-m" , Param "commit before switching to direct mode" ] diff --git a/Command/Indirect.hs b/Command/Indirect.hs index acf40c974..4ce4c2c38 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -12,7 +12,7 @@ import Control.Exception.Extensible import Common.Annex import Command import qualified Git -import qualified Git.Command +import qualified Git.Branch import qualified Git.LsFiles import Git.FileMode import Config @@ -49,9 +49,8 @@ perform = do showStart "commit" "" whenM stageDirect $ do showOutput - void $ inRepo $ Git.Command.runBool - [ Param "commit" - , Param "-m" + void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit + [ Param "-m" , Param "commit before switching to indirect mode" ] showEndOk diff --git a/Command/Sync.hs b/Command/Sync.hs index 983689118..50c6fbe69 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -127,14 +127,12 @@ commit = next $ next $ ifM isDirect showStart "commit" "" void stageDirect void preCommitDirect - commitStaged commitmessage + commitStaged Git.Branch.ManualCommit commitmessage , do showStart "commit" "" Annex.Branch.commit "update" - -- Commit will fail when the tree is clean, so ignore failure. - _ <- inRepo $ tryIO . Git.Command.runQuiet - [ Param "commit" - , Param "-a" + inRepo $ Git.Branch.commitQuiet Git.Branch.ManualCommit + [ Param "-a" , Param "-m" , Param commitmessage ] @@ -143,14 +141,14 @@ commit = next $ next $ ifM isDirect where commitmessage = "git-annex automatic sync" -commitStaged :: String -> Annex Bool -commitStaged commitmessage = go =<< inRepo Git.Branch.currentUnsafe +commitStaged :: Git.Branch.CommitMode -> String -> Annex Bool +commitStaged commitmode commitmessage = go =<< inRepo Git.Branch.currentUnsafe where go Nothing = return False go (Just branch) = do runAnnexHook preCommitAnnexHook parent <- inRepo $ Git.Ref.sha branch - void $ inRepo $ Git.Branch.commit False commitmessage branch + void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch (maybeToList parent) return True @@ -169,7 +167,7 @@ mergeLocal (Just branch) = go =<< needmerge go False = stop go True = do showStart "merge" $ Git.Ref.describe syncbranch - next $ next $ autoMergeFrom syncbranch (Just branch) + next $ next $ autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit pushLocal :: Maybe Git.Ref -> CommandStart pushLocal b = do @@ -221,7 +219,7 @@ mergeRemote remote b = case b of Just thisbranch -> and <$> (mapM (merge (Just thisbranch)) =<< tomerge (branchlist b)) where - merge thisbranch = flip autoMergeFrom thisbranch . remoteBranch remote + merge thisbranch br = autoMergeFrom (remoteBranch remote br) thisbranch Git.Branch.ManualCommit tomerge = filterM (changed remote) branchlist Nothing = [] branchlist (Just branch) = [branch, syncBranch branch] diff --git a/Command/Unannex.hs b/Command/Unannex.hs index daa14ce85..9cb88564c 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -16,6 +16,7 @@ import qualified Annex import Annex.Content import Annex.Content.Direct import qualified Git.Command +import qualified Git.Branch import qualified Git.Ref import qualified Git.DiffTree as DiffTree import Utility.CopyFile @@ -45,9 +46,8 @@ wrapUnannex a = ifM isDirect ) ) where - commit = inRepo $ Git.Command.run - [ Param "commit" - , Param "-q" + commit = inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit + [ Param "-q" , Param "--allow-empty" , Param "--no-verify" , Param "-m", Param "content removed from git annex" diff --git a/Git/Branch.hs b/Git/Branch.hs index 7c7e44d75..98838ef15 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -103,6 +103,28 @@ fastForward branch (first:rest) repo = (False, True) -> findbest c rs -- worse (False, False) -> findbest c rs -- same +{- The user may have set commit.gpgsign, indending all their manual + - commits to be signed. But signing automatic/background commits could + - easily lead to unwanted gpg prompts or failures. + -} +data CommitMode = ManualCommit | AutomaticCommit + deriving (Eq) + +{- Commit via the usual git command. -} +commitCommand :: CommitMode -> [CommandParam] -> Repo -> IO Bool +commitCommand = commitCommand' runBool + +{- Commit will fail when the tree is clean. This suppresses that error. -} +commitQuiet :: CommitMode -> [CommandParam] -> Repo -> IO () +commitQuiet commitmode ps = void . tryIO . commitCommand' runQuiet commitmode ps + +commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> [CommandParam] -> Repo -> IO a +commitCommand' runner commitmode ps = runner (Param "commit" : ps') + where + ps' + | commitmode == AutomaticCommit = Param "--no-gpg-sign" : ps + | otherwise = ps + {- Commits the index into the specified branch (or other ref), - with the specified parent refs, and returns the committed sha. - @@ -112,8 +134,8 @@ fastForward branch (first:rest) repo = - Unlike git-commit, does not run any hooks, or examine the work tree - in any way. -} -commit :: Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha) -commit allowempty message branch parentrefs repo = do +commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha) +commit commitmode allowempty message branch parentrefs repo = do tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo ifM (cancommit tree) @@ -126,16 +148,18 @@ commit allowempty message branch parentrefs repo = do , return Nothing ) where - ps = concatMap (\r -> ["-p", fromRef r]) parentrefs + ps = + (if commitmode == AutomaticCommit then ["--no-gpg-sign"] else []) + ++ concatMap (\r -> ["-p", fromRef r]) parentrefs cancommit tree | allowempty = return True | otherwise = case parentrefs of [p] -> maybe False (tree /=) <$> Git.Ref.tree p repo _ -> return True -commitAlways :: String -> Branch -> [Ref] -> Repo -> IO Sha -commitAlways message branch parentrefs repo = fromJust - <$> commit True message branch parentrefs repo +commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha +commitAlways commitmode message branch parentrefs repo = fromJust + <$> commit commitmode True message branch parentrefs repo {- A leading + makes git-push force pushing a branch. -} forcePush :: String -> String diff --git a/Git/Merge.hs b/Git/Merge.hs index d661db978..12dfa7c1f 100644 --- a/Git/Merge.hs +++ b/Git/Merge.hs @@ -11,14 +11,19 @@ import Common import Git import Git.Command import Git.BuildVersion +import Git.Branch (CommitMode(..)) {- Avoids recent git's interactive merge. -} -mergeNonInteractive :: Ref -> Repo -> IO Bool -mergeNonInteractive branch +mergeNonInteractive :: Ref -> CommitMode -> Repo -> IO Bool +mergeNonInteractive branch commitmode | older "1.7.7.6" = merge [Param $ fromRef branch] - | otherwise = merge [Param "--no-edit", Param $ fromRef branch] + | otherwise = merge $ [Param "--no-edit", Param $ fromRef branch] where - merge ps = runBool $ Param "merge" : ps + merge ps = runBool $ cp ++ [Param "merge"] ++ ps + cp + | commitmode == AutomaticCommit = + [Param "-c", Param "commit.gpgsign=false"] + | otherwise = [] {- Stage the merge into the index, but do not commit it.-} stageMerge :: Ref -> Repo -> IO Bool @@ -1406,9 +1406,9 @@ clonerepo testenv old new bare = do ensuretmpdir let b = if bare then " --bare" else "" boolSystem "git" [Params ("clone -q" ++ b), File old, File new] @? "git clone failed" + configrepo testenv new indir testenv new $ git_annex testenv "init" ["-q", new] @? "git annex init failed" - configrepo testenv new unless bare $ indir testenv new $ handleforcedirect testenv @@ -1416,8 +1416,11 @@ clonerepo testenv old new bare = do configrepo :: TestEnv -> FilePath -> IO () configrepo testenv dir = indir testenv dir $ do + -- ensure git is set up to let commits happen boolSystem "git" [Params "config user.name", Param "Test User"] @? "git config failed" boolSystem "git" [Params "config user.email test@example.com"] @? "git config failed" + -- avoid signed commits by test suite + boolSystem "git" [Params "config commit.gpgsign false"] @? "git config failed" handleforcedirect :: TestEnv -> IO () handleforcedirect testenv = when (M.lookup "FORCEDIRECT" testenv == Just "1") $ diff --git a/debian/changelog b/debian/changelog index 4550e7983..d08a08715 100644 --- a/debian/changelog +++ b/debian/changelog @@ -14,6 +14,8 @@ git-annex (5.20140614) UNRELEASED; urgency=medium * importfeed: When annex.genmetadata is set, metadata from the feed is added to files that are imported from it. * Android: patch git to avoid fchmod, which fails on /sdcard. + * Support users who have set commit.gpgsign, by disabling gpg signatures + for git-annex branch commits and commits made by the assistant. -- Joey Hess <joeyh@debian.org> Mon, 16 Jun 2014 11:28:42 -0400 |