diff --git a/Annex/Drop.hs b/Annex/Drop.hs index fca96c1530..00ca4d88a4 100644 --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -31,7 +31,8 @@ type Reason = String - - Skips trying to drop from remotes that are appendonly, since those drops - would presumably fail. Also skips dropping from exporttree/importtree remotes, - - which don't allow dropping individual keys. + - which don't allow dropping individual keys, and from thirdPartyPopulated + - remotes. - - The UUIDs are ones where the content is believed to be present. - The Remote list can include other remotes that do not have the content; diff --git a/Command/Export.hs b/Command/Export.hs index fe7830471a..3973d3c103 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -362,10 +362,10 @@ cleanupUnexport r db eks loc = do removeExportedLocation db (asKey ek) loc flushDbQueue db - -- An appendonly remote can support removeExportLocation to remove - -- the file from the exported tree, but still retain the content - -- and allow retrieving it. - unless (appendonly r) $ do + -- An versionedExport remote supports removeExportLocation to remove + -- the file from the exported tree, but still retains the content + -- and allows retrieving it. + unless (versionedExport (exportActions r)) $ do remaininglocs <- liftIO $ concat <$> forM eks (\ek -> getExportedLocation db (asKey ek)) when (null remaininglocs) $ diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 615631b28f..b1db4943ba 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -1,6 +1,6 @@ {- git-annex trust log - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -66,18 +66,19 @@ trustMapLoad :: Annex TrustMap trustMapLoad = do overrides <- Annex.getState Annex.forcetrust l <- remoteList - -- Export/import remotes are not trusted, since they are not - -- key/value stores. (Unless they are appendonly remotes.) + -- Export/import remotes are normally untrusted, because they are + -- not key/value stores and there are many ways that content stored + -- on them can be lost. An exception is ones with versionedExport set. let isexportimport r = Types.Remote.isExportSupported r <||> Types.Remote.isImportSupported r - let untrustworthy r = pure (not (Types.Remote.appendonly r)) - <&&> isexportimport r - exports <- filterM untrustworthy l - let exportoverrides = M.fromList $ - map (\r -> (Types.Remote.uuid r, UnTrusted)) exports + let isuntrustworthy r = isexportimport r + <&&> pure (not (Types.Remote.versionedExport (Types.Remote.exportActions r))) + untrustworthy <- filterM isuntrustworthy l + let trustoverrides = M.fromList $ + map (\r -> (Types.Remote.uuid r, UnTrusted)) untrustworthy logged <- trustMapRaw let configured = M.fromList $ mapMaybe configuredtrust l - let m = M.unionWith min exportoverrides $ + let m = M.unionWith min trustoverrides $ M.union overrides $ M.union configured logged Annex.changeState $ \s -> s { Annex.trustmap = Just m } diff --git a/Remote/Adb.hs b/Remote/Adb.hs index f67df51754..f0eeaad2f8 100644 --- a/Remote/Adb.hs +++ b/Remote/Adb.hs @@ -76,6 +76,7 @@ gen r u rc gc rs = do { storeExport = storeExportM serial adir , retrieveExport = retrieveExportM serial adir , removeExport = removeExportM serial adir + , versionedExport = False , checkPresentExport = checkPresentExportM this serial adir , removeExportDirectory = Just $ removeExportDirectoryM serial adir , renameExport = renameExportM serial adir diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 6de71fffe9..ed52a1ff25 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -88,6 +88,7 @@ gen r u rc gc rs = do { storeExport = storeExportM dir , retrieveExport = retrieveExportM dir , removeExport = removeExportM dir + , versionedExport = False , checkPresentExport = checkPresentExportM dir -- Not needed because removeExportLocation -- auto-removes empty directories. diff --git a/Remote/External.hs b/Remote/External.hs index 4921bb5027..7562737f74 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -93,6 +93,7 @@ gen r u rc gc rs { storeExport = storeExportM external , retrieveExport = retrieveExportM external , removeExport = removeExportM external + , versionedExport = False , checkPresentExport = checkPresentExportM external , removeExportDirectory = Just $ removeExportDirectoryM external , renameExport = renameExportM external diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs index cc40316ebd..e854ccb197 100644 --- a/Remote/Helper/ExportImport.hs +++ b/Remote/Helper/ExportImport.hs @@ -39,6 +39,7 @@ instance HasExportUnsupported (ExportActions Annex) where , retrieveExport = nope , checkPresentExport = \_ _ -> return False , removeExport = nope + , versionedExport = False , removeExportDirectory = nope , renameExport = \_ _ _ -> return Nothing } @@ -128,7 +129,8 @@ adjustExportImport' isexport isimport r rs = do dbv <- prepdbv ciddbv <- prepciddb let normal = not isexport && not isimport - let iskeyvaluestore = normal || appendonly r + let versioned = versionedExport (exportActions r) + let iskeyvaluestore = normal || versioned return $ r { exportActions = if isexport then if isimport @@ -170,16 +172,16 @@ adjustExportImport' isexport isimport r rs = do else Nothing , retrieveKeyFile = \k af dest p -> if isimport - then supportappendonlyretrieve k af dest p $ + then supportversionedretrieve k af dest p $ retrieveKeyFileFromImport dbv ciddbv k af dest p else if isexport - then supportappendonlyretrieve k af dest p $ + then supportversionedretrieve k af dest p $ retrieveKeyFileFromExport dbv k af dest p else retrieveKeyFile r k af dest p , retrieveKeyFileCheap = if iskeyvaluestore then retrieveKeyFileCheap r else Nothing - , checkPresent = \k -> if appendonly r + , checkPresent = \k -> if versioned then checkPresent r k else if isimport then anyM (checkPresentImport ciddbv k) @@ -356,11 +358,11 @@ adjustExportImport' isexport isimport r rs = do then retrieveKeyFileFromExport dbv k af dest p else giveup "no content identifier is recorded, unable to retrieve" - -- appendonly remotes have a key/value store, so can use + -- versionedExport remotes have a key/value store, so can use -- the usual retrieveKeyFile, rather than an import/export -- variant. However, fall back to that if retrieveKeyFile fails. - supportappendonlyretrieve k af dest p a - | appendonly r = + supportversionedretrieve k af dest p a + | versionedExport (exportActions r) = retrieveKeyFile r k af dest p `catchNonAsync` const a | otherwise = a diff --git a/Remote/HttpAlso.hs b/Remote/HttpAlso.hs index 7beb52426a..136df441cc 100644 --- a/Remote/HttpAlso.hs +++ b/Remote/HttpAlso.hs @@ -73,6 +73,7 @@ gen r u rc gc rs = do { storeExport = cannotModify , retrieveExport = retriveExportHttpAlso url , removeExport = cannotModify + , versionedExport = False , checkPresentExport = checkPresentExportHttpAlso url , removeExportDirectory = Nothing , renameExport = cannotModify diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 7627fbd2c6..1d00636b87 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -101,6 +101,7 @@ gen r u rc gc rs = do { storeExport = storeExportM o , retrieveExport = retrieveExportM o , removeExport = removeExportM o + , versionedExport = False , checkPresentExport = checkPresentExportM o , removeExportDirectory = Just (removeExportDirectoryM o) , renameExport = renameExportM o diff --git a/Remote/S3.hs b/Remote/S3.hs index 90db63bb1d..58121c3fc5 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -210,6 +210,7 @@ gen r u rc gc rs = do { storeExport = storeExportS3 hdl this rs info magic , retrieveExport = retrieveExportS3 hdl this info , removeExport = removeExportS3 hdl this rs info + , versionedExport = versioning info , checkPresentExport = checkPresentExportS3 hdl this info -- S3 does not have directories. , removeExportDirectory = Nothing @@ -232,7 +233,7 @@ gen r u rc gc rs = do , gitconfig = gc , localpath = Nothing , readonly = False - , appendonly = versioning info + , appendonly = False , availability = GloballyAvailable , remotetype = remote , mkUnavailable = gen r u (M.insert hostField (Proposed "!dne!") rc) gc rs diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 5163942b47..80f8e80093 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -100,6 +100,7 @@ gen r u rc gc rs = do , retrieveExport = retrieveExportDav hdl , checkPresentExport = checkPresentExportDav hdl this , removeExport = removeExportDav hdl + , versionedExport = False , removeExportDirectory = Just $ removeExportDirectoryDav hdl , renameExport = renameExportDav hdl diff --git a/Types/Remote.hs b/Types/Remote.hs index cc5fb47a23..717f9cb62d 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -141,9 +141,7 @@ data RemoteA a = Remote -- a Remote can be known to be readonly , readonly :: Bool -- a Remote can allow writes but not have a way to delete content - -- from it. Note that an export remote that supports removeExport - -- to remove a file from the exported tree, but still retains the - -- content in accessible form should set this to True. + -- from it. , appendonly :: Bool -- a Remote can be globally available. (Ie, "in the cloud".) , availability :: Availability @@ -251,6 +249,10 @@ data ExportActions a = ExportActions -- Can throw exception if unable to access remote, or if remote -- refuses to remove the content. , removeExport :: Key -> ExportLocation -> a () + -- Set when the content of a Key stored in the remote to an + -- ExportLocation and then removed with removeExport remains + -- accessible to retrieveKeyFile and checkPresent. + , versionedExport :: Bool -- Removes an exported directory. Typically the directory will be -- empty, but it could possibly contain files or other directories, -- and it's ok to delete those (but not required to). @@ -263,7 +265,9 @@ data ExportActions a = ExportActions -- the remote refuses to let the directory be removed. , removeExportDirectory :: Maybe (ExportDirectory -> a ()) -- Checks if anything is exported to the remote at the specified - -- ExportLocation. + -- ExportLocation. It may check the size or other characteristics + -- of the Key, but does not need to guarantee that the content on + -- the remote is the same as the Key's content. -- Throws an exception if the remote cannot be accessed. , checkPresentExport :: Key -> ExportLocation -> a Bool -- Renames an already exported file.