From: yamaoka Date: Sun, 3 Dec 2000 22:38:16 +0000 (+0000) Subject: Synch with Gnus. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=edaa49802cd17d968e6a84145e9c35b531dd770a;p=elisp%2Fgnus.git- Synch with Gnus. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cf72c33..3b3c495 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,25 @@ +2000-12-03 12:00:00 ShengHuo ZHU + + * mml2015.el (mml2015-fix-micalg): Alg might be nil. + +2000-12-01 Christopher Splinter + + * gnus-sum.el (gnus-summary-limit-to-age): Fix typo. + +2000-12-01 Simon Josefsson + + * mml-smime.el (mml-smime-verify): Fix address parsing. + +2000-12-01 Simon Josefsson + + * mml-smime.el (mml-smime-verify): Don't modify MM buffer. Handle + more than one certificate inside PKCS#7 blob. Better security + information (clamed / actual sender, openssl output, certificates + inside message). + + * smime.el (smime-verify-region): Output to /dev/null. + (smime-buffer-as-string-region): Don't parse empty lines. + 2000-11-30 23:00:00 ShengHuo ZHU * gnus-art.el (gnus-mime-security-button-line-format-alist): Add diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 525e41d..b3a79a3 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -6412,7 +6412,7 @@ articles that are younger than AGE days." (while (not days-got) (setq days (if younger (read-string "Limit to articles within (in days): ") - (read-string "Limit to articles old than (in days): "))) + (read-string "Limit to articles older than (in days): "))) (when (> (length days) 0) (setq days (read days))) (if (numberp days) diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index 16eff67..835516a 100644 --- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -117,8 +117,8 @@ certs)) (defun mml-smime-verify (handle ctl) - (with-current-buffer (mm-handle-multipart-original-buffer ctl) - ;; xxx modifies buffer -- noone else uses the buffer, so what the heck + (with-temp-buffer + (insert-buffer (mm-handle-multipart-original-buffer ctl)) (goto-char (point-min)) (insert (format "Content-Type: %s; " (mm-handle-media-type ctl))) (insert (format "protocol=\"%s\"; " @@ -129,35 +129,51 @@ (mm-handle-multipart-ctl-parameter ctl 'boundary))) (when (get-buffer smime-details-buffer) (kill-buffer smime-details-buffer)) - (if (smime-verify-buffer) + (let ((buf (current-buffer)) + (good-signature (smime-verify-buffer)) + addresses openssl-output) + (setq openssl-output (with-current-buffer smime-details-buffer + (buffer-string))) + (if (not good-signature) + (progn + ;; we couldn't verify message, fail with openssl output as message + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (concat "OpenSSL failed to verify message:\n" + "---------------------------------\n" + openssl-output))) ;; 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 mm-security-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 - mm-security-handle 'gnus-details - (with-current-buffer smime-details-buffer - (buffer-string)))) - handle)) + (insert-buffer-substring buf) + (goto-char (point-min)) + (while (re-search-forward "-----END CERTIFICATE-----" nil t) + (smime-pkcs7-email-region (point-min) (point)) + (setq addresses (append (smime-buffer-as-string-region + (point-min) (point)) addresses)) + (delete-region (point-min) (point))))) + (if (not (member mm-security-from addresses)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Sender forged") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK")) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (concat "Sender clamed to be: " mm-security-from "\n" + (if addresses + (concat "Addresses in certificate: " + (mapconcat 'identity addresses ", ")) + "No addresses found in certificate.") + "\n" "\n" + "OpenSSL output:\n" + "---------------\n" openssl-output "\n" + "Certificate(s) inside S/MIME signature:\n" + "---------------------------------------\n" + (buffer-string) "\n"))))) + handle) (defun mml-smime-verify-test (handle ctl) smime-openssl-program) diff --git a/lisp/mml2015.el b/lisp/mml2015.el index b682d89..126f647 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -131,10 +131,10 @@ mm-security-handle 'gnus-info "Failed")))) (defun mml2015-fix-micalg (alg) - (upcase - (if (and alg (string-match "^pgp-" alg)) - (substring alg (match-end 0)) - alg))) + (and alg + (upcase (if (string-match "^pgp-" alg) + (substring alg (match-end 0)) + alg)))) (defun mml2015-mailcrypt-verify (handle ctl) (catch 'error diff --git a/lisp/smime.el b/lisp/smime.el index 2f40b62..0653b56 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -254,7 +254,8 @@ nil." (error "No CA configured."))))) (with-current-buffer buffer (erase-buffer)) - (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" CAs) + (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify" + "-out" "/dev/null" CAs) (message "S/MIME message verified succesfully.") (message "S/MIME message NOT verified successfully.") nil))) @@ -338,7 +339,9 @@ A string or a list of strings is returned." (goto-char b) (let (res) (while (< (point) e) - (push (buffer-substring (point) (smime-point-at-eol)) res) + (let ((str (buffer-substring (point) (smime-point-at-eol)))) + (unless (string= "" str) + (push str res))) (forward-line)) res))) diff --git a/lisp/starttls.el b/lisp/starttls.el index 529dea5..cf6530d 100644 --- a/lisp/starttls.el +++ b/lisp/starttls.el @@ -1,8 +1,8 @@ -;;; starttls.el --- TLSv1 functions +;;; starttls.el --- STARTTLS functions -;; Copyright (C) 1999 Daiki Ueno +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. -;; Author: Daiki Ueno +;; Author: Daiki Ueno ;; Created: 1999/11/20 ;; Keywords: TLS, SSL, OpenSSL @@ -25,11 +25,7 @@ ;;; Commentary: -;; This module defines some utility functions for TLSv1 functions. - -;; [RFC 2246] "The TLS Protocol Version 1.0" -;; by Christopher Allen and -;; Tim Dierks (1999/01) +;; This module defines some utility functions for STARTTLS profiles. ;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP" ;; by Chris Newman (1999/06) @@ -65,9 +61,8 @@ BUFFER is the buffer (or `buffer-name') to associate with the process. Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to." - (let* ((process-connection-type nil) - (process (apply #'start-process + (process (apply #'start-process name buffer starttls-program host (format "%s" service) starttls-extra-args)))