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:
parent
a59e95a82d
commit
3175015d1b
3 changed files with 34 additions and 5 deletions
16
Remote/S3.hs
16
Remote/S3.hs
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue