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

make testremote work with gcrypt repos

Browse source 
This involved making Remote.Gcrypt.gen expect a Repo with a regular,
non-gcrypt path. Since tht is what's stored as the Remote's gitrepo,
testremote can then modify it and feed it back into gen.
This commit is contained in:
Joey Hess 2014-08-04 08:42:04 -04:00
parent db54981a4c
commit 6f4592966d
2 changed files with 15 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
Remote/GCrypt.hs
View file

@ -7,7 +7,7 @@
module Remote.GCrypt (
remote,
gen,
chainGen,
getGCryptUUID,
coreGCryptId,
setupRepo
@ -57,19 +57,24 @@ remote = RemoteType {
setup = gCryptSetup
}
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen gcryptr u c gc = do
chainGen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
chainGen gcryptr u c gc = do
g <- gitRepo
-- get underlying git repo with real path, not gcrypt path
r <- liftIO $ Git.GCrypt.encryptedRemote g gcryptr
let r' = r { Git.remoteName = Git.remoteName gcryptr }
gen r' u c gc
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen baser u c gc = do
-- doublecheck that cache matches underlying repo's gcrypt-id
-- (which might not be set), only for local repos
(mgcryptid, r'') <- getGCryptId True r'
case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of
(mgcryptid, r) <- getGCryptId True baser
g <- gitRepo
case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName baser)) of
(Just gcryptid, Just cachedgcryptid)
| gcryptid /= cachedgcryptid -> resetup gcryptid r''
_ -> gen' r'' u c gc
| gcryptid /= cachedgcryptid -> resetup gcryptid r
_ -> gen' r u c gc
where
-- A different drive may have been mounted, making a different
-- gcrypt remote available. So need to set the cached
@ -79,10 +84,10 @@ gen gcryptr u c gc = do
resetup gcryptid r = do
let u' = genUUIDInNameSpace gCryptNameSpace gcryptid
v <- M.lookup u' <$> readRemoteLog
case (Git.remoteName gcryptr, v) of
case (Git.remoteName baser, v) of
(Just remotename, Just c') -> do
setGcryptEncryption c' remotename
setConfig (remoteConfig gcryptr "uuid") (fromUUID u')
setConfig (remoteConfig baser "uuid") (fromUUID u')
setConfig (ConfigKey $ Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
gen' r u' c' gc
_ -> do

2
Remote/Git.hs
View file

@ -127,7 +127,7 @@ configRead r = do
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r u c gc
| Git.GCrypt.isEncrypted r = Remote.GCrypt.gen r u c gc
| Git.GCrypt.isEncrypted r = Remote.GCrypt.chainGen r u c gc
| otherwise = go <$> remoteCost gc defcst
where
defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost