set S3 version id in retrieveExportWithContentIdentifierS3

This is necessary because of checks for a S3 version id being set
done when deleting the export or overwriting or renaming it.
This commit is contained in:
Joey Hess 2019-04-24 15:13:07 -04:00
parent b9b3567747
commit f08cd6a4ac
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 39 additions and 42 deletions

View file

@ -23,6 +23,7 @@ import Git.Types
import Git.Tree
import Git.Sha
import Git.FilePath
import Git.History
import qualified Git.Ref
import qualified Git.Branch
import qualified Annex
@ -89,10 +90,10 @@ buildImportCommit
-> Annex (Maybe Ref)
buildImportCommit remote importtreeconfig importcommitconfig importable =
case importCommitParent importcommitconfig of
Nothing -> go emptyTree Nothing
Nothing -> go Nothing
Just basecommit -> inRepo (Git.Ref.tree basecommit) >>= \case
Nothing -> go emptyTree Nothing
Just origtree -> go origtree (Just basecommit)
Nothing -> go Nothing
Just _ -> go (Just basecommit)
where
basetree = case importtreeconfig of
ImportTree -> emptyTree
@ -101,29 +102,26 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
ImportTree -> Nothing
ImportSubTree dir _ -> Just dir
go origtree basecommit = do
go basecommit = do
imported@(History finaltree _) <-
buildImportTrees basetree subdir importable
mkcommits origtree basecommit imported >>= \case
Nothing -> return Nothing
Just finalcommit -> do
skipOldHistory basecommit imported >>= \case
Just toadd -> do
finalcommit <- mkcommits basecommit toadd
updatestate finaltree
return (Just finalcommit)
Nothing -> return Nothing
mkcommits origtree basecommit (History importedtree hs) = do
parents <- catMaybes <$> mapM (mkcommits origtree basecommit) (S.toList hs)
if importedtree == origtree && null parents
then return Nothing -- no changes to commit
else do
let commitparents = if null parents
then catMaybes [basecommit]
else parents
commit <- inRepo $ Git.Branch.commitTree
(importCommitMode importcommitconfig)
(importCommitMessage importcommitconfig)
commitparents
importedtree
return (Just commit)
mkcommits basecommit (History importedtree hs) = do
parents <- mapM (mkcommits basecommit) (S.toList hs)
let commitparents = if null parents
then catMaybes [basecommit]
else parents
inRepo $ Git.Branch.commitTree
(importCommitMode importcommitconfig)
(importCommitMessage importcommitconfig)
commitparents
importedtree
updatestate committedtree = do
importedtree <- case subdir of
@ -136,7 +134,7 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
updateexportdb importedtree
oldexport <- updateexportlog importedtree
updatelocationlog oldexport importedtree
updateexportdb importedtree = do
db <- Export.openDb (Remote.uuid remote)
Export.writeLockDbWhile db $ do
@ -176,24 +174,6 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
Export.runExportDiffUpdater updater db oldtree finaltree
Export.closeDb db
data History t = History t (S.Set (History t))
deriving (Show, Eq, Ord)
historyDepth :: History t -> Integer
historyDepth (History _ s)
| S.null s = 1
| otherwise = 1 + maximum (map historyDepth (S.toList s))
truncateHistoryToDepth :: Ord t => Integer -> History t -> History t
truncateHistoryToDepth n (History t s) = History t (go 1 s)
where
go depth s
| depth >= n = S.empty
| otherwise =
let depth' = succ depth
in flip S.map s $ \(History t' s') ->
History t' (go depth' s')
{- Finds the part of the History of git trees that is new and should be
- committed on top of the basecommit, skipping parts that have
- already been committed.
@ -209,7 +189,11 @@ truncateHistoryToDepth n (History t s) = History t (go 1 s)
- basecommit.
-}
skipOldHistory :: Maybe Sha -> History Sha -> Annex (Maybe (History Sha))
skipOldHistory basecommit importedhistory = undefined
skipOldHistory Nothing importedhistory = return (Just importedhistory)
skipOldHistory (Just basecommit) importedhistory =
inRepo (getTreeHistoryToDepth (historyDepth importedhistory) basecommit) >>= \case
Just knownhistory -> return $ skipOldHistory' knownhistory importedhistory
Nothing -> return $ Just importedhistory
{- The knownhistory does not need to be complete; it can be
- truncated to the same depth as the importedhistory to avoid reading

View file

@ -555,7 +555,12 @@ retrieveExportWithContentIdentifierS3 hv r info loc cid dest mkkey p = withS3Han
rewritePreconditionException $ retrieveHelper' h dest p $
limitGetToContentIdentifier cid $
S3.getObject (bucket info) o
mkkey
mk <- mkkey
case (mk, extractContentIdentifier cid o) of
(Just k, Right vid) ->
setS3VersionID info (uuid r) k vid
_ -> noop
return mk
where
o = T.pack $ bucketExportLocation info loc
@ -1089,6 +1094,14 @@ limitToContentIdentifier (ContentIdentifier v) limitetag limitversionid =
in limitetag (Just etag)
_ -> limitversionid (Just t)
-- A ContentIdentifier contains either a etag or a S3 version id.
extractContentIdentifier :: ContentIdentifier -> S3.Object -> Either S3Etag (Maybe S3VersionID)
extractContentIdentifier (ContentIdentifier v) o =
let t = either mempty id (T.decodeUtf8' v)
in case T.take 1 t of
"#" -> Left (T.drop 1 t)
_ -> Right (mkS3VersionID o (Just t))
setS3VersionID :: S3Info -> UUID -> Key -> Maybe S3VersionID -> Annex ()
setS3VersionID info u k vid
| versioning info = maybe noop (setS3VersionID' u k) vid