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.

6 files changed, 88 insertions, 50 deletions

diff --git a/Annex/UpdateInstead.hs b/Annex/UpdateInstead.hs
new file mode 100644
index 000000000..e31bcedaf
--- /dev/null
+++ b/Annex/UpdateInstead.hs
@@ -0,0 +1,27 @@
+{- git-annex UpdateIntead emulation
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.UpdateInstead where
+
+import qualified Annex
+import Annex.Common
+import Config
+import Annex.Version
+import Annex.AdjustedBranch
+import Git.Branch
+import Git.ConfigTypes
+
+{- 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)
diff --git a/CHANGELOG b/CHANGELOG
index 871018701..36ae125b1 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -15,6 +15,10 @@ git-annex (6.20170215) UNRELEASED; urgency=medium
   * Added post-recieve hook, which makes updateInstead work with direct
     mode and adjusted branches.
   * init: Set up the post-receive hook.
+  * 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.
   * 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/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.
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 0a49dd62a..9cb369e4d 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -1,6 +1,6 @@
 {- Standard git remotes.
  -
- - Copyright 2011-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,6 +11,7 @@ module Remote.Git (
 	remote,
 	configRead,
 	repoAvail,
+	onLocal,
 ) where
 
 import Annex.Common
@@ -336,7 +337,7 @@ inAnnex rmt key
 	checkremote = Ssh.inAnnex r key
 	checklocal = guardUsable r (cantCheck r) $
 		maybe (cantCheck r) return
-			=<< onLocal rmt (Annex.Content.inAnnexSafe key)
+			=<< onLocalFast rmt (Annex.Content.inAnnexSafe key)
 
 keyUrls :: Remote -> Key -> [String]
 keyUrls r key = map tourl locs'
@@ -359,7 +360,7 @@ dropKey :: Remote -> Key -> Annex Bool
 dropKey r key
 	| not $ Git.repoIsUrl (repo r) =
 		guardUsable (repo r) (return False) $
-			commitOnCleanup r $ onLocal r $ do
+			commitOnCleanup r $ onLocalFast r $ do
 				ensureInitialized
 				whenM (Annex.Content.inAnnex key) $ do
 					Annex.Content.lockContentForRemoval key $ \lock -> do
@@ -378,7 +379,7 @@ lockKey r key callback
 			-- Lock content from perspective of remote,
 			-- and then run the callback in the original
 			-- annex monad, not the remote's.
-			onLocal r $ 
+			onLocalFast r $ 
 				Annex.Content.lockContentShared key $ \vc ->
 					ifM (Annex.Content.inAnnex key)
 						( liftIO $ inorigrepo $ callback vc
@@ -442,7 +443,7 @@ copyFromRemote' r key file dest meterupdate
 		u <- getUUID
 		hardlink <- wantHardLink
 		-- run copy from perspective of remote
-		onLocal r $ do
+		onLocalFast r $ do
 			ensureInitialized
 			v <- Annex.Content.prepSendAnnex key
 			case v of
@@ -571,7 +572,7 @@ copyToRemote' r key file meterupdate
 		u <- getUUID
 		hardlink <- wantHardLink
 		-- run copy from perspective of remote
-		onLocal r $ ifM (Annex.Content.inAnnex key)
+		onLocalFast r $ ifM (Annex.Content.inAnnex key)
 			( return True
 			, do
 				ensureInitialized
@@ -613,34 +614,36 @@ repairRemote r a = return $ do
 {- Runs an action from the perspective of a local remote.
  -
  - The AnnexState is cached for speed and to avoid resource leaks.
- - However, coprocesses are stopped to avoid git processes hanging
- - around on removable media.
- -
- - The repository's git-annex branch is not updated, as an optimisation.
- - No caller of onLocal can query data from the branch and be ensured
- - it gets a current value. Caller of onLocal can make changes to
- - the branch, however.
+ - However, coprocesses are stopped after each call to avoid git
+ - processes hanging around on removable media.
  -}
 onLocal :: Remote -> Annex a -> Annex a
 onLocal r a = do
 	m <- Annex.getState Annex.remoteannexstate
-	case M.lookup (uuid r) m of
-		Nothing -> do
-			st <- liftIO $ Annex.new (repo r)
-			go st $ do
-				Annex.BranchState.disableUpdate	
-				a
-		Just st -> go st a
+	go =<< maybe
+		(liftIO $ Annex.new $ repo r)
+		return
+		(M.lookup (uuid r) m)
   where
 	cache st = Annex.changeState $ \s -> s
 		{ Annex.remoteannexstate = M.insert (uuid r) st (Annex.remoteannexstate s) }
-	go st a' = do
+	go st = do
 		curro <- Annex.getState Annex.output
 		(ret, st') <- liftIO $ Annex.run (st { Annex.output = curro }) $
-			stopCoProcesses `after` a'
+			stopCoProcesses `after` a
 		cache st'
 		return ret
 
+{- Faster variant of onLocal.
+ -
+ - The repository's git-annex branch is not updated, as an optimisation.
+ - No caller of onLocalFast can query data from the branch and be ensured
+ - it gets the most current value. Caller of onLocalFast can make changes
+ - to the branch, however.
+ -}
+onLocalFast :: Remote -> Annex a -> Annex a
+onLocalFast r a = onLocal r $ Annex.BranchState.disableUpdate >> a
+
 {- Copys a file with rsync unless both locations are on the same
  - filesystem. Then cp could be faster. -}
 rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool
@@ -664,7 +667,7 @@ commitOnCleanup r a = go `after` a
   where
 	go = Annex.addCleanup (RemoteCleanup $ uuid r) cleanup
 	cleanup
-		| not $ Git.repoIsUrl (repo r) = onLocal r $
+		| not $ Git.repoIsUrl (repo r) = onLocalFast r $
 			doQuietSideAction $
 				Annex.Branch.commit "update"
 		| otherwise = void $ do
diff --git a/git-annex.cabal b/git-annex.cabal
index 8b9a6b2f5..75ce82943 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -538,6 +538,7 @@ Executable git-annex
     Annex.Ssh
     Annex.TaggedPush
     Annex.Transfer
+    Annex.UpdateInstead
     Annex.UUID
     Annex.Url
     Annex.VariantFile