diff options
| -rw-r--r-- | Git/GCrypt.hs | 36 | ||||
| -rw-r--r-- | Remote/GCrypt.hs | 2 | ||||
| -rw-r--r-- | Remote/Git.hs | 2 | ||||
| -rw-r--r-- | debian/control | 2 |
4 files changed, 24 insertions, 18 deletions
diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index c8c193c45..f2f38dfa4 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 d5448ca64..27d368690 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 d761b03ba..2802db9ae 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 5c42e3442..fc7e3d608 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 |