mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add RemoteStateHandle

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

45
Remote/GitLFS.hs
View file

@ -57,8 +57,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
-- If the repo uses gcrypt, get the underlaying repo without the
-- gcrypt url, to do LFS endpoint discovery on.
r' <- if Git.GCrypt.isEncrypted r
@ -70,10 +70,10 @@ gen r u c gc = do
h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing sem r' gc
cst <- remoteCost gc expensiveRemoteCost
return $ Just $ specialRemote' specialcfg c
(simplyPrepare $ store u h)
(simplyPrepare $ retrieve u h)
(simplyPrepare $ store rs h)
(simplyPrepare $ retrieve rs h)
(simplyPrepare $ remove h)
(simplyPrepare $ checkKey u h)
(simplyPrepare $ checkKey rs h)
(this cst)
where
this cst = Remote
@ -109,6 +109,7 @@ gen r u c gc = do
, getInfo = gitRepoInfo (this cst)
, claimUrl = Nothing
, checkUrl = Nothing
, remoteStateHandle = rs
}
specialcfg = (specialRemoteCfg c)
-- chunking would not improve git-lfs
@ -327,8 +328,8 @@ extractKeySize k
| isEncKey k = Nothing
| otherwise = keySize k
mkUploadRequest :: UUID -> Key -> FilePath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer)
mkUploadRequest u k content = case (extractKeySha256 k, extractKeySize k) of
mkUploadRequest :: RemoteStateHandle -> Key -> FilePath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer)
mkUploadRequest rs k content = case (extractKeySha256 k, extractKeySize k) of
(Just sha256, Just size) ->
ret sha256 size
(_, Just size) -> do
@ -355,12 +356,12 @@ mkUploadRequest u k content = case (extractKeySha256 k, extractKeySize k) of
}
return (req, sha256, size)
remembersha256 sha256 = setRemoteState u k (T.unpack sha256)
rememberboth sha256 size = setRemoteState u k $
remembersha256 sha256 = setRemoteState rs k (T.unpack sha256)
rememberboth sha256 size = setRemoteState rs k $
show size ++ " " ++ T.unpack sha256
mkDownloadRequest :: UUID -> Key -> Annex (Maybe (LFS.TransferRequest, LFS.SHA256, Integer))
mkDownloadRequest u k = case (extractKeySha256 k, extractKeySize k) of
mkDownloadRequest :: RemoteStateHandle -> Key -> Annex (Maybe (LFS.TransferRequest, LFS.SHA256, Integer))
mkDownloadRequest rs k = case (extractKeySha256 k, extractKeySize k) of
(Just sha256, Just size) -> ret sha256 size
(_, Just size) ->
remembersha256 >>= \case
@ -383,8 +384,8 @@ mkDownloadRequest u k = case (extractKeySha256 k, extractKeySize k) of
, LFS.req_objects = [obj]
}
return $ Just (req, sha256, size)
remembersha256 = fmap T.pack <$> getRemoteState u k
rememberboth = maybe Nothing parse <$> getRemoteState u k
remembersha256 = fmap T.pack <$> getRemoteState rs k
rememberboth = maybe Nothing parse <$> getRemoteState rs k
where
parse s = case words s of
[ssize, ssha256] -> do
@ -392,11 +393,11 @@ mkDownloadRequest u k = case (extractKeySha256 k, extractKeySize k) of
return (T.pack ssha256, size)
_ -> Nothing
store :: UUID -> TVar LFSHandle -> Storer
store u h = fileStorer $ \k src p -> getLFSEndpoint LFS.RequestUpload h >>= \case
store :: RemoteStateHandle -> TVar LFSHandle -> Storer
store rs h = fileStorer $ \k src p -> getLFSEndpoint LFS.RequestUpload h >>= \case
Nothing -> return False
Just endpoint -> flip catchNonAsync failederr $ do
(req, sha256, size) <- mkUploadRequest u k src
(req, sha256, size) <- mkUploadRequest rs k src
sendTransferRequest req endpoint >>= \case
Left err -> do
warning err
@ -424,10 +425,10 @@ store u h = fileStorer $ \k src p -> getLFSEndpoint LFS.RequestUpload h >>= \cas
warning (show e)
return False
retrieve :: UUID -> TVar LFSHandle -> Retriever
retrieve u h = fileRetriever $ \dest k p -> getLFSEndpoint LFS.RequestDownload h >>= \case
retrieve :: RemoteStateHandle -> TVar LFSHandle -> Retriever
retrieve rs h = fileRetriever $ \dest k p -> getLFSEndpoint LFS.RequestDownload h >>= \case
Nothing -> giveup "unable to connect to git-lfs endpoint"
Just endpoint -> mkDownloadRequest u k >>= \case
Just endpoint -> mkDownloadRequest rs k >>= \case
Nothing -> giveup "unable to download this object from git-lfs"
Just (req, sha256, size) -> sendTransferRequest req endpoint >>= \case
Left err -> giveup (show err)
@ -448,10 +449,10 @@ retrieve u h = fileRetriever $ \dest k p -> getLFSEndpoint LFS.RequestDownload h
uo <- getUrlOptions
liftIO $ downloadConduit p req dest uo
checkKey :: UUID -> TVar LFSHandle -> CheckPresent
checkKey u h key = getLFSEndpoint LFS.RequestDownload h >>= \case
checkKey :: RemoteStateHandle -> TVar LFSHandle -> CheckPresent
checkKey rs h key = getLFSEndpoint LFS.RequestDownload h >>= \case
Nothing -> giveup "unable to connect to git-lfs endpoint"
Just endpoint -> mkDownloadRequest u key >>= \case
Just endpoint -> mkDownloadRequest rs key >>= \case
-- Unable to find enough information to request the key
-- from git-lfs, so it's not present there.
Nothing -> return False