From 2b97f5381a5417e3df77820bf4144e9a2b00c6fa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 26 Dec 2011 14:25:37 -0400 Subject: [PATCH] add tweak-fetch command, for use in the tweak-fetch hook tweak-fetch is a new git hook I have developed (not yet accepted into git, but looking bright). Amoung other things, the hook can be used to observe what is being fetched, notice remote git-annex branches that might be updated, and merge them into the git-annex branch. This will solve problems where users do a git pull, immediately followed by a push, and it refuses to push because their git-annex branch is diverged, and they neither ran git annex merge by hand, nor ran other git-annex commands that auto-merge. The tweak-fetch is written by git annex init. Of course, existing repositories won't have it, which is ok, because git-annex still automatically does a merge if changed branches have appeared. Indeed, it will always need to do that check, as long as it needs to support support git-annex branches that might be updated by other means. Eventually though, I will want to ensure all repositories have the tweak-fetch hook. Perhaps a minor verison upgrade to ensure it is added? A subtlety of the hook is that when it's run, the remote tracking refs have not yet been updated. So Annex.Branch.updateTo has to be careful to only use the sha1 that was fetched, not the branch name. The branch name is only used in the commit message. The other tricky thing is that git tweak-fetch hook should *only* output lines in a specific format, and git will be unhappy if it also outputs status messages, etc. So those messages are sent to stderr. --- Annex/Branch.hs | 23 ++++++++++++------ Command/TweakFetch.hs | 34 ++++++++++++++++++++++++++ Git/TweakFetch.hs | 32 +++++++++++++------------ GitAnnex.hs | 2 ++ Init.hs | 55 +++++++++++++++++++++++-------------------- doc/git-annex.mdwn | 5 ++++ 6 files changed, 103 insertions(+), 48 deletions(-) create mode 100644 Command/TweakFetch.hs diff --git a/Annex/Branch.hs b/Annex/Branch.hs index af1878479a..5f678b9d30 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -11,6 +11,7 @@ module Annex.Branch ( hasSibling, create, update, + updateTo, get, change, commit, @@ -81,10 +82,19 @@ getBranch = maybe (hasOrigin >>= go >>= use) (return) =<< branchsha {- Ensures that the branch and index are is up-to-date; should be - called before data is read from it. Runs only once per git-annex run. + -} +update :: Annex () +update = runUpdateOnce $ updateTo =<< siblingBranches + +{- Merges the specified Refs into the index, if they have any changes not + - already in it. The Branch names are only used in the commit message; + - it's even possible that the provided Branches have not been updated to + - point to the Refs yet. - - Before refs are merged into the index, it's important to first stage the - journal into the index. Otherwise, any changes in the journal would - later get staged, and might overwrite changes made during the merge. + - If no Refs are provided, the journal is still staged and committed. - - (It would be cleaner to handle the merge by updating the journal, not the - index, with changes from the branches.) @@ -92,13 +102,13 @@ getBranch = maybe (hasOrigin >>= go >>= use) (return) =<< branchsha - The branch is fast-forwarded if possible, otherwise a merge commit is - made. -} -update :: Annex () -update = runUpdateOnce $ do +updateTo :: [(Git.Ref, Git.Branch)] -> Annex () +updateTo pairs = do -- ensure branch exists, and get its current ref branchref <- getBranch -- check what needs updating before taking the lock dirty <- journalDirty - (refs, branches) <- unzip <$> newerSiblings + (refs, branches) <- unzip <$> filterM isnewer pairs if (not dirty && null refs) then updateIndex branchref else withIndex $ lockJournal $ do @@ -110,7 +120,7 @@ update = runUpdateOnce $ do " into " ++ show name unless (null branches) $ do showSideAction merge_desc - mergeIndex branches + mergeIndex refs ff <- if dirty then return False else inRepo $ Git.Branch.fastForward fullname refs @@ -120,8 +130,7 @@ update = runUpdateOnce $ do (nub $ fullname:refs) invalidateCache where - newerSiblings = filterM isnewer =<< siblingBranches - isnewer (_, b) = inRepo $ Git.Branch.changed fullname b + isnewer (r, _) = inRepo $ Git.Branch.changed fullname r {- Gets the content of a file on the branch, or content from the journal, or - staged in the index. @@ -238,7 +247,7 @@ genIndex :: Git.Repo -> IO () genIndex g = Git.UnionMerge.stream_update_index g [Git.UnionMerge.ls_tree fullname g] -{- Merges the specified branches into the index. +{- Merges the specified refs into the index. - Any changes staged in the index will be preserved. -} mergeIndex :: [Git.Ref] -> Annex () mergeIndex branches = do diff --git a/Command/TweakFetch.hs b/Command/TweakFetch.hs new file mode 100644 index 0000000000..077041b576 --- /dev/null +++ b/Command/TweakFetch.hs @@ -0,0 +1,34 @@ +{- git-annex command + - + - Copyright 2011 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.TweakFetch where + +import Common +import Command +import qualified Git.TweakFetch +import qualified Annex.Branch + +def :: [Command] +def = [command "tweak-fetch" paramNothing seek "run by git tweak-fetch hook"] + +seek :: [CommandSeek] +seek = [ withNothing start] + +start :: CommandStart +start = do + -- First, pass the hook's input through to its output, unchanged. + fetched <- liftIO $ Git.TweakFetch.runHook return + + -- If one of the fetched refs is going to be stored on a git-annex + -- tracking branch, then merge in the new sha for that ref. + let tomerge = filter siblings fetched + unless (null tomerge) $ Annex.Branch.updateTo $ map topairs tomerge + stop + where + siblings f = suffix `isSuffixOf` (show $ Git.TweakFetch.local f) + suffix = "/" ++ show Annex.Branch.name + topairs f = (Git.TweakFetch.sha f, Git.TweakFetch.local f) diff --git a/Git/TweakFetch.hs b/Git/TweakFetch.hs index 8e527829df..41cc0499bd 100644 --- a/Git/TweakFetch.hs +++ b/Git/TweakFetch.hs @@ -5,7 +5,10 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Git.TweakFetch (runHook, runHookUnsafe, FetchedRef(..)) where +module Git.TweakFetch (runHook, FetchedRef(..)) where + +import Data.Either (rights) +import System.Posix.IO import Common import Git @@ -26,24 +29,23 @@ data FetchedRef = FetchedRef - lines are passed through unchanged. -} type HookLine = Either String FetchedRef -{- Runs the hook, allowing lines to be mutated, but never be discarded. -} -runHook :: (FetchedRef -> IO FetchedRef) -> IO () -runHook mutate = runHook' go id +{- Runs the hook, allowing lines to be mutated, but never be discarded. + - Returns same FetchedRefs that are output by the hook, for further use. -} +runHook :: (FetchedRef -> IO FetchedRef) -> IO [FetchedRef] +runHook mutate = do + ls <- mapM go =<< input + output ls + + -- Nothing more should be output to stdout; only hook output + -- is accepted by git. Redirect stdout to stderr. + hFlush stdout + _ <- liftIO $ dupTo stdError stdOutput + + return $ rights ls where go u@(Left _) = return u go (Right r) = Right <$> catchDefaultIO (mutate r) r -{- Runs the hook, allowing lines to be mutated, discarded, or produce - - multiple output lines. -} -runHookUnsafe :: (FetchedRef -> IO [FetchedRef]) -> IO () -runHookUnsafe mutate = runHook' go concat - where - go u@(Left _) = return [u] - go (Right r) = map Right <$> catchDefaultIO (mutate r) [r] - -runHook' :: (HookLine -> IO b) -> ([b] -> [HookLine]) -> IO () -runHook' mutate reduce = output . reduce =<< mapM mutate =<< input - input :: IO [HookLine] input = map parseLine . lines <$> getContents diff --git a/GitAnnex.hs b/GitAnnex.hs index 7243d69cb0..43daf7367b 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -39,6 +39,7 @@ import qualified Command.DropUnused import qualified Command.Unlock import qualified Command.Lock import qualified Command.PreCommit +import qualified Command.TweakFetch import qualified Command.Find import qualified Command.Whereis import qualified Command.Merge @@ -73,6 +74,7 @@ cmds = concat , Command.Unannex.def , Command.Uninit.def , Command.PreCommit.def + , Command.TweakFetch.def , Command.Trust.def , Command.Untrust.def , Command.Semitrust.def diff --git a/Init.hs b/Init.hs index c8deadf3b4..47ac9e3d35 100644 --- a/Init.hs +++ b/Init.hs @@ -24,12 +24,12 @@ initialize mdescription = do prepUUID Annex.Branch.create setVersion - gitPreCommitHookWrite + gitHooksWrite u <- getUUID maybe (recordUUID u) (describeUUID u) mdescription uninitialize :: Annex () -uninitialize = gitPreCommitHookUnWrite +uninitialize = gitHooksUnWrite {- Will automatically initialize if there is already a git-annex branch from somewhere. Otherwise, require a manual init @@ -44,37 +44,40 @@ ensureInitialized = getVersion >>= maybe needsinit checkVersion then initialize Nothing else error "First run: git-annex init" -{- set up a git pre-commit hook, if one is not already present -} -gitPreCommitHookWrite :: Annex () -gitPreCommitHookWrite = unlessBare $ do - hook <- preCommitHook - exists <- liftIO $ doesFileExist hook +{- set up git hooks, if not already present -} +gitHooksWrite :: Annex () +gitHooksWrite = unlessBare $ forM_ hooks $ \(hook, content) -> do + file <- hookFile hook + exists <- liftIO $ doesFileExist file if exists - then warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring" + then warning $ hook ++ " hook (" ++ file ++ ") already exists, not configuring" else liftIO $ do - viaTmp writeFile hook preCommitScript - p <- getPermissions hook - setPermissions hook $ p {executable = True} + viaTmp writeFile file content + p <- getPermissions file + setPermissions file $ p {executable = True} -gitPreCommitHookUnWrite :: Annex () -gitPreCommitHookUnWrite = unlessBare $ do - hook <- preCommitHook - whenM (liftIO $ doesFileExist hook) $ do - c <- liftIO $ readFile hook - if c == preCommitScript - then liftIO $ removeFile hook - else warning $ "pre-commit hook (" ++ hook ++ +gitHooksUnWrite :: Annex () +gitHooksUnWrite = unlessBare $ forM_ hooks $ \(hook, content) -> do + file <- hookFile hook + whenM (liftIO $ doesFileExist file) $ do + c <- liftIO $ readFile file + if c == content + then liftIO $ removeFile file + else warning $ hook ++ " hook (" ++ file ++ ") contents modified; not deleting." ++ " Edit it to remove call to git annex." unlessBare :: Annex () -> Annex () unlessBare = unlessM $ fromRepo $ Git.repoIsLocalBare -preCommitHook :: Annex FilePath -preCommitHook = () <$> fromRepo Git.gitDir <*> pure "hooks/pre-commit" +hookFile :: FilePath -> Annex FilePath +hookFile f = () <$> fromRepo Git.gitDir <*> pure ("hooks/" ++ f) -preCommitScript :: String -preCommitScript = - "#!/bin/sh\n" ++ - "# automatically configured by git-annex\n" ++ - "git annex pre-commit .\n" +hooks :: [(String, String)] +hooks = [ ("pre-commit", hookscript "git annex pre-commit .") + , ("tweak-fetch", hookscript "git annex tweak-fetch") + ] + where + hookscript s = "#!/bin/sh\n" ++ + "# automatically configured by git-annex\n" ++ + s ++ "\n"; diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 8096005ce2..b7fd1b5217 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -344,6 +344,11 @@ subdirectories). This is meant to be called from git's pre-commit hook. `git annex init` automatically creates a pre-commit hook using this. +* tweak-fetch + + This is meant ot be called from git's tweak-fetch hook. `git annex init` + automatically creates a tweak-fetch hook using this. + * fromkey key file This plumbing-level command can be used to manually set up a file