From f08cd6a4ac92869ae566a47572e21bc8913fbd7b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 24 Apr 2019 15:13:07 -0400 Subject: [PATCH] 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. --- Annex/Import.hs | 66 +++++++++++++++++++------------------------------ Remote/S3.hs | 15 ++++++++++- 2 files changed, 39 insertions(+), 42 deletions(-) diff --git a/Annex/Import.hs b/Annex/Import.hs index 71b4468f28..7da4709055 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -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 diff --git a/Remote/S3.hs b/Remote/S3.hs index 3c6c83c0f1..1e5c4c8490 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -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