fix encryption of content to gcrypt and git-lfs

Fix serious regression in gcrypt and encrypted git-lfs remotes.
Since version 7.20200202.7, git-annex incorrectly stored content
on those remotes without encrypting it.

Problem was, Remote.Git enumerates all git remotes, including git-lfs
and gcrypt. It then dispatches to those. So, Remote.List used the
RemoteConfigParser from Remote.Git, instead of from git-lfs or gcrypt,
and that parser does not know about encryption fields, so did not
include them in the ParsedRemoteConfig. (Also didn't include other
fields specific to those remotes, perhaps chunking etc also didn't
get through.)

To fix, had to move RemoteConfig parsing down into the generate methods
of each remote, rather than doing it in Remote.List.

And a consequence of that was that ParsedRemoteConfig had to change to
include the RemoteConfig that got parsed, so that testremote can
generate a new remote based on an existing remote.

(I would have rather fixed this just inside Remote.Git, but that was not
practical, at least not w/o re-doing work that Remote.List already did.
Big ugly mostly mechanical patch seemed preferable to making git-annex
slower.)
This commit is contained in:
Joey Hess 2020-02-26 17:20:56 -04:00
parent cd8a208b8c
commit 8af6d2c3c5
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
31 changed files with 202 additions and 151 deletions

View file

@ -73,8 +73,9 @@ remote = specialRemoteType $ RemoteType
urlField :: RemoteConfigField
urlField = Accepted "url"
gen :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
gen r u c gc rs = do
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)
gen r u rc gc rs = do
c <- parsedRemoteConfig remote rc
-- 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
@ -85,14 +86,18 @@ gen r u c gc rs = do
sem <- liftIO $ MSemN.new 1
h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing sem r' gc
cst <- remoteCost gc expensiveRemoteCost
let specialcfg = (specialRemoteCfg c)
-- chunking would not improve git-lfs
{ chunkConfig = NoChunks
}
return $ Just $ specialRemote' specialcfg c
(simplyPrepare $ store rs h)
(simplyPrepare $ retrieve rs h)
(simplyPrepare $ remove h)
(simplyPrepare $ checkKey rs h)
(this cst)
(this c cst)
where
this cst = Remote
this c cst = Remote
{ uuid = u
, cost = cst
, name = Git.repoDescribe r
@ -122,15 +127,11 @@ gen r u c gc rs = do
-- content cannot be removed from a git-lfs repo
, appendonly = True
, mkUnavailable = return Nothing
, getInfo = gitRepoInfo (this cst)
, getInfo = gitRepoInfo (this c cst)
, claimUrl = Nothing
, checkUrl = Nothing
, remoteStateHandle = rs
}
specialcfg = (specialRemoteCfg c)
-- chunking would not improve git-lfs
{ chunkConfig = NoChunks
}
mySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
mySetup _ mu _ c gc = do