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.
This commit is contained in:
Joey Hess 2017-02-17 15:21:39 -04:00
parent 00464fbed7
commit e6857e75a6
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
6 changed files with 88 additions and 50 deletions

View file

@ -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

View file

@ -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.