From 00932eda06d75ac2a154dd44084b6a48736cbbb4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 22 Oct 2013 13:32:10 -0400 Subject: [PATCH] webapp: Fix bug when adding a remote and git-remote-gcrypt is not installed. --- Assistant/WebApp/Configurators/Local.hs | 10 +++++----- Assistant/WebApp/Configurators/Ssh.hs | 20 +++++++++---------- Assistant/WebApp/Gpg.hs | 15 +++++++++++--- debian/changelog | 2 ++ ..._webapp_gives_internal_server_error__.mdwn | 3 +++ 5 files changed, 31 insertions(+), 19 deletions(-) diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index f08694874b..5b495ae677 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -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 diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index ef691ad62f..5ba2c81d7d 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -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. -} diff --git a/Assistant/WebApp/Gpg.hs b/Assistant/WebApp/Gpg.hs index 1f6b5cb187..0456ec56c4 100644 --- a/Assistant/WebApp/Gpg.hs +++ b/Assistant/WebApp/Gpg.hs @@ -79,9 +79,18 @@ getGCryptRemoteName u repoloc = do where missing = error $ "Cannot find configuration for the gcrypt remote at " ++ repoloc -checkGCryptRepoEncryption :: (Monad m, LiftAnnex m) => String -> m a -> m a -> m a -checkGCryptRepoEncryption location notencrypted encrypted = - dispatch =<< liftAnnex (inRepo $ Git.GCrypt.probeRepo location) +{- Checks to see if a repo is encrypted with gcrypt, and runs one action if + - it's not an another if it is. + - + - Since the probing requires gcrypt to be installed, a third action must + - be provided to run if it's not installed. + -} +checkGCryptRepoEncryption :: (Monad m, MonadIO m, LiftAnnex m) => String -> m a -> m a -> m a -> m a +checkGCryptRepoEncryption location notencrypted notinstalled encrypted = + ifM (liftIO isGcryptInstalled) + ( dispatch =<< liftAnnex (inRepo $ Git.GCrypt.probeRepo location) + , notinstalled + ) where dispatch Git.GCrypt.Decryptable = encrypted dispatch Git.GCrypt.NotEncrypted = notencrypted diff --git a/debian/changelog b/debian/changelog index 5644d70668..51dbba396e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,5 +1,7 @@ git-annex (4.20131003) UNRELEASED; urgency=low + * webapp: Fix bug when adding a remote and git-remote-gcrypt + is not installed. * The assitant can now run scheduled incremental fsck jobs on the local repository and remotes. These can be configured using vicfg or with the webapp. diff --git a/doc/bugs/Adding_unencrypted_repo_on_drive_in_webapp_gives_internal_server_error__.mdwn b/doc/bugs/Adding_unencrypted_repo_on_drive_in_webapp_gives_internal_server_error__.mdwn index 99af19d22b..ab98c631ec 100644 --- a/doc/bugs/Adding_unencrypted_repo_on_drive_in_webapp_gives_internal_server_error__.mdwn +++ b/doc/bugs/Adding_unencrypted_repo_on_drive_in_webapp_gives_internal_server_error__.mdwn @@ -64,3 +64,6 @@ h the git-annex assistant, paste in .git/annex/daemon.log """]] I'm not at my computer, will check upstream Git later. Sorry if this has been reported before. + +> This only occurred when git-remote-gcrypt was not installed. +> I've fixed the bug. [[done]] --[[Joey]]