X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmml2015.el;h=f8f0a560417baf6c69937dfb5377c1f075d81b00;hb=ea60ea3c05a8391dcdc00251d1744e1558d7f7d4;hp=eb01c924c2dc1bb156f2b4f5313f3fa74c8548c5;hpb=b45aca7c770b410e86cdd2840abd31bdb56620a4;p=gnus diff --git a/lisp/mml2015.el b/lisp/mml2015.el index eb01c924c..f8f0a5604 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -1,6 +1,6 @@ ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -;; Copyright (C) 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 2000-2012 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: PGP MIME MML @@ -55,9 +55,15 @@ 'epg) (error)) (progn - (ignore-errors (require 'pgg)) - (and (fboundp 'pgg-sign-region) - 'pgg)) + (let ((abs-file (locate-library "pgg"))) + ;; Don't load PGG if it is marked as obsolete + ;; (Emacs 24). + (when (and abs-file + (not (string-match "/obsolete/[^/]*\\'" + abs-file))) + (ignore-errors (require 'pgg)) + (and (fboundp 'pgg-sign-region) + 'pgg)))) (progn (ignore-errors (load "mc-toplev")) (and (fboundp 'mc-encrypt-generic) @@ -116,7 +122,8 @@ Whether the passphrase is cached at all is controlled by :type 'integer) (defcustom mml2015-signers nil - "A list of your own key ID which will be used to sign a message." + "A list of your own key ID(s) which will be used to sign a message. +If set, it overrides the setting of `mml2015-sign-with-sender'." :group 'mime-security :type '(repeat (string :tag "Key ID"))) @@ -728,6 +735,7 @@ Whether the passphrase is cached at all is controlled by (defvar epg-user-id-alist) (defvar epg-digest-algorithm-alist) +(defvar epg-gpg-program) (defvar inhibit-redisplay) (autoload 'epg-make-context "epg") @@ -736,7 +744,6 @@ Whether the passphrase is cached at all is controlled by (autoload 'epg-context-set-signers "epg") (autoload 'epg-context-result-for "epg") (autoload 'epg-new-signature-digest-algorithm "epg") -(autoload 'epg-verify-result-to-string "epg") (autoload 'epg-list-keys "epg") (autoload 'epg-decrypt-string "epg") (autoload 'epg-verify-string "epg") @@ -748,6 +755,8 @@ Whether the passphrase is cached at all is controlled by (autoload 'epg-sub-key-capability "epg") (autoload 'epg-sub-key-validity "epg") (autoload 'epg-sub-key-fingerprint "epg") +(autoload 'epg-signature-key-id "epg") +(autoload 'epg-signature-to-string "epg") (autoload 'epg-configuration "epg-config") (autoload 'epg-expand-group "epg-config") (autoload 'epa-select-keys "epa") @@ -781,13 +790,16 @@ Whether the passphrase is cached at all is controlled by (catch 'found (while keys (let ((pointer (epg-key-sub-key-list (car keys)))) - (while pointer - (if (and (memq usage (epg-sub-key-capability (car pointer))) - (not (memq 'disabled (epg-sub-key-capability (car pointer)))) - (not (memq (epg-sub-key-validity (car pointer)) - '(revoked expired)))) - (throw 'found (car keys))) - (setq pointer (cdr pointer)))) + ;; The primary key will be marked as disabled, when the entire + ;; key is disabled (see 12 Field, Format of colon listings, in + ;; gnupg/doc/DETAILS) + (unless (memq 'disabled (epg-sub-key-capability (car pointer))) + (while pointer + (if (and (memq usage (epg-sub-key-capability (car pointer))) + (not (memq (epg-sub-key-validity (car pointer)) + '(revoked expired)))) + (throw 'found (car keys))) + (setq pointer (cdr pointer))))) (setq keys (cdr keys))))) ;; XXX: since gpg --list-secret-keys does not return validity of each @@ -808,6 +820,35 @@ Whether the passphrase is cached at all is controlled by (setq secret-keys (cdr secret-keys)))) secret-key)) +(defun mml2015-epg-key-image (key-id) + "Return the image of a key, if any" + (with-temp-buffer + (mm-set-buffer-multibyte nil) + (let* ((coding-system-for-write 'binary) + (coding-system-for-read 'binary) + (data (shell-command-to-string + (format "%s --list-options no-show-photos --attribute-fd 3 --list-keys %s 3>&1 >/dev/null 2>&1" + epg-gpg-program key-id)))) + (when (> (length data) 0) + (insert (substring data 16)) + (create-image (buffer-string) nil t))))) + +(defun mml2015-epg-key-image-to-string (key-id) + "Return a string with the image of a key, if any" + (let* ((result "") + (key-image (mml2015-epg-key-image key-id))) + (when key-image + (setq result " ") + (put-text-property 1 2 'display key-image result)) + result)) + +(defun mml2015-epg-signature-to-string (signature) + (concat (epg-signature-to-string signature) + (mml2015-epg-key-image-to-string (epg-signature-key-id signature)))) + +(defun mml2015-epg-verify-result-to-string (verify-result) + (mapconcat #'mml2015-epg-signature-to-string verify-result "\n")) + (defun mml2015-epg-decrypt (handle ctl) (catch 'error (let ((inhibit-redisplay t) @@ -850,7 +891,7 @@ Whether the passphrase is cached at all is controlled by (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info (concat "OK\n" - (epg-verify-result-to-string + (mml2015-epg-verify-result-to-string (epg-context-result-for context 'verify)))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK")) @@ -898,7 +939,7 @@ Whether the passphrase is cached at all is controlled by (if (epg-context-result-for context 'verify) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details - (epg-verify-result-to-string + (mml2015-epg-verify-result-to-string (epg-context-result-for context 'verify))))))) (defun mml2015-epg-verify (handle ctl) @@ -916,7 +957,7 @@ Whether the passphrase is cached at all is controlled by (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) - (setq part (mm-replace-in-string part "\n" "\r\n" t) + (setq part (mm-replace-in-string part "\n" "\r\n") signature (mm-get-part signature) context (epg-make-context)) (condition-case error @@ -932,7 +973,8 @@ Whether the passphrase is cached at all is controlled by (throw 'error handle))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info - (epg-verify-result-to-string (epg-context-result-for context 'verify))) + (mml2015-epg-verify-result-to-string + (epg-context-result-for context 'verify))) handle))) (defun mml2015-epg-clear-verify () @@ -955,7 +997,7 @@ Whether the passphrase is cached at all is controlled by (progn (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info - (epg-verify-result-to-string + (mml2015-epg-verify-result-to-string (epg-context-result-for context 'verify))) (delete-region (point-min) (point-max)) (insert (mm-decode-coding-string plain coding-system-for-read))) @@ -965,8 +1007,10 @@ Whether the passphrase is cached at all is controlled by (let* ((inhibit-redisplay t) (context (epg-make-context)) (boundary (mml-compute-boundary cont)) - (sender (when mml2015-sign-with-sender - message-options-get 'message-sender)) + (sender (message-options-get 'message-sender)) + (signer-names (or mml2015-signers + (if (and mml2015-sign-with-sender sender) + (list (concat "<" sender ">"))))) signer-key (signers (or (message-options-get 'mml2015-epg-signers) @@ -976,10 +1020,7 @@ Whether the passphrase is cached at all is controlled by (epa-select-keys context "\ Select keys for signing. If no one is selected, default secret key is used. " - (if sender - (cons (concat "<" sender ">") - mml2015-signers) - mml2015-signers) + signer-names t) (if (or sender mml2015-signers) (delq nil @@ -995,10 +1036,7 @@ If no one is selected, default secret key is used. " signer))) (error "No secret key for %s" signer)) signer-key) - (if sender - (cons (concat "<" sender ">") - mml2015-signers) - mml2015-signers)))))))) + signer-names))))))) signature micalg) (epg-context-set-armor context t) (epg-context-set-textmode context t) @@ -1038,15 +1076,18 @@ If no one is selected, default secret key is used. " (goto-char (point-max)))) (defun mml2015-epg-encrypt (cont &optional sign) - (let ((inhibit-redisplay t) - (context (epg-make-context)) - (config (epg-configuration)) - (sender (when mml2015-sign-with-sender - (message-options-get 'message-sender))) - (recipients (message-options-get 'mml2015-epg-recipients)) - cipher signers - (boundary (mml-compute-boundary cont)) - recipient-key signer-key) + (let* ((inhibit-redisplay t) + (context (epg-make-context)) + (boundary (mml-compute-boundary cont)) + (config (epg-configuration)) + (recipients (message-options-get 'mml2015-epg-recipients)) + cipher + (sender (message-options-get 'message-sender)) + (signer-names (or mml2015-signers + (if (and mml2015-sign-with-sender sender) + (list (concat "<" sender ">"))))) + signers + recipient-key signer-key) (unless recipients (setq recipients (apply #'nconc @@ -1060,12 +1101,9 @@ If no one is selected, default secret key is used. " (read-string "Recipients: "))) "[ \f\t\n\r\v,]+")))) (when mml2015-encrypt-to-self - (unless (or sender mml2015-signers) - (error "Message sender and mml2015-signers not set")) - (setq recipients (nconc recipients (if sender - (cons (concat "<" sender ">") - mml2015-signers) - mml2015-signers)))) + (unless signer-names + (error "Neither message sender nor mml2015-signers are set")) + (setq recipients (nconc recipients signer-names))) (if (eq mm-encrypt-option 'guided) (setq recipients (epa-select-keys context "\ @@ -1098,10 +1136,7 @@ If no one is selected, symmetric encryption will be performed. " (epa-select-keys context "\ Select keys for signing. If no one is selected, default secret key is used. " - (if sender - (cons (concat "<" sender ">") - mml2015-signers) - mml2015-signers) + signer-names t) (if (or sender mml2015-signers) (delq nil @@ -1117,9 +1152,7 @@ If no one is selected, default secret key is used. " signer))) (error "No secret key for %s" signer)) signer-key) - (if sender - (cons (concat "<" sender ">") mml2015-signers) - mml2015-signers)))))))) + signer-names))))))) (epg-context-set-signers context signers)) (epg-context-set-armor context t) (epg-context-set-textmode context t)