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

refactor

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

17
Assistant/WebApp/Configurators/Local.hs
View file

@ -38,7 +38,6 @@ import Config
import Utility.Gpg
import qualified Annex.Branch
import qualified Remote.GCrypt as GCrypt
import qualified Git.GCrypt
import qualified Types.Remote
import qualified Data.Text as T
@ -295,17 +294,11 @@ getFinishAddDriveR drive = go
r <- liftAnnex $ addRemote $
makeGCryptRemote remotename dir keyid
return (Types.Remote.uuid r, r)
go NoRepoKey = do
pr <- liftAnnex $ inRepo $ Git.GCrypt.probeRepo dir
case pr of
Git.GCrypt.Decryptable -> do
mu <- liftIO $ probeGCryptRemoteUUID dir
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
go NoRepoKey = checkGCryptRepoEncryption dir makeunencrypted $ do
mu <- liftIO $ probeGCryptRemoteUUID dir
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."
enablegcryptremote u = do
mname <- liftAnnex $ getGCryptRemoteName u dir
case mname of

18
Assistant/WebApp/Configurators/Ssh.hs
View file

@ -21,8 +21,6 @@ import Logs.PreferredContent
import Types.StandardGroups
import Utility.UserInfo
import Utility.Gpg
import qualified Remote.GCrypt as GCrypt
import qualified Git.GCrypt
import Types.Remote (RemoteConfigKey)
import Git.Remote
import Assistant.WebApp.Utility
@ -393,16 +391,12 @@ enableRsyncNetGCrypt :: SshInput -> String -> Handler Html
enableRsyncNetGCrypt sshinput reponame =
prepRsyncNet sshinput reponame $ \sshdata -> do
let repourl = sshUrl True sshdata
pr <- liftAnnex $ inRepo $ Git.GCrypt.probeRepo repourl
case pr of
Git.GCrypt.Decryptable ->
setupCloudRemote TransferGroup $
enableSpecialRemote reponame GCrypt.remote $ M.fromList
[("gitrepo", repourl)]
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."
checkGCryptRepoEncryption repourl notencrypted $
setupCloudRemote TransferGroup $
enableSpecialRemote reponame GCrypt.remote $ M.fromList
[("gitrepo", repourl)]
where
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
- its SshData. -}

8
Assistant/WebApp/Gpg.hs
View file

@ -72,3 +72,11 @@ getGCryptRemoteName u repoloc = do
void $ inRepo $ Git.Remote.remove tmpremote
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."