;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: PGP MIME MML
;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'gnus-clfns))
(require 'mm-decode)
(defvar mml2015-use (or
(setq handles (mm-dissect-buffer t)))
(mm-destroy-parts handle)
(mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "OK")
+ mm-security-handle 'gnus-info
+ (concat "OK"
+ (let ((sig (with-current-buffer mml2015-result-buffer
+ (mml2015-gpg-extract-signature-details))))
+ (concat ", Signer: " sig))))
(if (listp (car handles))
handles
(list handles)))))
(insert (format "--%s--\n" boundary))
(goto-char (point-max))))
-(defun mml2015-mailcrypt-encrypt (cont)
+(defun mml2015-mailcrypt-encrypt (cont &optional sign)
(let ((mc-pgp-always-sign
(or mc-pgp-always-sign
+ sign
(eq t (or (message-options-get 'message-sign-encrypt)
(message-options-set
'message-sign-encrypt
(mc-encrypt-generic
(or (message-options-get 'message-recipients)
(message-options-set 'message-recipients
- (mc-cleanup-recipient-headers
- (read-string "Recipients: "))))
+ (mc-cleanup-recipient-headers
+ (read-string "Recipients: "))))
nil nil nil
(message-options-get 'message-sender))))
(goto-char (point-min))
(autoload 'gpg-verify-cleartext "gpg")
(autoload 'gpg-sign-detached "gpg")
(autoload 'gpg-sign-encrypt "gpg")
+ (autoload 'gpg-encrypt "gpg")
(autoload 'gpg-passphrase-read "gpg"))
(defun mml2015-gpg-passphrase ()
(defun mml2015-gpg-pretty-print-fpr (fingerprint)
(let* ((result "")
- (fpr-length (string-width fingerprint))
- (n-slice 0)
- slice)
+ (fpr-length (string-width fingerprint))
+ (n-slice 0)
+ slice)
(setq fingerprint (string-to-list fingerprint))
(while fingerprint
(setq fpr-length (- fpr-length 4))
(setq fingerprint (nthcdr 4 fingerprint))
(setq n-slice (1+ n-slice))
(setq result
- (concat
- result
- (case n-slice
- (1 slice)
- (otherwise (concat " " slice))))))
+ (concat
+ result
+ (case n-slice
+ (1 slice)
+ (otherwise (concat " " slice))))))
result))
-
+
(defun mml2015-gpg-extract-signature-details ()
(goto-char (point-min))
(if (boundp 'gpg-unabbrev-trust-alist)
- (let* ((signer (and (re-search-forward
- "^\\[GNUPG:\\] GOODSIG [0-9A-Za-z]* \\(.*\\)$"
+ (let* ((expired (re-search-forward
+ "^\\[GNUPG:\\] SIGEXPIRED$"
+ nil t))
+ (signer (and (re-search-forward
+ "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
nil t)
- (match-string 1)))
- (fprint (and (re-search-forward
- "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
+ (cons (match-string 1) (match-string 2))))
+ (fprint (and (re-search-forward
+ "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
nil t)
- (match-string 1)))
- (trust (and (re-search-forward "^\\[GNUPG:\\] \\(TRUST_.*\\)$" nil t)
- (match-string 1)))
- (trust-good-enough-p
- (cdr (assoc (cdr (assoc trust gpg-unabbrev-trust-alist))
+ (match-string 1)))
+ (trust (and (re-search-forward "^\\[GNUPG:\\] \\(TRUST_.*\\)$" nil t)
+ (match-string 1)))
+ (trust-good-enough-p
+ (cdr (assoc (cdr (assoc trust gpg-unabbrev-trust-alist))
mml2015-trust-boundaries-alist))))
- (if (and signer trust fprint)
- (concat signer
- (unless trust-good-enough-p
- (concat "\nUntrusted, Fingerprint: "
- (mml2015-gpg-pretty-print-fpr fprint))))
- "From unknown user"))
+ (cond ((and signer fprint)
+ (concat (cdr signer)
+ (unless trust-good-enough-p
+ (concat "\nUntrusted, Fingerprint: "
+ (mml2015-gpg-pretty-print-fpr fprint)))
+ (when expired
+ (format "\nWARNING: Signature from expired key (%s)"
+ (car signer)))))
+ (t
+ "From unknown user")))
(if (re-search-forward "^gpg: Good signature from \"\\(.*\\)\"$" nil t)
(match-string 1)
"From unknown user")))
(error
(mm-set-handle-multipart-parameter
mm-security-handle 'gnus-details (mml2015-format-error err))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Error.")
- (setq info-is-set-p t)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Error.")
+ (setq info-is-set-p t)
nil)
(quit
(mm-set-handle-multipart-parameter
mm-security-handle 'gnus-details "Quit.")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Quit.")
- (setq info-is-set-p t)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Quit.")
+ (setq info-is-set-p t)
nil))
- (unless info-is-set-p
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed"))
+ (unless info-is-set-p
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))
(throw 'error handle)))
(mm-set-handle-multipart-parameter
mm-security-handle 'gnus-info
(insert (format "--%s--\n" boundary))
(goto-char (point-max)))))
-(defun mml2015-gpg-encrypt (cont)
+(defun mml2015-gpg-encrypt (cont &optional sign)
(let ((boundary
(funcall mml-boundary-function (incf mml-multipart-number)))
(text (current-buffer))
cipher)
(mm-with-unibyte-current-buffer-mule4
(with-temp-buffer
- (unless (gpg-sign-encrypt
- text (setq cipher (current-buffer))
- mml2015-result-buffer
- (split-string
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- "[ \f\t\n\r\v,]+")
- nil
- (message-options-get 'message-sender)
- t t) ; armor & textmode
- (unless (> (point-max) (point-min))
- (pop-to-buffer mml2015-result-buffer)
- (error "Encrypt error")))
+ ;; set up a function to call the correct gpg encrypt routine
+ ;; with the right arguments. (FIXME: this should be done
+ ;; differently.)
+ (flet ((gpg-encrypt-func
+ (sign plaintext ciphertext result recipients &optional
+ passphrase sign-with-key armor textmode)
+ (if sign
+ (gpg-sign-encrypt
+ plaintext ciphertext result recipients passphrase
+ sign-with-key armor textmode)
+ (gpg-encrypt
+ plaintext ciphertext result recipients passphrase
+ armor textmode))))
+ (unless (gpg-encrypt-func
+ sign ; passed in when using signencrypt
+ text (setq cipher (current-buffer))
+ mml2015-result-buffer
+ (split-string
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ "[ \f\t\n\r\v,]+")
+ nil
+ (message-options-get 'message-sender)
+ t t) ; armor & textmode
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer mml2015-result-buffer)
+ (error "Encrypt error"))))
(goto-char (point-min))
(while (re-search-forward "\r+$" nil t)
(replace-match "" t t))
mml2015-use)
;;;###autoload
-(defun mml2015-encrypt (cont)
+(defun mml2015-encrypt (cont &optional sign)
(mml2015-clean-buffer)
(let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
(if func
- (funcall func cont)
+ (funcall func cont sign)
(error "Cannot find encrypt function"))))
;;;###autoload
projects / elisp / gnus.git- / blobdiff