From 615053c624b357520ef01db60c58e60d848a44bd Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 17 Feb 2017 14:04:43 -0400
Subject: 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.
---
 Command/Merge.hs       |  6 ++---
 Command/PostReceive.hs | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 64 insertions(+), 3 deletions(-)
 create mode 100644 Command/PostReceive.hs

(limited to 'Command')

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
-- 
cgit v1.2.3