2011-09-28 19:15:42 +00:00
|
|
|
{- git cat-file interface, with handle automatically stored in the Annex monad
|
|
|
|
-
|
2013-05-15 22:46:38 +00:00
|
|
|
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
|
2011-09-28 19:15:42 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2011-10-04 04:40:47 +00:00
|
|
|
module Annex.CatFile (
|
2011-11-12 21:45:12 +00:00
|
|
|
catFile,
|
detect and recover from branch push/commit race
Dealing with a race without using locking is exceedingly difficult and tricky.
Fully tested, I hope.
There are three places left where the branch can be updated, that are not
covered by the race recovery code. Let's prove they're all immune to the
race:
1. tryFastForwardTo checks to see if a fast-forward can be done,
and then does git-update-ref on the branch to fast-forward it.
If a push comes in before the check, then either no fast-forward
will be done (ok), or the push set the branch to a ref that can
still be fast-forwarded (also ok)
If a push comes in after the check, the git-update-ref will
undo the ref change made by the push. It's as if the push did not come
in, and the next git-push will see this, and try to re-do it.
(acceptable)
2. When creating the branch for the very first time, an empty index
is created, and a commit of it made to the branch. The commit's ref
is recorded as the current state of the index. If a push came in
during that, it will be noticed the next time a commit is made to the
branch, since the branch will have changed. (ok)
3. Creating the branch from an existing remote branch involves making
the branch, and then getting its ref, and recording that the index
reflects that ref.
If a push creates the branch first, git-branch will fail (ok).
If the branch is created and a racing push is then able to change it
(highly unlikely!) we're still ok, because it first records the ref into
the index.lck, and then updating the index. The race can cause the
index.lck to have the old branch ref, while the index has the newly pushed
branch merged into it, but that only results in an unnecessary update of
the index file later on.
2011-12-11 22:39:53 +00:00
|
|
|
catObject,
|
2012-06-10 23:58:34 +00:00
|
|
|
catObjectDetails,
|
2013-01-05 19:26:22 +00:00
|
|
|
catFileHandle,
|
2012-12-12 23:20:38 +00:00
|
|
|
catKey,
|
2013-01-05 19:26:22 +00:00
|
|
|
catKeyFile,
|
2013-08-22 17:57:07 +00:00
|
|
|
catKeyFileHEAD,
|
2011-09-28 19:15:42 +00:00
|
|
|
) where
|
|
|
|
|
2012-06-20 17:13:40 +00:00
|
|
|
import qualified Data.ByteString.Lazy as L
|
2013-05-15 22:46:38 +00:00
|
|
|
import qualified Data.Map as M
|
2011-11-12 21:45:12 +00:00
|
|
|
|
2011-10-05 20:02:51 +00:00
|
|
|
import Common.Annex
|
improve type signatures with a Ref newtype
In git, a Ref can be a Sha, or a Branch, or a Tag. I added type aliases for
those. Note that this does not prevent mixing up of eg, refs and branches
at the type level. Since git really doesn't care, except rare cases like
git update-ref, or git tag -d, that seems ok for now.
There's also a tree-ish, but let's just use Ref for it. A given Sha or Ref
may or may not be a tree-ish, depending on the object type, so there seems
no point in trying to represent it at the type level.
2011-11-16 06:23:34 +00:00
|
|
|
import qualified Git
|
2011-09-28 19:15:42 +00:00
|
|
|
import qualified Git.CatFile
|
|
|
|
import qualified Annex
|
2012-06-10 23:58:34 +00:00
|
|
|
import Git.Types
|
2013-05-12 22:18:48 +00:00
|
|
|
import Git.FilePath
|
2011-09-28 19:15:42 +00:00
|
|
|
|
improve type signatures with a Ref newtype
In git, a Ref can be a Sha, or a Branch, or a Tag. I added type aliases for
those. Note that this does not prevent mixing up of eg, refs and branches
at the type level. Since git really doesn't care, except rare cases like
git update-ref, or git tag -d, that seems ok for now.
There's also a tree-ish, but let's just use Ref for it. A given Sha or Ref
may or may not be a tree-ish, depending on the object type, so there seems
no point in trying to represent it at the type level.
2011-11-16 06:23:34 +00:00
|
|
|
catFile :: Git.Branch -> FilePath -> Annex L.ByteString
|
2011-11-12 21:45:12 +00:00
|
|
|
catFile branch file = do
|
|
|
|
h <- catFileHandle
|
|
|
|
liftIO $ Git.CatFile.catFile h branch file
|
|
|
|
|
detect and recover from branch push/commit race
Dealing with a race without using locking is exceedingly difficult and tricky.
Fully tested, I hope.
There are three places left where the branch can be updated, that are not
covered by the race recovery code. Let's prove they're all immune to the
race:
1. tryFastForwardTo checks to see if a fast-forward can be done,
and then does git-update-ref on the branch to fast-forward it.
If a push comes in before the check, then either no fast-forward
will be done (ok), or the push set the branch to a ref that can
still be fast-forwarded (also ok)
If a push comes in after the check, the git-update-ref will
undo the ref change made by the push. It's as if the push did not come
in, and the next git-push will see this, and try to re-do it.
(acceptable)
2. When creating the branch for the very first time, an empty index
is created, and a commit of it made to the branch. The commit's ref
is recorded as the current state of the index. If a push came in
during that, it will be noticed the next time a commit is made to the
branch, since the branch will have changed. (ok)
3. Creating the branch from an existing remote branch involves making
the branch, and then getting its ref, and recording that the index
reflects that ref.
If a push creates the branch first, git-branch will fail (ok).
If the branch is created and a racing push is then able to change it
(highly unlikely!) we're still ok, because it first records the ref into
the index.lck, and then updating the index. The race can cause the
index.lck to have the old branch ref, while the index has the newly pushed
branch merged into it, but that only results in an unnecessary update of
the index file later on.
2011-12-11 22:39:53 +00:00
|
|
|
catObject :: Git.Ref -> Annex L.ByteString
|
|
|
|
catObject ref = do
|
|
|
|
h <- catFileHandle
|
|
|
|
liftIO $ Git.CatFile.catObject h ref
|
|
|
|
|
2012-06-10 23:58:34 +00:00
|
|
|
catObjectDetails :: Git.Ref -> Annex (Maybe (L.ByteString, Sha))
|
|
|
|
catObjectDetails ref = do
|
|
|
|
h <- catFileHandle
|
|
|
|
liftIO $ Git.CatFile.catObjectDetails h ref
|
|
|
|
|
2013-05-15 22:46:38 +00:00
|
|
|
{- There can be multiple index files, and a different cat-file is needed
|
|
|
|
- for each. This is selected by setting GIT_INDEX_FILE in the gitEnv. -}
|
2011-11-12 21:45:12 +00:00
|
|
|
catFileHandle :: Annex Git.CatFile.CatFileHandle
|
2013-05-15 22:46:38 +00:00
|
|
|
catFileHandle = do
|
|
|
|
m <- Annex.getState Annex.catfilehandles
|
|
|
|
indexfile <- fromMaybe "" . maybe Nothing (lookup "GIT_INDEX_FILE")
|
|
|
|
<$> fromRepo gitEnv
|
|
|
|
case M.lookup indexfile m of
|
|
|
|
Just h -> return h
|
|
|
|
Nothing -> do
|
|
|
|
h <- inRepo Git.CatFile.catFileStart
|
|
|
|
let m' = M.insert indexfile h m
|
|
|
|
Annex.changeState $ \s -> s { Annex.catfilehandles = m' }
|
|
|
|
return h
|
2012-12-12 23:20:38 +00:00
|
|
|
|
2012-12-25 19:48:15 +00:00
|
|
|
{- From the Sha or Ref of a symlink back to the key. -}
|
|
|
|
catKey :: Ref -> Annex (Maybe Key)
|
2013-01-05 19:26:22 +00:00
|
|
|
catKey ref = do
|
2013-05-25 04:37:41 +00:00
|
|
|
l <- fromInternalGitPath . encodeW8 . L.unpack <$> catObject ref
|
2013-01-05 19:26:22 +00:00
|
|
|
return $ if isLinkToAnnex l
|
|
|
|
then fileKey $ takeFileName l
|
|
|
|
else Nothing
|
|
|
|
|
2013-05-25 04:37:41 +00:00
|
|
|
{- From a file in the repository back to the key.
|
2013-01-05 19:26:22 +00:00
|
|
|
-
|
|
|
|
- Prefixing the file with ./ makes this work even if in a subdirectory
|
2013-05-15 22:46:38 +00:00
|
|
|
- of a repo.
|
2013-05-25 04:37:41 +00:00
|
|
|
-
|
|
|
|
- Ideally, this should reflect the key that's staged in the index,
|
|
|
|
- not the key that's committed to HEAD. Unfortunately, git cat-file
|
|
|
|
- does not refresh the index file after it's started up, so things
|
|
|
|
- newly staged in the index won't show up. It does, however, notice
|
|
|
|
- when branches change.
|
|
|
|
-
|
|
|
|
- For command-line git-annex use, that doesn't matter. It's perfectly
|
|
|
|
- reasonable for things staged in the index after the currently running
|
|
|
|
- git-annex process to not be noticed by it.
|
|
|
|
-
|
|
|
|
- For the assistant, this is much more of a problem, since it commits
|
|
|
|
- files and then needs to be able to immediately look up their keys.
|
|
|
|
- OTOH, the assistant doesn't keep changes staged in the index for very
|
|
|
|
- long at all before committing them -- and it won't look at the keys
|
|
|
|
- of files until after committing them.
|
|
|
|
-
|
|
|
|
- So, this gets info from the index, unless running as a daemon.
|
2013-01-05 19:26:22 +00:00
|
|
|
-}
|
|
|
|
catKeyFile :: FilePath -> Annex (Maybe Key)
|
2013-05-25 04:37:41 +00:00
|
|
|
catKeyFile f = ifM (Annex.getState Annex.daemon)
|
2013-08-22 17:57:07 +00:00
|
|
|
( catKeyFileHEAD f
|
2013-05-25 04:37:41 +00:00
|
|
|
, catKey $ Ref $ ":./" ++ f
|
|
|
|
)
|
2013-08-22 17:57:07 +00:00
|
|
|
|
|
|
|
catKeyFileHEAD :: FilePath -> Annex (Maybe Key)
|
|
|
|
catKeyFileHEAD f = catKey $ Ref $ "HEAD:./" ++ f
|