git-annex/Annex/TaggedPush.hs
Joey Hess e213ef310f git-annex (5.20140717) unstable; urgency=high
* Fix minor FD leak in journal code. Closes: #754608
  * direct: Fix handling of case where a work tree subdirectory cannot
    be written to due to permissions.
  * migrate: Avoid re-checksumming when migrating from hashE to hash backend.
  * uninit: Avoid failing final removal in some direct mode repositories
    due to file modes.
  * S3: Deal with AWS ACL configurations that do not allow creating or
    checking the location of a bucket, but only reading and writing content to
    it.
  * resolvemerge: New plumbing command that runs the automatic merge conflict
    resolver.
  * Deal with change in git 2.0 that made indirect mode merge conflict
    resolution leave behind old files.
  * sync: Fix git sync with local git remotes even when they don't have an
    annex.uuid set. (The assistant already did so.)
  * Set gcrypt-publish-participants when setting up a gcrypt repository,
    to avoid unncessary passphrase prompts.
    This is a security/usability tradeoff. To avoid exposing the gpg key
    ids who can decrypt the repository, users can unset
    gcrypt-publish-participants.
  * Install nautilus hooks even when ~/.local/share/nautilus/ does not yet
    exist, since it is not automatically created for Gnome 3 users.
  * Windows: Move .vbs files out of git\bin, to avoid that being in the
    PATH, which caused some weird breakage. (Thanks, divB)
  * Windows: Fix locking issue that prevented the webapp starting
    (since 5.20140707).

# imported from the archive
2014-07-17 11:27:25 -04:00

61 lines
2 KiB
Haskell

{- git-annex tagged pushes
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.TaggedPush where
import Common.Annex
import qualified Remote
import qualified Annex.Branch
import qualified Git
import qualified Git.Ref
import qualified Git.Command
import qualified Git.Branch
import Utility.Base64
{- Converts a git branch into a branch that is tagged with a UUID, typically
- the UUID of the repo that will be pushing it, and possibly with other
- information.
-
- Pushing to branches on the remote that have our uuid in them is ugly,
- but it reserves those branches for pushing by us, and so our pushes will
- never conflict with other pushes.
-
- To avoid cluttering up the branch display, the branch is put under
- refs/synced/, rather than the usual refs/remotes/
-
- Both UUIDs and Base64 encoded data are always legal to be used in git
- refs, per git-check-ref-format.
-}
toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Branch
toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes
[ Just "refs/synced"
, Just $ fromUUID u
, toB64 <$> info
, Just $ Git.fromRef $ Git.Ref.base b
]
fromTaggedBranch :: Git.Branch -> Maybe (UUID, Maybe String)
fromTaggedBranch b = case split "/" $ Git.fromRef b of
("refs":"synced":u:info:_base) ->
Just (toUUID u, fromB64Maybe info)
("refs":"synced":u:_base) ->
Just (toUUID u, Nothing)
_ -> Nothing
where
taggedPush :: UUID -> Maybe String -> Git.Ref -> Remote -> Git.Repo -> IO Bool
taggedPush u info branch remote = Git.Command.runBool
[ Param "push"
, Param $ Remote.name remote
{- Using forcePush here is safe because we "own" the tagged branch
- we're pushing; it has no other writers. Ensures it is pushed
- even if it has been rewritten by a transition. -}
, Param $ Git.Branch.forcePush $ refspec Annex.Branch.name
, Param $ refspec branch
]
where
refspec b = Git.fromRef b ++ ":" ++ Git.fromRef (toTaggedBranch u info b)