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

2
Remote/Git.hs
View file

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