X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=pgg-epg.el;h=69631130f6640bb41eaea383cf4e119175e492e6;hb=c165609a9c48703317640231336ce8fa9e2ee4e9;hp=6153f0b1e1e227a425dfd2eecf35fbce33478403;hpb=0aaa0d9d521bd62d32cf5b4f2a1d56a901804a76;p=elisp%2Fepg.git diff --git a/pgg-epg.el b/pgg-epg.el index 6153f0b..6963113 100644 --- a/pgg-epg.el +++ b/pgg-epg.el @@ -28,6 +28,27 @@ (require 'epg) (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) + (epg-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))))) + (defun pgg-epg-encrypt-region (start end recipients &optional sign passphrase) "This function is for internal use only. @@ -38,14 +59,30 @@ 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) ;Some Gnus users hate 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) + (get-buffer-create pgg-output-buffer) + (get-buffer-create pgg-errors-buffer) + (condition-case error + (setq cipher + (epg-encrypt-string context + (buffer-substring start end) + (mapcar + (lambda (recipient) + (car (epg-list-keys 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)) (erase-buffer) @@ -69,10 +106,21 @@ 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) ;Some Gnus users hate 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) + (get-buffer-create pgg-output-buffer) + (get-buffer-create pgg-errors-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)))) (save-excursion (set-buffer (get-buffer-create pgg-output-buffer)) (erase-buffer) @@ -87,29 +135,44 @@ 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) ;Some Gnus users hate 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 - 'clearsign - 'detached))) + (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback) + (get-buffer-create pgg-output-buffer) + (get-buffer-create pgg-errors-buffer) + (condition-case error + (setq signature + (epg-sign-string context + (buffer-substring start end) + (if cleartext + 'clearsign + '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)) (erase-buffer) (insert signature)) t)) -(defvar pgg-epg-verify-results 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)) - verify-results) + (inhibit-redisplay t)) ;Some Gnus users hate flickering (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) + (get-buffer-create pgg-output-buffer) + (get-buffer-create pgg-errors-buffer) (if signature (epg-verify-string context (with-temp-buffer @@ -117,13 +180,12 @@ Verify region between START and END as the detached signature SIGNATURE." (buffer-string)) (buffer-substring start end)) (epg-verify-string context (buffer-substring start end))) - (setq verify-results (reverse (epg-context-result-for context 'verify))) (save-excursion (set-buffer (get-buffer-create pgg-errors-buffer)) - (make-local-variable 'pgg-epg-verify-results) - (setq pgg-epg-verify-results (car verify-results)) + (make-local-variable 'pgg-epg-signatures) + (setq pgg-epg-signatures (epg-context-result-for context 'verify)) (erase-buffer) - (insert (mapconcat #'epg-verify-result-to-string verify-results "\n"))) + (insert (epg-verify-result-to-string pgg-epg-signatures))) t)) (defun pgg-epg-insert-key () @@ -131,6 +193,7 @@ Verify region between START and END as the detached signature SIGNATURE." Insert public key at point." (let ((context (epg-make-context)) + (inhibit-redisplay t) ;Some Gnus users hate flickering pointer) (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) @@ -141,20 +204,21 @@ Insert public key at point." Add all public keys in region between START and END to the keyring." (let ((context (epg-make-context)) + (inhibit-redisplay t) ;Some Gnus users hate flickering pointer) (epg-context-set-armor context t) (epg-context-set-textmode context pgg-text-mode) (epg-import-keys context (buffer-substring start end)))) -(defun mml2015-gpg-extract-verify-result-details () - (if pgg-epg-verify-result - (let* ((expired (eq (epg-verify-result-status pgg-epg-verify-result) +(defun mml2015-gpg-extract-signature-details () + (if pgg-epg-signatures + (let* ((expired (eq (epg-signature-status (car pgg-epg-signatures)) 'key-expired)) - (signer (cons (epg-verify-result-key-id pgg-epg-verify-result) - (epg-verify-result-user-id pgg-epg-verify-result))) - (fprint (epg-verify-result-fingerprint pgg-epg-verify-result)) + (signer (cons (epg-signature-key-id (car pgg-epg-signatures)) + (epg-signature-user-id (car pgg-epg-signatures)))) + (fprint (epg-signature-fingerprint (car pgg-epg-signatures))) (trust-good-enough-p - (memq (epg-verify-result-validity pgg-epg-verify-result) + (memq (epg-signature-validity (car pgg-epg-signatures)) '(marginal fully ultimate)))) (cond ((and signer fprint) (concat (cdr signer)