add RemoteStateHandle

This solves the problem of sameas remotes trampling over per-remote
state. Used for:

* per-remote state, of course
* per-remote metadata, also of course
* per-remote content identifiers, because two remote implementations
  could in theory generate the same content identifier for two different
  peices of content

While chunk logs are per-remote data, they don't use this, because the
number and size of chunks stored is a common property across sameas
remotes.

External special remote had a complication, where it was theoretically
possible for a remote to send SETSTATE or GETSTATE during INITREMOTE or
EXPORTSUPPORTED. Since the uuid of the remote is typically generate in
Remote.setup, it would only be possible to pass a Maybe
RemoteStateHandle into it, and it would otherwise have to construct its
own. Rather than go that route, I decided to send an ERROR in this case.
It seems unlikely that any existing external special remote will be
affected. They would have to make up a git-annex key, and set state for
some reason during INITREMOTE. I can imagine such a hack, but it doesn't
seem worth complicating the code in such an ugly way to support it.

Unfortunately, both TestRemote and Annex.Import needed the Remote
to have a new field added that holds its RemoteStateHandle.
This commit is contained in:
Joey Hess 2019-10-14 12:33:27 -04:00
parent 37f0abbca8
commit 9828f45d85
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
31 changed files with 274 additions and 209 deletions

View file

@ -61,8 +61,8 @@ remote = RemoteType
, importSupported = importUnsupported
}
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc = do
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
gen r u c gc rs = do
cst <- remoteCost gc expensiveRemoteCost
hdl <- liftIO $ TahoeHandle
<$> maybe (defaultTahoeConfigDir u) return (remoteAnnexTahoe gc)
@ -71,18 +71,18 @@ gen r u c gc = do
{ uuid = u
, cost = cst
, name = Git.repoDescribe r
, storeKey = store u hdl
, retrieveKeyFile = retrieve u hdl
, storeKey = store rs hdl
, retrieveKeyFile = retrieve rs hdl
, retrieveKeyFileCheap = \_ _ _ -> return False
-- Tahoe cryptographically verifies content.
, retrievalSecurityPolicy = RetrievalAllKeysSecure
, removeKey = remove
, lockContent = Nothing
, checkPresent = checkKey u hdl
, checkPresent = checkKey rs hdl
, checkPresentCheap = False
, exportActions = exportUnsupported
, importActions = importUnsupported
, whereisKey = Just (getWhereisKey u)
, whereisKey = Just (getWhereisKey rs)
, remoteFsck = Nothing
, repairRepo = Nothing
, config = c
@ -97,6 +97,7 @@ gen r u c gc = do
, getInfo = return []
, claimUrl = Nothing
, checkUrl = Nothing
, remoteStateHandle = rs
}
tahoeSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
@ -119,14 +120,14 @@ tahoeSetup _ mu _ c _ = do
furlk = "introducer-furl"
missingfurl = giveup "Set TAHOE_FURL to the introducer furl to use."
store :: UUID -> TahoeHandle -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
store u hdl k _f _p = sendAnnex k noop $ \src ->
store :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
store rs hdl k _f _p = sendAnnex k noop $ \src ->
parsePut <$> liftIO (readTahoe hdl "put" [File src]) >>= maybe
(return False)
(\cap -> storeCapability u k cap >> return True)
(\cap -> storeCapability rs k cap >> return True)
retrieve :: UUID -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
retrieve u hdl k _f d _p = unVerified $ go =<< getCapability u k
retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
retrieve rs hdl k _f d _p = unVerified $ go =<< getCapability rs k
where
go Nothing = return False
go (Just cap) = liftIO $ requestTahoe hdl "get" [Param cap, File d]
@ -136,8 +137,8 @@ remove _k = do
warning "content cannot be removed from tahoe remote"
return False
checkKey :: UUID -> TahoeHandle -> Key -> Annex Bool
checkKey u hdl k = go =<< getCapability u k
checkKey :: RemoteStateHandle -> TahoeHandle -> Key -> Annex Bool
checkKey rs hdl k = go =<< getCapability rs k
where
go Nothing = return False
go (Just cap) = liftIO $ do
@ -233,14 +234,14 @@ tahoeParams :: TahoeConfigDir -> String -> [CommandParam] -> [CommandParam]
tahoeParams configdir command params =
Param "-d" : File configdir : Param command : params
storeCapability :: UUID -> Key -> Capability -> Annex ()
storeCapability u k cap = setRemoteState u k cap
storeCapability :: RemoteStateHandle -> Key -> Capability -> Annex ()
storeCapability rs k cap = setRemoteState rs k cap
getCapability :: UUID -> Key -> Annex (Maybe Capability)
getCapability u k = getRemoteState u k
getCapability :: RemoteStateHandle -> Key -> Annex (Maybe Capability)
getCapability rs k = getRemoteState rs k
getWhereisKey :: UUID -> Key -> Annex [String]
getWhereisKey u k = disp <$> getCapability u k
getWhereisKey :: RemoteStateHandle -> Key -> Annex [String]
getWhereisKey rs k = disp <$> getCapability rs k
where
disp Nothing = []
disp (Just c) = [c]