From: Simon Josefsson Date: Wed, 29 Nov 2000 22:11:15 +0000 (+0000) Subject: 2000-11-30 Simon Josefsson X-Git-Url: https://cgit.sxemacs.org/?a=commitdiff_plain;h=e7fb4b99133a4f7919bffc11a47f019b81be2da1;p=gnus 2000-11-30 Simon Josefsson * mml-smime.el (mml-smime-verify): Verify that certificate mail address match sender address. * mm-decode.el (mm-possibly-verify-or-decrypt): Bind sender address. * smime.el (smime-verify-region): Don't copy buffer. (smime-decrypt-buffer): Use expand-file-name on keyfile. (smime-pkcs7-region): New function. (smime-pkcs7-certificates-region): Ditto. (smime-pkcs7-email-region): Ditto. (smime-buffer-as-string-region): Ditto. * gnus-art.el (gnus-mime-security-show-details): Goto beginning of buffer. 2000-11-23 Jens Krinke * smime.el (smime-decrypt-region): Fix keyfile argument. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b69e152e1..ed6b2a5f3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,24 @@ +2000-11-30 Simon Josefsson + + * mml-smime.el (mml-smime-verify): Verify that certificate mail + address match sender address. + + * mm-decode.el (mm-possibly-verify-or-decrypt): Bind sender address. + + * smime.el (smime-verify-region): Don't copy buffer. + (smime-decrypt-buffer): Use expand-file-name on keyfile. + (smime-pkcs7-region): New function. + (smime-pkcs7-certificates-region): Ditto. + (smime-pkcs7-email-region): Ditto. + (smime-buffer-as-string-region): Ditto. + + * gnus-art.el (gnus-mime-security-show-details): Goto beginning of + buffer. + +2000-11-23 Jens Krinke + + * smime.el (smime-decrypt-region): Fix keyfile argument. + 2000-11-29 00:00:00 ShengHuo ZHU * nnmail.el (nnmail-cache-accepted-message-ids): Add doc. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 565585041..4a4c5b096 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -5163,7 +5163,8 @@ For example: (setq gnus-mime-security-details-buffer (gnus-get-buffer-create "*MIME Security Details*"))) (with-current-buffer gnus-mime-security-details-buffer - (insert details)) + (insert details) + (goto-char (point-min))) (pop-to-buffer gnus-mime-security-details-buffer)) (gnus-message 5 "No details.")))) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 9a511069e..537e495ca 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1018,6 +1018,10 @@ If RECURSIVE, search recursively." (defun mm-possibly-verify-or-decrypt (parts ctl) (let ((subtype (cadr (split-string (car ctl) "/"))) (mm-security-handle ctl) ;; (car CTL) is the type. + (from (save-restriction + (mail-narrow-to-head) + (cadr (funcall gnus-extract-address-components + (or (mail-fetch-field "from") ""))))) protocol func functest) (cond ((equal subtype "signed") diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index 146ead4e5..7143239d7 100644 --- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -130,10 +130,26 @@ (when (get-buffer smime-details-buffer) (kill-buffer smime-details-buffer)) (if (smime-verify-buffer) - (progn - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - (kill-buffer smime-details-buffer)) + ;; verify mail addresses in mail against those in certificate + (when (and (smime-pkcs7-region (point-min) (point-max)) + (smime-pkcs7-certificates-region (point-min) (point-max))) + (with-temp-buffer + (insert-buffer-substring (mm-handle-multipart-original-buffer ctl)) + (if (not (member from (and (smime-pkcs7-email-region + (point-min) (point-max)) + (smime-buffer-as-string-region + (point-min) (point-max))))) + (progn + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Sender forged") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (with-current-buffer + (mm-handle-multipart-original-buffer ctl) + (buffer-string)))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + (kill-buffer smime-details-buffer)))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed") (mm-set-handle-multipart-parameter diff --git a/lisp/smime.el b/lisp/smime.el index 530ed8d54..749766c9d 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -36,6 +36,11 @@ ;; Especially, don't expect this library to buy security for you. If ;; you don't understand what you are doing, you're as likely to lose ;; security than gain any by using this library. +;; +;; This library is not intended to provide a "raw" API for S/MIME, +;; PKCSx or similar, it's intended to perform common operations +;; done on messages encoded in these formats. The terminology chosen +;; reflect this. ;;; Quick introduction: @@ -156,7 +161,7 @@ If nil, use system defaults." string) :group 'dig) -(defvar smime-details-buffer "*S/MIME OpenSSL output*") +(defvar smime-details-buffer "*OpenSSL output*") ;; OpenSSL wrappers. @@ -240,28 +245,25 @@ nil." ;; Verify+decrypt region (defun smime-verify-region (b e) - (let ((buffer (generate-new-buffer (generate-new-buffer-name "*smime*"))) + (let ((buffer (get-buffer-create smime-details-buffer)) (CAs (cond (smime-CA-file (list "-CAfile" (expand-file-name smime-CA-file))) (smime-CA-directory (list "-CApath" (expand-file-name smime-CA-directory))) (t (error "No CA configured."))))) - (prog1 - (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" CAs) - (message "S/MIME message verified succesfully.") - (message "S/MIME message NOT verified successfully.") - nil) - (with-current-buffer (get-buffer-create smime-details-buffer) - (goto-char (point-max)) - (insert-buffer buffer)) - (kill-buffer buffer)))) - + (with-current-buffer buffer + (erase-buffer)) + (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" CAs) + (message "S/MIME message verified succesfully.") + (message "S/MIME message NOT verified successfully.") + nil))) + (defun smime-decrypt-region (b e keyfile) (let ((buffer (generate-new-buffer (generate-new-buffer-name "*smime*"))) CAs) (when (apply 'smime-call-openssl-region b e buffer "smime" "-decrypt" - "-recip" keyfile) + "-recip" (list keyfile)) ) (with-current-buffer (get-buffer-create smime-details-buffer) @@ -285,11 +287,55 @@ Uses current buffer if BUFFER is nil, queries user of KEYFILE is nil." (with-current-buffer (or buffer (current-buffer)) (smime-decrypt-region (point-min) (point-max) - (or keyfile - (smime-get-key-by-email - (completing-read "Decrypt with which key? " smime-keys nil nil - (and (listp (car-safe smime-keys)) - (caar smime-keys)))))))) + (expand-file-name + (or keyfile + (smime-get-key-by-email + (completing-read "Decrypt with which key? " smime-keys nil nil + (and (listp (car-safe smime-keys)) + (caar smime-keys))))))))) + +;; Various operations + +(defun smime-pkcs7-region (b e) + "Convert S/MIME message between points B and E into a PKCS7 message." + (let ((buffer (get-buffer-create smime-details-buffer))) + (with-current-buffer buffer + (erase-buffer)) + (when (smime-call-openssl-region b e buffer "smime" "-pk7out") + (delete-region b e) + (insert-buffer-substring buffer) + t))) + +(defun smime-pkcs7-certificates-region (b e) + "Extract any certificates enclosed in PKCS7 message between points B and E." + (let ((buffer (get-buffer-create smime-details-buffer))) + (with-current-buffer buffer + (erase-buffer)) + (when (smime-call-openssl-region b e buffer "pkcs7" "-print_certs" "-text") + (delete-region b e) + (insert-buffer-substring buffer) + t))) + +(defun smime-pkcs7-email-region (b e) + "Get email addresses contained in certificate between points B and E. +A string or a list of strings is returned." + (let ((buffer (get-buffer-create smime-details-buffer))) + (with-current-buffer buffer + (erase-buffer)) + (when (smime-call-openssl-region b e buffer "x509" "-email" "-noout") + (delete-region b e) + (insert-buffer-substring buffer) + t))) + +(defun smime-buffer-as-string-region (b e) + "Return each line in region between B and E as a list of strings." + (save-excursion + (goto-char b) + (let (res) + (while (< (point) e) + (push (buffer-substring (point) (point-at-eol)) res) + (forward-line)) + res))) ;; Find certificates