a2eb3b450a
This handles cases where a single key is used by multiple files in the exported tree. When using `git-annex push`, the key's content gets stored in the annexobjects location, and then when the branch is pushed, it gets renamed from the annexobjects location to the first exported file. For subsequent exported files, a copy of the content needs to be made. This causes it to download the key from the remote in order to upload another copy to it. This is not needed when using `git push` followed by `git-annex copy --to` the proxied remote, because the received key is stored at all export locations then. Also, fixed handling of the synced branch push, it was exporting master when synced/master was pushed. Note that currently, the first push to the remote does not see that it is able to get a key from it in order to upload it back. It displays "(not available)". The second push is able to. Since git-annex push pushes first the synced branch and then the branch, this does end up with a full export being made, but it is not quite right.
118 lines
3.3 KiB
Haskell
118 lines
3.3 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2017-2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Command.PostReceive where
|
|
|
|
import Command
|
|
import qualified Annex
|
|
import Annex.UpdateInstead
|
|
import Annex.CurrentBranch
|
|
import Command.Sync (mergeLocal, prepMerge, mergeConfig, SyncOptions(..))
|
|
import Annex.Proxy
|
|
import Remote
|
|
import qualified Types.Remote as Remote
|
|
import Config
|
|
import Git.Types
|
|
import Git.Sha
|
|
import Git.FilePath
|
|
import qualified Git.Ref
|
|
import Command.Export (filterExport, getExportCommit, seekExport)
|
|
import Command.Sync (syncBranch)
|
|
|
|
import qualified Data.Set as S
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.ByteString.Char8 as B8
|
|
|
|
-- This does not need to modify the git-annex branch to update the
|
|
-- work tree, but auto-initialization might change the git-annex branch.
|
|
-- Since it would be surprising for a post-receive hook to make such a
|
|
-- change, that's prevented by noCommit.
|
|
cmd :: Command
|
|
cmd = noCommit $
|
|
command "post-receive" SectionPlumbing
|
|
"run by git post-receive hook"
|
|
paramNothing
|
|
(withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek _ = do
|
|
fixPostReceiveHookEnv
|
|
whenM needUpdateInsteadEmulation $
|
|
commandAction updateInsteadEmulation
|
|
proxyExportTree
|
|
|
|
updateInsteadEmulation :: CommandStart
|
|
updateInsteadEmulation = do
|
|
prepMerge
|
|
let o = def { notOnlyAnnexOption = True }
|
|
mc <- mergeConfig False
|
|
mergeLocal mc o =<< getCurrentBranch
|
|
|
|
proxyExportTree :: CommandSeek
|
|
proxyExportTree = do
|
|
rbs <- catMaybes <$> (mapM canexport =<< proxyForRemotes)
|
|
unless (null rbs) $ do
|
|
pushedbranches <- liftIO $
|
|
S.fromList . map snd . parseHookInput
|
|
<$> B.hGetContents stdin
|
|
let waspushed (r, (b, d))
|
|
| S.member (Git.Ref.branchRef b) pushedbranches =
|
|
Just (r, b, d)
|
|
| S.member (Git.Ref.branchRef (syncBranch b)) pushedbranches =
|
|
Just (r, syncBranch b, d)
|
|
| otherwise = Nothing
|
|
case headMaybe (mapMaybe waspushed rbs) of
|
|
Just (r, b, Nothing) -> go r b
|
|
Just (r, b, Just d) -> go r $
|
|
Git.Ref.branchFileRef b (getTopFilePath d)
|
|
Nothing -> noop
|
|
where
|
|
canexport r = case remoteAnnexTrackingBranch (Remote.gitconfig r) of
|
|
Nothing -> return Nothing
|
|
Just branch ->
|
|
ifM (isExportSupported r)
|
|
( return (Just (r, splitRemoteAnnexTrackingBranchSubdir branch))
|
|
, return Nothing
|
|
)
|
|
|
|
go r b = inRepo (Git.Ref.tree b) >>= \case
|
|
Nothing -> return ()
|
|
Just t -> do
|
|
tree <- filterExport r t
|
|
mtbcommitsha <- getExportCommit r b
|
|
seekExport r tree mtbcommitsha [r]
|
|
|
|
parseHookInput :: B.ByteString -> [((Sha, Sha), Ref)]
|
|
parseHookInput = mapMaybe parse . B8.lines
|
|
where
|
|
parse l = case B8.words l of
|
|
(oldb:newb:refb:[]) -> do
|
|
old <- extractSha oldb
|
|
new <- extractSha newb
|
|
return ((old, new), Ref refb)
|
|
_ -> Nothing
|
|
|
|
{- 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 = case location g' of
|
|
loc@(Local {}) -> loc
|
|
{ worktree = Just ".." }
|
|
loc -> loc
|
|
}
|
|
_ -> noop
|
|
|