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.

12 files changed, 138 insertions, 11 deletions

diff --git a/Annex/Hook.hs b/Annex/Hook.hs
index a073c2598..b53914505 100644
--- a/Annex/Hook.hs
+++ b/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" ""
 
diff --git a/Annex/Init.hs b/Annex/Init.hs
index 74274ad7f..3427c0049 100644
--- a/Annex/Init.hs
+++ b/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
 
diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index 80eb71f37..1ce342911 100644
--- a/Annex/Perms.hs
+++ b/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
 
diff --git a/CHANGELOG b/CHANGELOG
index f5c0f3ce5..871018701 100644
--- a/CHANGELOG
+++ b/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.
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 99cf564cc..0e472005c 100644
--- a/CmdLine/GitAnnex.hs
+++ b/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
diff --git a/Command/Merge.hs b/Command/Merge.hs
index 4f1913978..80a8227d1 100644
--- a/Command/Merge.hs
+++ b/Command/Merge.hs
@@ -17,9 +17,9 @@ cmd = command "merge" SectionMaintenance
 	paramNothing (withParams seek)
 
 seek :: CmdParams -> CommandSeek
-seek ps = do
-	withNothing mergeBranch ps
-	withNothing mergeSynced ps
+seek _ = do
+	commandAction mergeBranch
+	commandAction mergeSynced
 
 mergeBranch :: CommandStart
 mergeBranch = do
diff --git a/Command/PostReceive.hs b/Command/PostReceive.hs
new file mode 100644
index 000000000..2110333f0
--- /dev/null
+++ b/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
diff --git a/Git/SharedRepository.hs b/Git/ConfigTypes.hs
index 1e7382388..af3dc976d 100644
--- a/Git/SharedRepository.hs
+++ b/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
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index fb25f2f26..af901fcf1 100644
--- a/Types/GitConfig.hs
+++ b/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")
 	}
diff --git a/doc/git-annex-post-receive.mdwn b/doc/git-annex-post-receive.mdwn
new file mode 100644
index 000000000..9fa9e314d
--- /dev/null
+++ b/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.
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 63f58d9e4..525900d92 100644
--- a/doc/git-annex.mdwn
+++ b/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.
diff --git a/git-annex.cabal b/git-annex.cabal
index 2cd605e0b..8b9a6b2f5 100644
--- a/git-annex.cabal
+++ b/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