This commit is contained in:
Joey Hess 2013-09-27 01:03:50 -04:00
parent 5bd5e604ad
commit b58bb4c8c1
3 changed files with 19 additions and 24 deletions

View file

@ -38,7 +38,6 @@ import Config
import Utility.Gpg import Utility.Gpg
import qualified Annex.Branch import qualified Annex.Branch
import qualified Remote.GCrypt as GCrypt import qualified Remote.GCrypt as GCrypt
import qualified Git.GCrypt
import qualified Types.Remote import qualified Types.Remote
import qualified Data.Text as T import qualified Data.Text as T
@ -295,17 +294,11 @@ getFinishAddDriveR drive = go
r <- liftAnnex $ addRemote $ r <- liftAnnex $ addRemote $
makeGCryptRemote remotename dir keyid makeGCryptRemote remotename dir keyid
return (Types.Remote.uuid r, r) return (Types.Remote.uuid r, r)
go NoRepoKey = do go NoRepoKey = checkGCryptRepoEncryption dir makeunencrypted $ do
pr <- liftAnnex $ inRepo $ Git.GCrypt.probeRepo dir mu <- liftIO $ probeGCryptRemoteUUID dir
case pr of case mu of
Git.GCrypt.Decryptable -> do Just u -> enablegcryptremote u
mu <- liftIO $ probeGCryptRemoteUUID dir Nothing -> error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported."
case mu of
Just u -> enablegcryptremote u
Nothing -> error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported."
Git.GCrypt.NotDecryptable ->
error $ "The drive contains a git repository that is encrypted with a GnuPG key that you do not have."
Git.GCrypt.NotEncrypted -> makeunencrypted
enablegcryptremote u = do enablegcryptremote u = do
mname <- liftAnnex $ getGCryptRemoteName u dir mname <- liftAnnex $ getGCryptRemoteName u dir
case mname of case mname of

View file

@ -21,8 +21,6 @@ import Logs.PreferredContent
import Types.StandardGroups import Types.StandardGroups
import Utility.UserInfo import Utility.UserInfo
import Utility.Gpg import Utility.Gpg
import qualified Remote.GCrypt as GCrypt
import qualified Git.GCrypt
import Types.Remote (RemoteConfigKey) import Types.Remote (RemoteConfigKey)
import Git.Remote import Git.Remote
import Assistant.WebApp.Utility import Assistant.WebApp.Utility
@ -393,16 +391,12 @@ enableRsyncNetGCrypt :: SshInput -> String -> Handler Html
enableRsyncNetGCrypt sshinput reponame = enableRsyncNetGCrypt sshinput reponame =
prepRsyncNet sshinput reponame $ \sshdata -> do prepRsyncNet sshinput reponame $ \sshdata -> do
let repourl = sshUrl True sshdata let repourl = sshUrl True sshdata
pr <- liftAnnex $ inRepo $ Git.GCrypt.probeRepo repourl checkGCryptRepoEncryption repourl notencrypted $
case pr of setupCloudRemote TransferGroup $
Git.GCrypt.Decryptable -> enableSpecialRemote reponame GCrypt.remote $ M.fromList
setupCloudRemote TransferGroup $ [("gitrepo", repourl)]
enableSpecialRemote reponame GCrypt.remote $ M.fromList where
[("gitrepo", repourl)] notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository."
Git.GCrypt.NotDecryptable ->
error "The drive contains a git repository that is encrypted with a GnuPG key that you do not have."
Git.GCrypt.NotEncrypted ->
error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository."
{- Prepares rsync.net ssh key, and if successful, runs an action with {- Prepares rsync.net ssh key, and if successful, runs an action with
- its SshData. -} - its SshData. -}

View file

@ -72,3 +72,11 @@ getGCryptRemoteName u repoloc = do
void $ inRepo $ Git.Remote.remove tmpremote void $ inRepo $ Git.Remote.remove tmpremote
return mname return mname
checkGCryptRepoEncryption :: String -> Handler Html -> Handler Html -> Handler Html
checkGCryptRepoEncryption location notencrypted encrypted =
dispatch =<< liftAnnex (inRepo $ Git.GCrypt.probeRepo location)
where
dispatch Git.GCrypt.Decryptable = encrypted
dispatch Git.GCrypt.NotEncrypted = notencrypted
dispatch Git.GCrypt.NotDecryptable =
error "This git repository is encrypted with a GnuPG key that you do not have."