lockContent for S3 (with versioning=yes) and git-lfs

Made several special remotes support locking content on them while
dropping, which allows dropping from another special remote when the
content will only remain on a special remote of these types.

In both cases, verify the content is present actively, because it's
certianly possible for things other than git-annex to have removed it.

Worth thinking about what to do if at some later point, git-lfs gains
support for dropping content, and a content locking operation.
That would probably need a transition; first would need to make lockContent
use the locking operation. Then, once enough time had passed that we can
assume any git-annex operating on the git-lfs remote had that change,
git-annex could finally allow dropping from git-lfs.

Or, it could be that git-lfs gains support for dropping content, but not
locking it. In that case, it seems this commit would need to be reverted,
and then wait long enough for that git-annex to be everywhere, and only
then can git-annex safely support dropping from git-lfs.

So, the assumption made in this commit could lead to bother later.. But I
think it's actually highly unlikely git-lfs does ever support dropping;
it's outside their centralized model. Probably. :) Worth keeping in mind as
the same assumption is made about other special remotes though.

This commit was sponsored by Ethan Aubin.
This commit is contained in:
Joey Hess 2020-06-26 13:46:42 -04:00
parent a59e95a82d
commit 3175015d1b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 34 additions and 5 deletions

View file

@ -58,6 +58,7 @@ import Logs.Web
import Logs.MetaData
import Types.MetaData
import Types.ProposedAccepted
import Types.NumCopies
import Utility.Metered
import Utility.DataUnits
import Annex.Content
@ -199,7 +200,7 @@ gen r u rc gc rs = do
-- secure.
, retrievalSecurityPolicy = RetrievalAllKeysSecure
, removeKey = removeKeyDummy
, lockContent = Nothing
, lockContent = lockContentS3 hdl this rs c info
, checkPresent = checkPresentDummy
, checkPresentCheap = False
, exportActions = ExportActions
@ -427,6 +428,19 @@ remove hv r info k = withS3HandleOrFail (uuid r) hv $ \h -> do
S3.DeleteObject (T.pack $ bucketObject info k) (bucket info)
return ()
lockContentS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> ParsedRemoteConfig -> S3Info -> Maybe (Key -> (VerifiedCopy -> Annex a) -> Annex a)
lockContentS3 hv r rs c info
-- When versioning is enabled, content is never removed from the
-- remote, so nothing needs to be done to lock the content there,
-- beyond a sanity check that the content is in fact present.
| versioning info = Just $ \k callback -> do
checkVersioning info rs k
ifM (checkKey hv r rs c info k)
( withVerifiedCopy LockedCopy (uuid r) (return True) callback
, giveup $ "content seems to be missing from " ++ name r ++ " despite S3 versioning being enabled"
)
| otherwise = Nothing
checkKey :: S3HandleVar -> Remote -> RemoteStateHandle -> ParsedRemoteConfig -> S3Info -> CheckPresent
checkKey hv r rs c info k = withS3Handle hv $ \case
Just h -> do