From e8e209f4e50c23f2d720dad4dc027ed4bf34f8fe Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 19 Sep 2013 12:53:24 -0400 Subject: [PATCH] better probing for gcrypt repositories using new --check option Now can tell if a repo uses gcrypt or not, and whether it's decryptable with the current gpg keys. This closes the hole that undecryptable gcrypt repos could have before been combined into the repo in encrypted mode. --- Assistant/WebApp/Configurators/Local.hs | 25 ++++++++--------- Git/GCrypt.hs | 36 ++++++++++++++----------- Remote/GCrypt.hs | 2 +- Remote/Git.hs | 2 +- debian/control | 2 +- 5 files changed, 35 insertions(+), 32 deletions(-) diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index ab1e7270bc..6b96f91485 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -307,24 +307,21 @@ getFinishAddDriveR drive = go , page "Encrypt repository" (Just Configuration) $ $(widgetFile "configurators/needgcrypt") ) - {- Either making a new unencrypted repo, or combining with - - an existing unencrypted repo, or combining with an existing - - gcrypt special remot, or some other existing gcrypt repo. -} go NoRepoKey = do - mu <- liftIO $ probeGCryptRemoteUUID dir - case mu of - Just u -> enablegcryptremote u - Nothing -> - ifM (liftAnnex $ inRepo $ Git.GCrypt.probeGCryptRepo dir) - ( error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported." - , makeunencrypted - ) - {- Sync the git-annex branch from the gcrypt repo, in order to - - make sure we know how the special remote should be set up. -} + 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 enablegcryptremote u = do mname <- liftAnnex $ getGCryptRemoteName u dir case mname of - Nothing -> error $ "Unable to use the gcrypt remote at " ++ dir ++ ". Perhaps it is encrypted using a GnuPG key that you do not have?" + Nothing -> error $ "Cannot find configuration for the gcrypt remote at " ++ dir Just name -> makewith $ const $ do r <- liftAnnex $ addRemote $ enableSpecialRemote name GCrypt.remote $ M.fromList diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index c8c193c453..f2f38dfa4f 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -32,8 +32,8 @@ isEncrypted _ = False - Throws an exception if an url is invalid or the repo does not use - gcrypt. -} -encryptedRepo :: Repo -> Repo -> IO Repo -encryptedRepo baserepo = go +encryptedRemote :: Repo -> Repo -> IO Repo +encryptedRemote baserepo = go where go Repo { location = Url url } | urlPrefix `isPrefixOf` u = @@ -45,20 +45,26 @@ encryptedRepo baserepo = go go _ = notencrypted notencrypted = error "not a gcrypt encrypted repository" -{- Checks if the git repo at a location is a gcrypt repo that - - we can decrypt. This works by trying to fetch from the repo - - at the location, into the baserepo. - - - - Returns false if the git repo is not using gcrypt, or if it is using - - gcrypt but cannot be decrypted. We do not try to detect gcrypt - - repos that cannot be decrypted, because gcrypt may change in the future - - to avoid easy fingerprinting of gcrypt repos. +data ProbeResult = Decryptable | NotDecryptable | NotEncrypted + +{- Checks if the git repo at a location uses gcrypt. + - + - Rather expensive -- many need to fetch the entire repo contents. + - (Which is fine if the repo is going to be added as a remote..) -} -probeGCryptRepo :: FilePath -> Repo -> IO Bool -probeGCryptRepo dir baserepo = catchBoolIO $ Command.runBool - [ Param "fetch" - , Param $ urlPrefix ++ dir - ] baserepo +probeRepo :: String -> Repo -> IO ProbeResult +probeRepo loc baserepo = do + let p = proc "git" $ toCommand $ Command.gitCommandLine + [ Param "remote-gcrypt" + , Param "--check" + , Param loc + ] baserepo + (_, _, _, pid) <- createProcess p + code <- waitForProcess pid + return $ case code of + ExitSuccess -> Decryptable + ExitFailure 1 -> NotDecryptable + ExitFailure _ -> NotEncrypted type RemoteName = String type GCryptId = String diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index d5448ca64c..27d3686903 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -50,7 +50,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remot gen gcryptr u c gc = do g <- gitRepo -- get underlying git repo with real path, not gcrypt path - r <- liftIO $ Git.GCrypt.encryptedRepo g gcryptr + r <- liftIO $ Git.GCrypt.encryptedRemote g gcryptr let r' = r { Git.remoteName = Git.remoteName gcryptr } (mgcryptid, r'') <- liftIO $ getGCryptId r' -- doublecheck that local cache matches underlying repo's gcrypt-id diff --git a/Remote/Git.hs b/Remote/Git.hs index d761b03bae..2802db9ae0 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -128,7 +128,7 @@ repoAvail r | Git.GCrypt.isEncrypted r = do g <- gitRepo liftIO $ do - er <- Git.GCrypt.encryptedRepo g r + er <- Git.GCrypt.encryptedRemote g r if Git.repoIsLocal er || Git.repoIsLocalUnknown er then catchBoolIO $ void (Git.Config.read er) >> return True diff --git a/debian/control b/debian/control index 5c42e34422..fc7e3d6088 100644 --- a/debian/control +++ b/debian/control @@ -72,7 +72,7 @@ Depends: ${misc:Depends}, ${shlibs:Depends}, wget, curl, openssh-client (>= 1:5.6p1) -Recommends: lsof, gnupg, bind9-host, ssh-askpass, quvi, git-remote-gcrypt +Recommends: lsof, gnupg, bind9-host, ssh-askpass, quvi, git-remote-gcrypt (>= 0.20130908-4) Suggests: graphviz, bup, libnss-mdns Description: manage files with git, without checking their contents into git git-annex allows managing files with git, without checking the file