From: Joey Hess Date: Mon, 21 Dec 2020 20:03:27 +0000 (-0400) Subject: improve thirdpartypopulated support X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~98^2~299^2~14 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=15000dee07a06d04285351616915794bd6ec7f14;p=git-annex.git improve thirdpartypopulated support May actually work now. Note that, importKey now has to add the size to the key if it's supposed to have size. Remote.Directory relied on the importer adding the size, which is no longer done, so it was changed; it was the only one. This way, importKey does not need to behave differently between regular and thirdpartypopulated imports. --- diff --git a/Annex/Import.hs b/Annex/Import.hs index ffcf5484f6..0bc0c44c83 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -325,7 +325,7 @@ importKeys -> Bool -> ImportableContents (ContentIdentifier, ByteSize) -> Annex (Maybe (ImportableContents (Either Sha Key))) -importKeys remote importtreeconfig importcontent ignorelargefilesconfig importablecontents = do +importKeys remote importtreeconfig importcontent thirdpartypopulated importablecontents = do unless (canImportKeys remote importcontent) $ giveup "This remote does not support importing without downloading content." -- This map is used to remember content identifiers that @@ -347,7 +347,9 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab go oldversion cidmap importing (ImportableContents l h) db = do largematcher <- largeFilesMatcher jobs <- forM l $ \i -> - startimport cidmap importing db i oldversion largematcher + if thirdpartypopulated + then thirdpartypopulatedimport cidmap db i + else startimport cidmap importing db i oldversion largematcher l' <- liftIO $ forM jobs $ either pure (atomically . takeTMVar) if any isNothing l' @@ -406,6 +408,20 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab importaction return (Right job) + thirdpartypopulatedimport cidmap db (loc, (cid, sz)) = + case Remote.importKey ia of + Nothing -> return $ Left Nothing + Just importkey -> + tryNonAsync (importkey loc cid sz nullMeterUpdate) >>= \case + Right (Just k) -> do + recordcidkey cidmap db cid k + logChange k (Remote.uuid remote) InfoPresent + return $ Left $ Just (loc, Right k) + Right Nothing -> return $ Left Nothing + Left e -> do + warning (show e) + return $ Left Nothing + importordownload cidmap db (loc, (cid, sz)) largematcher= do f <- locworktreefile loc matcher <- largematcher f @@ -415,7 +431,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab let act = if importcontent then case Remote.importKey ia of Nothing -> dodownload - Just _ -> if not ignorelargefilesconfig && Utility.Matcher.introspect matchNeedsFileContent matcher + Just _ -> if Utility.Matcher.introspect matchNeedsFileContent matcher then dodownload else doimport else doimport @@ -425,7 +441,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab case Remote.importKey ia of Nothing -> error "internal" -- checked earlier Just importkey -> do - when (not ignorelargefilesconfig && Utility.Matcher.introspect matchNeedsFileContent matcher) $ + when (Utility.Matcher.introspect matchNeedsFileContent matcher) $ giveup "annex.largefiles configuration examines file contents, so cannot import without content." let mi = MatchingInfo ProvidedInfo { providedFilePath = f @@ -434,9 +450,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab , providedMimeType = Nothing , providedMimeEncoding = Nothing } - islargefile <- if ignorelargefilesconfig - then pure True - else checkMatcher' matcher mi mempty + islargefile <- checkMatcher' matcher mi mempty metered Nothing sz $ const $ if islargefile then doimportlarge importkey cidmap db loc cid sz f else doimportsmall cidmap db loc cid sz @@ -457,20 +471,15 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab let p' = if importcontent then nullMeterUpdate else p importkey loc cid sz p' >>= \case Nothing -> return Nothing - Just unsizedk -> do - -- This avoids every remote needing - -- to add the size. - let k = alterKey unsizedk $ \kd -> kd - { keySize = keySize kd <|> Just sz } - checkSecureHashes k >>= \case - Nothing -> do - recordcidkey cidmap db cid k - logChange k (Remote.uuid remote) InfoPresent - if importcontent - then getcontent k - else return (Just (k, True)) - Just msg -> giveup (msg ++ " to import") - + Just k -> checkSecureHashes k >>= \case + Nothing -> do + recordcidkey cidmap db cid k + logChange k (Remote.uuid remote) InfoPresent + if importcontent + then getcontent k + else return (Just (k, True)) + Just msg -> giveup (msg ++ " to import") + getcontent :: Key -> Annex (Maybe (Key, Bool)) getcontent k = do let af = AssociatedFile (Just f) @@ -552,9 +561,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab , contentFile = Just tmpfile , matchKey = Nothing } - islargefile <- if ignorelargefilesconfig - then pure True - else checkMatcher' matcher mi mempty + islargefile <- checkMatcher' matcher mi mempty if islargefile then do backend <- chooseBackend f diff --git a/Command/Import.hs b/Command/Import.hs index f383fd843f..472d82d4e7 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -324,11 +324,18 @@ seekRemote remote branch msubdir importcontent ci = do listContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> TVar (Maybe (ImportableContents (ContentIdentifier, Remote.ByteSize))) -> CommandStart listContents remote importtreeconfig ci tvar = starting "list" ai si $ + listContents' remote importtreeconfig ci $ \importable -> do + liftIO $ atomically $ writeTVar tvar (Just importable) + next $ return True + where + ai = ActionItemOther (Just (Remote.name remote)) + si = SeekInput [] + +listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (ImportableContents (ContentIdentifier, Remote.ByteSize) -> Annex a) -> Annex a +listContents' remote importtreeconfig ci a = makeImportMatcher remote >>= \case Right matcher -> getImportableContents remote importtreeconfig ci matcher >>= \case - Just importable -> next $ do - liftIO $ atomically $ writeTVar tvar (Just importable) - return True + Just importable -> a importable Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote Left err -> giveup $ unwords [ "Cannot import from" @@ -336,9 +343,6 @@ listContents remote importtreeconfig ci tvar = starting "list" ai si $ , "because of a problem with its configuration:" , err ] - where - ai = ActionItemOther (Just (Remote.name remote)) - si = SeekInput [] commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents (Either Sha Key) -> CommandStart commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig importable = diff --git a/Command/Sync.hs b/Command/Sync.hs index 613afe8639..3a3839b050 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -77,7 +77,6 @@ import Utility.Process.Transcript import Utility.Tuple import Control.Concurrent.MVar -import Control.Concurrent.STM import qualified Data.Map as M import qualified Data.ByteString as S import Data.Char @@ -492,24 +491,18 @@ importRemote importcontent o mergeconfig remote currbranch - updated, because the filenames are the names of annex object files, - not suitable for a tracking branch. Does not transfer any content. -} importThirdPartyPopulated :: Remote -> CommandSeek -importThirdPartyPopulated remote = do - importabletvar <- liftIO $ newTVarIO Nothing - void $ includeCommandAction (Command.Import.listContents remote ImportTree (CheckGitIgnore False) importabletvar) - liftIO (atomically (readTVar importabletvar)) >>= \case - Nothing -> return () - Just importable -> - importKeys remote ImportTree False False importable >>= \case - Just importablekeys -> go importablekeys - Nothing -> warning $ concat - [ "Failed to import from" - , Remote.name remote - ] +importThirdPartyPopulated remote = + void $ includeCommandAction $ starting "list" ai si $ + Command.Import.listContents' remote ImportTree (CheckGitIgnore False) go where - go importablekeys = void $ includeCommandAction $ starting "pull" ai si $ do - (_imported, updatestate) <- recordImportTree remote ImportTree importablekeys - next $ do - updatestate - return True + go importable = importKeys remote ImportTree False True importable >>= \case + Just importablekeys -> do + (_imported, updatestate) <- recordImportTree remote ImportTree importablekeys + next $ do + updatestate + return True + Nothing -> next $ return False + ai = ActionItemOther (Just (Remote.name remote)) si = SeekInput [] diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 009c160339..91ea86019a 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -371,9 +371,11 @@ guardSameContentIdentifiers cont old new | otherwise = giveup "file content has changed" importKeyM :: RawFilePath -> ExportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key) -importKeyM dir loc cid _sz p = do +importKeyM dir loc cid sz p = do backend <- chooseBackend f - k <- fst <$> genKey ks p backend + unsizedk <- fst <$> genKey ks p backend + let k = alterKey unsizedk $ \kd -> kd + { keySize = keySize kd <|> Just sz } currcid <- liftIO $ mkContentIdentifier absf =<< R.getFileStatus absf guardSameContentIdentifiers (return (Just k)) cid currcid diff --git a/Remote/Helper/ThirdParty.hs b/Remote/Helper/ThirdParty.hs deleted file mode 100644 index 6ce106fa12..0000000000 --- a/Remote/Helper/ThirdParty.hs +++ /dev/null @@ -1,56 +0,0 @@ -{- Helpers for thirdPartyPopulated remotes - - - - Copyright 2020 Joey Hess - - - - Licensed under the GNU AGPL version 3 or higher. - -} - -module Remote.Helper.ThirdParty where - -import Annex.Common -import Types.Remote -import Types.Import -import Crypto (isEncKey) -import Utility.Metered - -import qualified System.FilePath.ByteString as P - --- When a remote is thirdPartyPopulated, and contains a backup of a --- git-annex repository or some special remotes, this can be used to --- find only those ImportLocations that are annex object files. --- All other ImportLocations are ignored. -importKey :: ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key) -importKey loc _cid sz _ = return $ case deserializeKey' f of - Just k - -- Annex objects always are in a subdirectory with the same - -- name as the filename. If this is not the case for the file - -- that was backed up, it is probably not a valid annex object. - -- Eg, it could be something in annex/bad/, or annex/tmp/. - -- Or it could be a file that only happens to have a name - -- like an annex object. - -- (This does unfortunately prevent recognizing files that are - -- part of special remotes that don't use that layout. The most - -- likely special remote to be in a backup, the directory - -- special remote, does use that layout at least.) - | lastMaybe (P.splitDirectories (P.dropFileName p)) /= Just f -> Nothing - -- Chunked or encrypted keys used in special remotes are not - -- supported. - | isChunkKey k || isEncKey k -> Nothing - -- Check that the size of the key is the same as the size of the - -- file stored in the backup. This is a cheap way to make sure it's - -- probabably the actual content of the file. We don't fully - -- verify the content here because that could be a very - -- expensive operation for a large repository; if the user - -- wants to detect every possible data corruption problem - -- (eg, wrong data read off disk during backup, or the object - -- was corrupt in the git-annex repo and that bad object got - -- backed up), they can fsck the remote. - | otherwise -> case fromKey keySize k of - Just sz' - | sz' == sz -> Just k - | otherwise -> Nothing - Nothing -> Just k - Nothing -> Nothing - where - p = fromImportLocation loc - f = P.takeFileName p diff --git a/Remote/Helper/ThirdPartyPopulated.hs b/Remote/Helper/ThirdPartyPopulated.hs new file mode 100644 index 0000000000..6ce106fa12 --- /dev/null +++ b/Remote/Helper/ThirdPartyPopulated.hs @@ -0,0 +1,56 @@ +{- Helpers for thirdPartyPopulated remotes + - + - Copyright 2020 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Remote.Helper.ThirdParty where + +import Annex.Common +import Types.Remote +import Types.Import +import Crypto (isEncKey) +import Utility.Metered + +import qualified System.FilePath.ByteString as P + +-- When a remote is thirdPartyPopulated, and contains a backup of a +-- git-annex repository or some special remotes, this can be used to +-- find only those ImportLocations that are annex object files. +-- All other ImportLocations are ignored. +importKey :: ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key) +importKey loc _cid sz _ = return $ case deserializeKey' f of + Just k + -- Annex objects always are in a subdirectory with the same + -- name as the filename. If this is not the case for the file + -- that was backed up, it is probably not a valid annex object. + -- Eg, it could be something in annex/bad/, or annex/tmp/. + -- Or it could be a file that only happens to have a name + -- like an annex object. + -- (This does unfortunately prevent recognizing files that are + -- part of special remotes that don't use that layout. The most + -- likely special remote to be in a backup, the directory + -- special remote, does use that layout at least.) + | lastMaybe (P.splitDirectories (P.dropFileName p)) /= Just f -> Nothing + -- Chunked or encrypted keys used in special remotes are not + -- supported. + | isChunkKey k || isEncKey k -> Nothing + -- Check that the size of the key is the same as the size of the + -- file stored in the backup. This is a cheap way to make sure it's + -- probabably the actual content of the file. We don't fully + -- verify the content here because that could be a very + -- expensive operation for a large repository; if the user + -- wants to detect every possible data corruption problem + -- (eg, wrong data read off disk during backup, or the object + -- was corrupt in the git-annex repo and that bad object got + -- backed up), they can fsck the remote. + | otherwise -> case fromKey keySize k of + Just sz' + | sz' == sz -> Just k + | otherwise -> Nothing + Nothing -> Just k + Nothing -> Nothing + where + p = fromImportLocation loc + f = P.takeFileName p