post-recive hook to make updateInstead work in direct mode and adjusted branches

* Added post-recieve hook, which makes updateInstead work with direct
  mode and adjusted branches.
* init: Set up the post-receive hook.

This commit was sponsored by Fernando Jimenez on Patreon.

Annex/Hook.hs

@@ -4,7 +4,7 @@
  - not change, otherwise removing old hooks using an old version of
  - the script would fail.
  -
- - Copyright 2013-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -22,6 +22,9 @@ import qualified Data.Map as M
 preCommitHook :: Git.Hook
 preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .")
 
+postReceiveHook :: Git.Hook
+postReceiveHook = Git.Hook "post-receive" (mkHookScript "git annex post-receive")
+
 preCommitAnnexHook :: Git.Hook
 preCommitAnnexHook = Git.Hook "pre-commit-annex" ""
 

Annex/Init.hs

@@ -83,8 +83,9 @@ initialize' mversion = do
 	checkLockSupport
 	checkFifoSupport
 	checkCrippledFileSystem
-	unlessM isBareRepo $
+	unlessM isBareRepo $ do
 		hookWrite preCommitHook
+		hookWrite postReceiveHook
 	setDifferences
 	unlessM (isJust <$> getVersion) $
 		setVersion (fromMaybe defaultVersion mversion)
@@ -114,6 +115,7 @@ initialize' mversion = do
 uninitialize :: Annex ()
 uninitialize = do
 	hookUnWrite preCommitHook
+	hookUnWrite postReceiveHook
 	removeRepoUUID
 	removeVersion
 

Annex/Perms.hs

@@ -24,7 +24,7 @@ module Annex.Perms (
 
 import Annex.Common
 import Utility.FileMode
-import Git.SharedRepository
+import Git.ConfigTypes
 import qualified Annex
 import Config
 

CHANGELOG

@@ -12,6 +12,9 @@ git-annex (6.20170215) UNRELEASED; urgency=medium
   * sync: Improve integration with receive.denyCurrentBranch=updateInstead,
     displaying error messages from the remote then it fails to update
     its checked out branch.
+  * Added post-recieve hook, which makes updateInstead work with direct
+    mode and adjusted branches.
+  * init: Set up the post-receive hook.
   * config group groupwanted numcopies schedule wanted required: 
     Avoid displaying extraneous messages about repository auto-init,
     git-annex branch merging, etc, when being used to get information.

CmdLine/GitAnnex.hs

@@ -61,6 +61,7 @@ import qualified Command.AddUnused
 import qualified Command.Unlock
 import qualified Command.Lock
 import qualified Command.PreCommit
+import qualified Command.PostReceive
 import qualified Command.Find
 import qualified Command.FindRef
 import qualified Command.Whereis
@@ -148,6 +149,7 @@ cmds testoptparser testrunner =
 	, Command.Uninit.cmd
 	, Command.Reinit.cmd
 	, Command.PreCommit.cmd
+	, Command.PostReceive.cmd
 	, Command.NumCopies.cmd
 	, Command.Trust.cmd
 	, Command.Untrust.cmd

Command/Merge.hs

@@ -17,9 +17,9 @@ cmd = command "merge" SectionMaintenance
 	paramNothing (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = do
+seek _ = do
-	withNothing mergeBranch ps
+	commandAction mergeBranch
-	withNothing mergeSynced ps
+	commandAction mergeSynced
 
 mergeBranch :: CommandStart
 mergeBranch = do

Command/PostReceive.hs

@@ -0,0 +1,61 @@
+{- git-annex command
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Command.PostReceive where
+
+import Command
+import qualified Annex
+import Config
+import Annex.Version
+import Annex.AdjustedBranch
+import Git.Branch
+import Git.Types
+import Git.ConfigTypes
+import qualified Command.Merge
+
+cmd :: Command
+cmd = command "post-receive" SectionPlumbing
+	"run by git post-receive hook"
+	paramNothing
+	(withParams seek)
+
+seek :: CmdParams -> CommandSeek
+seek _ = whenM needUpdateInsteadEmulation $ do
+	fixPostReceiveHookEnv
+	updateInsteadEmulation
+
+{- When run by the post-receive hook, the cwd is the .git directory, 
+ - and GIT_DIR=. It's not clear why git does this.
+ -
+ - Fix up from that unusual situation, so that git commands
+ - won't try to treat .git as the work tree. -}
+fixPostReceiveHookEnv :: Annex ()
+fixPostReceiveHookEnv = do
+	g <- Annex.gitRepo
+	case location g of
+		Local { gitdir = ".", worktree = Just "." } ->
+			Annex.adjustGitRepo $ \g' -> pure $ g'
+				{ location = (location g')
+					{ worktree = Just ".." }
+				}
+		_ -> noop
+
+{- receive.denyCurrentBranch=updateInstead does not work in direct mode
+ - repositories or when an adjusted branch is checked out, so must be
+ - emulated. -}
+needUpdateInsteadEmulation :: Annex Bool
+needUpdateInsteadEmulation = updateinsteadset <&&> (isDirect <||> isadjusted)
+  where
+	updateinsteadset = (== UpdateInstead) . receiveDenyCurrentBranch
+		<$> Annex.getGitConfig
+	isadjusted = versionSupportsUnlockedPointers
+		<&&> (maybe False (isJust . getAdjustment) <$> inRepo Git.Branch.current)
+
+updateInsteadEmulation :: Annex ()
+updateInsteadEmulation = commandAction Command.Merge.mergeSynced

Git/ConfigTypes.hs

@@ -1,11 +1,11 @@
-{- git core.sharedRepository handling
+{- git config types
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012, 2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Git.SharedRepository where
+module Git.ConfigTypes where
 
 import Data.Char
 
@@ -14,6 +14,7 @@ import Git
 import qualified Git.Config
 
 data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int
+	deriving (Eq)
 
 getSharedRepository :: Repo -> SharedRepository
 getSharedRepository r =
@@ -26,3 +27,14 @@ getSharedRepository r =
 		"world" -> AllShared
 		"everybody" -> AllShared
 		v -> maybe UnShared UmaskShared (readish v)
+
+data DenyCurrentBranch = UpdateInstead | RefusePush | WarnPush | IgnorePush
+	deriving (Eq)
+
+getDenyCurrentBranch :: Repo -> DenyCurrentBranch
+getDenyCurrentBranch r =
+	case map toLower $ Git.Config.get "receive.denycurrentbranch" "" r of
+		"updateinstead" -> UpdateInstead
+		"warn" -> WarnPush
+		"ignore" -> IgnorePush
+		_ -> RefusePush

Types/GitConfig.hs

@@ -18,7 +18,7 @@ import Common
 import qualified Git
 import qualified Git.Config
 import qualified Git.Construct
-import Git.SharedRepository
+import Git.ConfigTypes
 import Utility.DataUnits
 import Config.Cost
 import Types.UUID
@@ -84,6 +84,7 @@ data GitConfig = GitConfig
 	, annexAddUnlocked :: Bool
 	, coreSymlinks :: Bool
 	, coreSharedRepository :: SharedRepository
+	, receiveDenyCurrentBranch :: DenyCurrentBranch
 	, gcryptId :: Maybe String
 	, gpgCmd :: GpgCmd
 	}
@@ -137,6 +138,7 @@ extractGitConfig r = GitConfig
 	, annexAddUnlocked = getbool (annex "addunlocked") False
 	, coreSymlinks = getbool "core.symlinks" True
 	, coreSharedRepository = getSharedRepository r
+	, receiveDenyCurrentBranch = getDenyCurrentBranch r
 	, gcryptId = getmaybe "core.gcrypt-id"
 	, gpgCmd = mkGpgCmd (getmaybe "gpg.program")
 	}

doc/git-annex-post-receive.mdwn

@@ -0,0 +1,34 @@
+# NAME
+
+git-annex post-receive - run by git post-receive hook
+
+# SYNOPSIS
+
+git annex post-receive
+
+# DESCRIPTION
+
+This is meant to be called from git's post-receive hook. `git annex init`
+automatically creates a post-receive hook using this.
+
+When a repository is configured with receive.denyCurrentBranch=updateInstead,
+pushes to the repository update its work tree. However, that does not work
+for repositories that use direct mode or have an adjusted branch checked
+out. The hook updates the work tree when run in such a repository,
+the same as running `git-annex merge` would.
+
+# SEE ALSO
+
+[[git-annex]](1)
+
+[[git-annex-direct]](1)
+
+[[git-annex-adjust]](1)
+
+[[git-annex-merge]](1)
+
+# AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.

doc/git-annex.mdwn

@@ -542,6 +542,13 @@ subdirectories).
   
   See [[git-annex-pre-commit]](1) for details.
 
+* `post-receive`
+
+  This is meant to be called from git's post-receive hook. `git annex init`
+  automatically creates a post-receive hook using this.
+  
+  See [[git-annex-post-receive]](1) for details.
+
 * `lookupkey [file ...]`
 
   Looks up key used for file.

git-annex.cabal

@@ -743,6 +743,7 @@ Executable git-annex
     Command.NotifyChanges
     Command.NumCopies
     Command.P2P
+    Command.PostReceive
     Command.PreCommit
     Command.Proxy
     Command.ReKey
@@ -814,6 +815,7 @@ Executable git-annex
     Git.Command
     Git.Command.Batch
     Git.Config
+    Git.ConfigTypes
     Git.Construct
     Git.CurrentRepo
     Git.DiffTree
@@ -839,7 +841,6 @@ Executable git-annex
     Git.Remote.Remove
     Git.Repair
     Git.Sha
-    Git.SharedRepository
     Git.Status
     Git.Tree
     Git.Types