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

webapp: Fix bug when adding a remote and git-remote-gcrypt is not installed.

Browse source
This commit is contained in:
Joey Hess 2013-10-22 13:32:10 -04:00
parent c1166aaad7
commit 00932eda06
5 changed files with 31 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -294,11 +294,11 @@ getFinishAddDriveR drive = go
r <- liftAnnex $ addRemote $
makeGCryptRemote remotename dir keyid
return (Types.Remote.uuid r, r)
go NoRepoKey = checkGCryptRepoEncryption dir makeunencrypted $ do
mu <- liftAnnex $ probeGCryptRemoteUUID dir
case mu of
Just u -> enableexistinggcryptremote u
Nothing -> error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported."
go NoRepoKey = checkGCryptRepoEncryption dir makeunencrypted makeunencrypted $ do
mu <- liftAnnex $ probeGCryptRemoteUUID dir
case mu of
Just u -> enableexistinggcryptremote u
Nothing -> error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported."
enableexistinggcryptremote u = do
remotename' <- liftAnnex $ getGCryptRemoteName u dir
makewith $ const $ do

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

@ -342,15 +342,12 @@ getMakeSshGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $
{- Detect if the user entered a location with an existing, known
- gcrypt repository, and enable it. Otherwise, runs the action. -}
checkExistingGCrypt :: SshData -> Widget -> Widget
checkExistingGCrypt sshdata nope = ifM (liftIO isGcryptInstalled)
( checkGCryptRepoEncryption repourl nope $ do
mu <- liftAnnex $ probeGCryptRemoteUUID repourl
case mu of
Just u -> void $ liftH $
combineExistingGCrypt sshdata u
Nothing -> error "The location contains a gcrypt repository that is not a git-annex special remote. This is not supported."
, nope
)
checkExistingGCrypt sshdata nope = checkGCryptRepoEncryption repourl nope nope $ do
mu <- liftAnnex $ probeGCryptRemoteUUID repourl
case mu of
Just u -> void $ liftH $
combineExistingGCrypt sshdata u
Nothing -> error "The location contains a gcrypt repository that is not a git-annex special remote. This is not supported."
where
repourl = genSshUrl sshdata
@ -465,11 +462,12 @@ enableRsyncNet sshinput reponame =
enableRsyncNetGCrypt :: SshInput -> RemoteName -> Handler Html
enableRsyncNetGCrypt sshinput reponame =
prepRsyncNet sshinput reponame $ \sshdata ->
checkGCryptRepoEncryption (genSshUrl sshdata) notencrypted $
prepRsyncNet sshinput reponame $ \sshdata -> whenGcryptInstalled $
checkGCryptRepoEncryption (genSshUrl sshdata) notencrypted notinstalled $
enableGCrypt sshdata reponame
where
notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository."
notinstalled = error "internal"
{- Prepares rsync.net ssh key, and if successful, runs an action with
- its SshData. -}