X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=pgg-epg.el;h=86c61550d1d685fbd03a6139f1e2adbb61915c1d;hb=9d2c627fd773120cd54b7db58bf85b6b51337e18;hp=1c8a1332426ddc6a515714c61e1309547d8ba047;hpb=75f1f5eb5623d49dcc05dfb8c2428e1d37d60df7;p=elisp%2Fepg.git diff --git a/pgg-epg.el b/pgg-epg.el index 1c8a133..86c6155 100644 --- a/pgg-epg.el +++ b/pgg-epg.el @@ -1,10 +1,10 @@ -;;; pgg-epg.el --- Gnus/PGG backend of EasyPG. +;;; pgg-epg.el --- Gnus' PGG backend of EasyPG. ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, ;; 2005, 2006 Free Software Foundation, Inc. ;; Copyright (C) 2006 Daiki Ueno ;; Author: Daiki Ueno -;; Keywords: PGP, GnuPG +;; Keywords: PGP, GnuPG, Gnus ;; This file is part of EasyPG. @@ -23,11 +23,37 @@ ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. +;;; Commentary: + +;; To use, add (setq pgg-scheme 'epg) to your ~/.gnus. + ;;; Code: -(require 'epg) +(require 'epa) (eval-when-compile (require 'pgg)) +(defvar pgg-epg-secret-key-id-list nil) + +(defun pgg-epg-passphrase-callback (context key-id ignore) + (if (eq key-id 'SYM) + (epa-passphrase-callback-function context key-id nil) + (let* ((entry (assoc key-id epg-user-id-alist)) + (passphrase + (pgg-read-passphrase + (format "GnuPG passphrase for %s: " + (if entry + (cdr entry) + key-id)) + (if (eq key-id 'PIN) + "PIN" + key-id)))) + (when passphrase + (pgg-add-passphrase-to-cache key-id passphrase) + (setq pgg-epg-secret-key-id-list + (cons key-id pgg-epg-secret-key-id-list)) + (copy-sequence passphrase))))) + +(defvar inhibit-redisplay) (defun pgg-epg-encrypt-region (start end recipients &optional sign passphrase) "This function is for internal use only. @@ -38,17 +64,35 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt. If optional PASSPHRASE is not specified, it will be obtained from the passphrase cache or user." (let ((context (epg-make-context)) + (inhibit-redisplay t) ;Gnus users don't like flickering cipher) (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) - (setq cipher (epg-encrypt-string context (buffer-substring start end) - (if pgg-encrypt-for-me - (cons pgg-default-user-id recipients) - recipients) - sign t)) + (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback) (save-excursion (set-buffer (get-buffer-create pgg-output-buffer)) (erase-buffer) + (set-buffer (get-buffer-create pgg-errors-buffer)) + (erase-buffer)) + (condition-case error + (setq cipher + (epg-encrypt-string context + (buffer-substring start end) + (mapcar + (lambda (recipient) + (car (epg-list-keys context recipient))) + (if pgg-encrypt-for-me + (cons pgg-default-user-id recipients) + recipients)) + sign t) + pgg-epg-secret-key-id-list nil) + (error + (while pgg-epg-secret-key-id-list + (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list)) + (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) + (save-excursion + (set-buffer (get-buffer-create pgg-output-buffer)) (insert cipher)) t)) @@ -69,13 +113,30 @@ Decrypt the current region between START and END. If optional PASSPHRASE is not specified, it will be obtained from the passphrase cache or user." (let ((context (epg-make-context)) + (inhibit-redisplay t) ;Gnus users don't like flickering plain) (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) - (setq plain (epg-decrypt-string context (buffer-substring start end))) + (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback) (save-excursion (set-buffer (get-buffer-create pgg-output-buffer)) (erase-buffer) + (set-buffer (get-buffer-create pgg-errors-buffer)) + (erase-buffer)) + (condition-case error + (setq plain + (epg-decrypt-string context (buffer-substring start end)) + pgg-epg-secret-key-id-list nil) + (error + (while pgg-epg-secret-key-id-list + (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list)) + (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) + (if (and pgg-text-mode + (fboundp 'decode-coding-string)) + (setq plain (decode-coding-string plain 'raw-text))) + (save-excursion + (set-buffer (get-buffer-create pgg-output-buffer)) (insert plain)) t)) @@ -87,77 +148,112 @@ Make detached signature from text between START and END. If optional PASSPHRASE is not specified, it will be obtained from the passphrase cache or user." (let ((context (epg-make-context)) + (inhibit-redisplay t) ;Gnus users don't like flickering signature) (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) - (setq signature (epg-sign-string context (buffer-substring start end) - (if cleartext - 'cleartext - 'detached))) + (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback) + (epg-context-set-signers + context + (list (car (epg-list-keys context pgg-default-user-id t)))) + (save-excursion + (set-buffer (get-buffer-create pgg-output-buffer)) + (erase-buffer) + (set-buffer (get-buffer-create pgg-errors-buffer)) + (erase-buffer)) + (condition-case error + (setq signature + (epg-sign-string context + (buffer-substring start end) + (if cleartext + 'clear + 'detached)) + pgg-epg-secret-key-id-list nil) + (error + (while pgg-epg-secret-key-id-list + (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list)) + (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) (save-excursion (set-buffer (get-buffer-create pgg-output-buffer)) (insert signature)) t)) -(defvar pgg-epg-signature nil) +(defvar pgg-epg-signatures nil) (defun pgg-epg-verify-region (start end &optional signature) "This function is for internal use only. Verify region between START and END as the detached signature SIGNATURE." (let ((context (epg-make-context)) - pointer) + (inhibit-redisplay t)) ;Gnus users don't like flickering (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) + (save-excursion + (set-buffer (get-buffer-create pgg-output-buffer)) + (erase-buffer) + (set-buffer (get-buffer-create pgg-errors-buffer)) + (erase-buffer)) (if signature - (epg-verify-file context signature (buffer-substring start end) nil) + (epg-verify-string context + (with-temp-buffer + (insert-file-contents signature) + (buffer-string)) + (buffer-substring start end)) (epg-verify-string context (buffer-substring start end))) - (setq signature (reverse (epg-context-result-for context 'verify)) - pointer signature) (save-excursion (set-buffer (get-buffer-create pgg-errors-buffer)) - (make-local-variable 'pgg-epg-signature) - (setq pgg-epg-signature (car signature)) - (erase-buffer) - (while pointer - (insert (format "%s: %s %s %s\n" - (epg-signature-status (car pointer)) - (epg-signature-key-id (car pointer)) - (epg-signature-user-id (car pointer)) - (epg-signature-validity (car pointer)))) - (setq pointer (cdr pointer)))) - signature)) + (make-local-variable 'pgg-epg-signatures) + (setq pgg-epg-signatures (epg-context-result-for context 'verify)) + (insert (epg-verify-result-to-string pgg-epg-signatures))) + t)) (defun pgg-epg-insert-key () "This function is for internal use only. Insert public key at point." (let ((context (epg-make-context)) - pointer) + (inhibit-redisplay t) ;Gnus users don't like flickering + ) (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) - (insert (epg-export-keys context pgg-default-user-id)))) + (save-excursion + (set-buffer (get-buffer-create pgg-output-buffer)) + (erase-buffer) + (set-buffer (get-buffer-create pgg-errors-buffer)) + (erase-buffer)) + (insert (epg-export-keys-to-string context pgg-default-user-id)))) (defun pgg-epg-snarf-keys-region (start end) "This function is for internal use only. Add all public keys in region between START and END to the keyring." (let ((context (epg-make-context)) - pointer) + (inhibit-redisplay t) ;Gnus users don't like flickering + ) (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) - (epg-import-keys context (buffer-substring start end)))) + (save-excursion + (set-buffer (get-buffer-create pgg-output-buffer)) + (erase-buffer) + (set-buffer (get-buffer-create pgg-errors-buffer)) + (erase-buffer)) + (epg-import-keys-from-string context (buffer-substring start end)))) +(eval-when-compile + (autoload 'mml2015-gpg-pretty-print-fpr "mml2015")) (defun mml2015-gpg-extract-signature-details () - (if pgg-epg-signature - (let* ((expired (eq (epg-signature-status pgg-epg-signature) + (if pgg-epg-signatures + (let* ((expired (eq (epg-signature-status (car pgg-epg-signatures)) 'key-expired)) - (signer (cons (epg-signature-key-id pgg-epg-signature) - (epg-signature-user-id pgg-epg-signature))) - (fprint (epg-signature-fingerprint pgg-epg-signature)) + (signer (cons (epg-signature-key-id (car pgg-epg-signatures)) + (cdr (assoc (epg-signature-key-id + (car pgg-epg-signatures)) + epg-user-id-alist)))) + (fprint (epg-signature-fingerprint (car pgg-epg-signatures))) (trust-good-enough-p - (memq (epg-signature-validity pgg-epg-signature) - '(marginal fully ultimate)))) + (memq (epg-signature-validity (car pgg-epg-signatures)) + '(marginal full ultimate)))) (cond ((and signer fprint) (concat (cdr signer) (unless trust-good-enough-p @@ -170,6 +266,12 @@ Add all public keys in region between START and END to the keyring." "From unknown user"))) "From unknown user")) +(defun pgg-epg-lookup-key (string &optional type) + "Search keys associated with STRING." + (mapcar (lambda (key) + (epg-sub-key-id (car (epg-key-sub-key-list key)))) + (epg-list-keys (epg-make-context) string (not (null type))))) + (provide 'pgg-epg) ;;; pgg-epg.el ends here