From 8b22e0bf37c1d073c79157d0b79a73ec69968c35 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 26 Jun 2020 14:23:21 -0400 Subject: [PATCH] lockContent for tahoe Trivial since git-annex cannot remove, but do an active checkKey verification anyway, in case the data was lost somehow. This commit was sponsored by Ryan Newton on Patreon. --- CHANGELOG | 2 +- Remote/Tahoe.hs | 15 +++++++++++++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index 04067c73a1..75d3b4d2b6 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -16,7 +16,7 @@ git-annex (8.20200618) UNRELEASED; urgency=medium * 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: - S3 (with versioning=yes), git-lfs + S3 (with versioning=yes), git-lfs, tahoe -- Joey Hess Thu, 18 Jun 2020 12:21:14 -0400 diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index 693eaafdcc..9e57e68a68 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -13,7 +13,7 @@ - - Tahoe has its own encryption, so git-annex's encryption is not used. - - - Copyright 2014-2019 Joey Hess + - Copyright 2014-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -31,6 +31,7 @@ import Annex.Common import Types.Remote import Types.Creds import Types.ProposedAccepted +import Types.NumCopies import qualified Git import Config import Config.Cost @@ -91,7 +92,7 @@ gen r u rc gc rs = do -- Tahoe cryptographically verifies content. , retrievalSecurityPolicy = RetrievalAllKeysSecure , removeKey = remove - , lockContent = Nothing + , lockContent = Just $ lockKey u rs hdl , checkPresent = checkKey rs hdl , checkPresentCheap = False , exportActions = exportUnsupported @@ -153,6 +154,16 @@ retrieve rs hdl k _f d _p = do remove :: Key -> Annex () remove _k = giveup "content cannot be removed from tahoe remote" +-- Since content cannot be removed from tahoe (by git-annex), +-- nothing needs to be done to lock content there, except for checking that +-- it is actually present. +lockKey :: UUID -> RemoteStateHandle -> TahoeHandle -> Key -> (VerifiedCopy -> Annex a) -> Annex a +lockKey u rs hrl k callback = + ifM (checkKey rs hrl k) + ( withVerifiedCopy LockedCopy u (return True) callback + , giveup $ "content seems to be missing from tahoe remote" + ) + checkKey :: RemoteStateHandle -> TahoeHandle -> Key -> Annex Bool checkKey rs hdl k = go =<< getCapability rs k where