sync hack to make updateInstead work on eg FAT

sync: When syncing with a local repository located on a crippled
filesystem, run the post-receive hook there, since it wouldn't get run
otherwise. This makes pushing to repos on FAT-formatted removable drives
update them when receive.denyCurrentBranch=updateInstead.

Made Remote.Git export onLocal, which was cleaned up to not have so many
caveats about its use.

This commit was sponsored by Jeff Goeke-Smith on Patreon.

2 files changed, 30 insertions, 27 deletions

diff --git a/Command/PostReceive.hs b/Command/PostReceive.hs
index 2110333f0..84652f20d 100644
--- a/Command/PostReceive.hs
+++ b/Command/PostReceive.hs
@@ -5,19 +5,13 @@
  - 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
+import Annex.UpdateInstead
+import Command.Sync (mergeLocal, prepMerge, mergeConfig, getCurrBranch)
 
 cmd :: Command
 cmd = command "post-receive" SectionPlumbing
@@ -28,7 +22,7 @@ cmd = command "post-receive" SectionPlumbing
 seek :: CmdParams -> CommandSeek
 seek _ = whenM needUpdateInsteadEmulation $ do
 	fixPostReceiveHookEnv
-	updateInsteadEmulation
+	commandAction 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.
@@ -46,16 +40,7 @@ fixPostReceiveHookEnv = do
 				}
 		_ -> 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
+updateInsteadEmulation :: CommandStart
+updateInsteadEmulation = do
+	prepMerge
+	mergeLocal mergeConfig =<< join getCurrBranch
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 78a66a14a..0d5d46b2f 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -1,7 +1,7 @@
 {- git-annex command
  -
  - Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
- - Copyright 2011-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -40,6 +40,7 @@ import qualified Git
 import qualified Remote.Git
 import Config
 import Config.GitConfig
+import Config.Files
 import Annex.Wanted
 import Annex.Content
 import Command.Get (getKey')
@@ -51,6 +52,7 @@ import Annex.AutoMerge
 import Annex.AdjustedBranch
 import Annex.Ssh
 import Annex.BloomFilter
+import Annex.UpdateInstead
 import Utility.Bloom
 import Utility.OptParse
 
@@ -377,14 +379,30 @@ pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> need
 		showOutput
 		ok <- inRepoWithSshOptionsTo (Remote.repo remote) (Remote.gitconfig remote) $
 			pushBranch remote branch
-		unless ok $ do
-			warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
-			showLongNote "(non-fast-forward problems can be solved by setting receive.denyNonFastforwards to false in the remote's git config)"
-		return ok
+		if ok
+			then postpushupdate
+			else do
+				warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]
+				showLongNote "(non-fast-forward problems can be solved by setting receive.denyNonFastforwards to false in the remote's git config)"
+				return ok
   where
 	needpush
 		| remoteAnnexReadOnly (Remote.gitconfig remote) = return False
 		| otherwise = anyM (newer remote) [syncBranch branch, Annex.Branch.name]
+	-- Do updateInstead emulation for remotes on eg removable drives
+	-- formatted FAT, where the post-update hook won't run.
+	postpushupdate
+		| maybe False annexCrippledFileSystem (remoteGitConfig (Remote.gitconfig remote)) = 
+			case Git.repoWorkTree (Remote.repo remote) of
+				Nothing -> return True
+				Just wt -> ifM (Remote.Git.onLocal remote needUpdateInsteadEmulation)
+					( liftIO $ do
+						p <- readProgramFile
+						boolSystem' p [Param "post-receive"]
+							(\cp -> cp { cwd = Just wt })
+					, return True
+					)
+		| otherwise = return True
 
 {- Pushes a regular branch like master to a remote. Also pushes the git-annex
  - branch.