From 372a2066b50e43957fc5904254da04cf9d680535 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 16 Mar 2001 00:18:43 +0000 Subject: [PATCH] Synch with Oort Gnus. --- contrib/ssl.el | 201 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ChangeLog | 54 ++++++++++++++ lisp/gnus-mailcap.el | 8 +- lisp/gnus-score.el | 4 +- lisp/gnus-sum.el | 2 +- lisp/gnus.el | 2 +- lisp/message.el | 21 ++++-- lisp/mm-util.el | 2 +- lisp/rfc2047.el | 17 +++-- texi/ChangeLog | 10 +++ texi/gnus-ja.texi | 2 +- texi/gnus.texi | 2 +- texi/message-ja.texi | 3 + texi/message.texi | 3 + 14 files changed, 312 insertions(+), 19 deletions(-) create mode 100644 contrib/ssl.el diff --git a/contrib/ssl.el b/contrib/ssl.el new file mode 100644 index 0000000..bdf0736 --- /dev/null +++ b/contrib/ssl.el @@ -0,0 +1,201 @@ +;;; ssl.el,v --- ssl functions for emacsen without them builtin +;; Author: $Author: yamaoka $ +;; Created: $Date: 2001-03-16 00:14:21 $ +;; Version: $Revision: 1.1.2.1 $ +;; Keywords: comm + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1995, 1996 by William M. Perry +;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc. +;;; +;;; This file is part of GNU Emacs. +;;; +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'cl) +(require 'base64) + +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(defgroup ssl nil + "Support for `Secure Sockets Layer' encryption." + :group 'comm) + +(defcustom ssl-certificate-directory "~/.w3/certs/" + "*Directory to store CA certificates in" + :group 'ssl + :type 'directory) + +(defcustom ssl-rehash-program-name "c_rehash" + "*Program to run after adding a cert to a directory . +Run with one argument, the directory name." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-name "x509" + "*The program to run to provide a human-readable view of a certificate." + :group 'ssl + :type 'string) + +(defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER") + "*Arguments that should be passed to the certificate viewing program. +The certificate is piped to it. +Maybe a way of passing a file should be implemented" + :group 'ssl + :type 'list) + +(defcustom ssl-certificate-directory-style 'ssleay + "*Style of cert database to use, the only valid value right now is `ssleay'. +This means a directory of pem encoded certificates with hash symlinks." + :group 'ssl + :type '(choice (const :tag "SSLeay" :value ssleay) + (const :tag "OpenSSL" :value openssl))) + +(defcustom ssl-certificate-verification-policy 0 + "*How far up the certificate chain we should verify." + :group 'ssl + :type '(choice (const :tag "No verification" :value 0) + (const :tag "Verification required" :value 1) + (const :tag "Reject connection if verification fails" :value 3) + (const :tag "SSL_VERIFY_CLIENT_ONCE" :value 5))) + +(defcustom ssl-program-name "openssl" + "*The program to run in a subprocess to open an SSL connection." + :group 'ssl + :type 'string) + +(defcustom ssl-program-arguments + '("s_client" + "-quiet" + "-host" host + "-port" service + "-verify" (int-to-string ssl-certificate-verification-policy) + "-CApath" ssl-certificate-directory + ) + "*Arguments that should be passed to the program `ssl-program-name'. +This should be used if your SSL program needs command line switches to +specify any behaviour (certificate file locations, etc). +The special symbols 'host and 'port may be used in the list of arguments +and will be replaced with the hostname and service/port that will be connected +to." + :group 'ssl + :type 'list) + +(defun ssl-certificate-information (der) + "Return an assoc list of information about a certificate in DER format." + (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" + (base64-encode-string der) + "\n-----END CERTIFICATE-----\n")) + (exit-code 0)) + (save-excursion + (set-buffer (get-buffer-create " *openssl*")) + (erase-buffer) + (insert certificate) + (setq exit-code (condition-case () + (call-process-region (point-min) (point-max) + ssl-program-name + t (list (current-buffer) nil) t + "x509" + "-subject" ; Print the subject DN + "-issuer" ; Print the issuer DN + "-dates" ; Both before and after dates + "-serial" ; print out serial number + "-noout" ; Don't spit out the certificate + ) + (error -1))) + (if (/= exit-code 0) + nil + (let ((vals nil)) + (goto-char (point-min)) + (while (re-search-forward "^\\([^=\n\r]+\\)\\s *=\\s *\\(.*\\)" nil t) + (push (cons (match-string 1) (match-string 2)) vals)) + vals))))) + +(defun ssl-accept-ca-certificate () + "Ask if the user is willing to accept a new CA certificate. The buffer-name +should be the intended name of the certificate, and the buffer should probably +be in DER encoding" + ;; TODO, check if it is really new or if we already know it + (let* ((process-connection-type nil) + (tmpbuf (generate-new-buffer "X509 CA Certificate Information")) + (response (save-excursion + (and (eq 0 + (apply 'call-process-region + (point-min) (point-max) + ssl-view-certificate-program-name + nil tmpbuf t + ssl-view-certificate-program-arguments)) + (switch-to-buffer tmpbuf) + (goto-char (point-min)) + (or (recenter) t) + (yes-or-no-p + "Accept this CA to vouch for secure server identities? ") + (kill-buffer tmpbuf))))) + (if (not response) + nil + (if (not (file-directory-p ssl-certificate-directory)) + (make-directory ssl-certificate-directory)) + (case ssl-certificate-directory-style + (ssleay + (base64-encode-region (point-min) (point-max)) + (goto-char (point-min)) + (insert "-----BEGIN CERTIFICATE-----\n") + (goto-char (point-max)) + (insert "-----END CERTIFICATE-----\n") + (let ((f (expand-file-name + (concat (file-name-sans-extension (buffer-name)) ".pem") + ssl-certificate-directory))) + (write-file f) + (call-process ssl-rehash-program-name + nil nil nil + (expand-file-name ssl-certificate-directory)))))))) + +(defun open-ssl-stream (name buffer host service) + "Open a SSL connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +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." + (if (integerp service) (setq service (int-to-string service))) + (let* ((process-connection-type nil) + (port service) + (proc (eval + (` + (start-process name buffer ssl-program-name + (,@ ssl-program-arguments)))))) + (process-kill-without-query proc) + proc)) + +(provide 'ssl) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2a12fe4..4cfc000 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,57 @@ +2001-03-11 Kai Gro,A_(Bjohann + + * message.el (message-generate-headers-first): Update doc. + +2001-03-10 Matthias Wiehl + + * gnus.el (gnus-summary-line-format): Typo. + +2001-03-11 Simon Josefsson + + * mailcap.el (mailcap-mime-data): Add application/sieve. + (mailcap-mime-extensions): Add .siv, .xls. + +2001-03-14 20:00:00 ShengHuo ZHU + From Christoph Conrad + + * gnus-score.el (gnus-summary-lower-thread): Typo. + +2001-03-14 19:00:00 ShengHuo ZHU + + * message.el (message-forward-decoded-p): New variable. + (message-forward-subject-author-subject): Use it. + (message-make-forward-subject): Use it. + (message-forward): Use it. + + * gnus-uu.el (gnus-uu-digest-mail-forward): Use it. + + * mm-util.el, message.el, rfc2047.el, gnus-sum.el, gnus-score.el: + Sync with Emacs 21 (tag EMACS_PRETEST_21_0_100). + +;;Has been fixed -- zsh. +;;2001-03-05 Dave Love +;; +;; * mm-util.el (mm-mime-mule-charset-alist): Fix utf-8 case. +;; Move it after definition of mm-coding-system-p. +;; +2001-03-01 Dave Love + + * mm-util.el (mm-inhibit-file-name-handlers): Add + image-file-handler. + +2001-02-11 Dave Love + + * message.el (message-signature-file): Fix doc, :type. + +2001-02-08 Dave Love + + * rfc2047.el (rfc2047-fold-region): Don't forward-char at EOB. + (message-posting-charset): Defvar when compiling again. + (rfc2047-encodable-p): Require message. + + * gnus-sum.el (gnus-alter-articles-to-read-function): + * gnus-score.el (gnus-score-after-write-file-function): Fix :type. + 2001-03-08 20:00:00 ShengHuo ZHU * nnrss.el: New file. diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 818b617..bdd4547 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -147,7 +147,11 @@ (viewer . "ps2ascii %s") (type . "application/postscript") (test . (not (getenv "DISPLAY"))) - ("copiousoutput"))) + ("copiousoutput")) + ("sieve" + (viewer . sieve-mode) + (test . (fboundp 'sieve-mode)) + (type . "application/sieve"))) ("audio" ("x-mpeg" (viewer . "maplay %s") @@ -811,6 +815,7 @@ this type is returned." (".rtx" . "text/richtext") (".sh" . "application/x-sh") (".sit" . "application/x-stuffit") + (".siv" . "application/sieve") (".snd" . "audio/basic") (".src" . "application/x-wais-source") (".tar" . "archive/tar") @@ -828,6 +833,7 @@ this type is returned." (".vox" . "audio/basic") (".vrml" . "x-world/x-vrml") (".wav" . "audio/x-wav") + (".xls" . "application/vnd.ms-excel") (".wrl" . "x-world/x-vrml") (".xbm" . "image/xbm") (".xpm" . "image/xpm") diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 3dca790..3947cfd 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -385,7 +385,7 @@ If nil, the user will be asked for a duration." (defcustom gnus-score-after-write-file-function nil "Function called with the name of the score file just written to disk." :group 'gnus-score-files - :type 'function) + :type '(choice (const nil) function)) (defcustom gnus-score-thread-simplify nil "If non-nil, subjects will simplified as in threading." @@ -2495,7 +2495,7 @@ score in GNUS-NEWSGROUP-SCORED by SCORE." (defun gnus-summary-lower-thread (&optional score) "Lower score of articles in the current thread with SCORE." (interactive "P") - (gnus-summary-raise-thread (- (1- (gnus-score-delta-default score))))) + (gnus-summary-raise-thread (- (gnus-score-delta-default score)))) ;;; Finding score files. diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 9191e59..368eb49 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -976,7 +976,7 @@ For example: ((1 . cn-gb-2312) (2 . big5))." (defcustom gnus-alter-articles-to-read-function nil "Function to be called to alter the list of articles to be selected." - :type 'function + :type '(choice (const nil) function) :group 'gnus-summary) (defcustom gnus-orphan-score nil diff --git a/lisp/gnus.el b/lisp/gnus.el index 2970c51..22a5310 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -2178,7 +2178,7 @@ it is invalid to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. -The smart choice is to have these specs as for to the left as +The smart choice is to have these specs as far to the left as possible. This restriction may disappear in later versions of Gnus." diff --git a/lisp/message.el b/lisp/message.el index f8a6f2d..c85de29 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -602,7 +602,13 @@ variable isn't used." :type 'sexp) (defcustom message-generate-headers-first nil - "*If non-nil, generate all required headers before composing." + "*If non-nil, generate all required headers before composing. +The variables `message-required-news-headers' and +`message-required-mail-headers' specify which headers to generate. + +Note that the variable `message-deletable-headers' specifies headers which +are to be deleted and then re-generated before sending, so this variable +will not have a visible effect for those headers." :group 'message-headers :type 'boolean) @@ -729,8 +735,10 @@ If a form, the result from the form will be used instead." ;;;###autoload (defcustom message-signature-file "~/.signature" - "*File containing the text inserted at end of message buffer." - :type 'file + "*Name of file containing the text inserted at end of message buffer. +Ignored if the named file doesn't exist. +If nil, don't insert a signature." + :type '(choice file (const :tags "None" nil)) :group 'message-insertion) (defcustom message-distribution-function nil @@ -5249,6 +5257,9 @@ Previous forwarders, replyers, etc. may add it." ;;; Forwarding messages. +(defvar message-forward-decoded-p nil + "Non-nil means the original message is decoded.") + (defun message-forward-subject-author-subject (subject) "Generate a SUBJECT for a forwarded message. The form is: [Source] Subject, where if the original message was mail, @@ -5270,7 +5281,7 @@ The form is: Fwd: Subject, where Subject is the original subject of the message." (concat "Fwd: " subject)) -(defun message-make-forward-subject (&optional decoded) +(defun message-make-forward-subject () "Return a Subject header suitable for the message in the current buffer." (save-excursion (save-restriction @@ -5279,7 +5290,7 @@ the message." (subject (message-fetch-field "Subject"))) (setq subject (if subject - (if decoded + (if message-forward-decoded-p subject (nnheader-decode-subject subject)) "")) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 38a3ba8..e9cd0d2 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -478,7 +478,7 @@ Mule4 only." (nreverse out))) (defvar mm-inhibit-file-name-handlers - '(jka-compr-handler) + '(jka-compr-handler image-file-handler) "A list of handlers doing (un)compression (etc) thingies.") (defun mm-insert-file-contents (filename &optional visit beg end replace diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index a14ef2c..7d04a83 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -93,7 +93,7 @@ Valid encodings are nil, `Q' and `B'.") '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):" . "-A-Za-z0-9!*+/" ) ;; = (\075), _ (\137), ? (\077) are used in the encoded word. - ;; Avoid using 8bit characters. Some versions of Emacs has bug! + ;; Avoid using 8bit characters. ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" ("." . "\010\012\014\040-\074\076\100-\136\140-\177")) "Alist of header regexps and valid Q characters.") @@ -178,9 +178,14 @@ Should be called narrowed to the head of the message." (t))) (goto-char (point-max))))))) +;; Fixme: This, and the require below may not be the Right Thing, but +;; should be safe just before release. -- fx 2001-02-08 +(eval-when-compile (defvar message-posting-charset)) + (defun rfc2047-encodable-p () "Return non-nil if any characters in current buffer need encoding in headers. The buffer may be narrowed." + (require 'message) ; for message-posting-charset (let ((charsets (mapcar 'mm-mime-charset @@ -248,7 +253,7 @@ The buffer may be narrowed." result)) (defun rfc2047-encode-region (b e &optional word-chars) - "Encode all encodable words in region." + "Encode all encodable words in region B to E." (let ((words (rfc2047-dissect-region b e word-chars)) word) (save-restriction (narrow-to-region b e) @@ -312,7 +317,7 @@ The buffer may be narrowed." (forward-line 1))))) (defun rfc2047-fold-region (b e) - "Fold long lines in the region." + "Fold long lines in region B to E." (save-restriction (narrow-to-region b e) (goto-char (point-min)) @@ -332,7 +337,7 @@ The buffer may be narrowed." (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. (skip-chars-forward " \t") - (forward-char 1)) + (unless (eobp) (forward-char 1))) (cond ((eq (char-after) ?\n) (forward-char 1) @@ -366,10 +371,10 @@ The buffer may be narrowed." (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. (skip-chars-forward " \t") - (forward-char 1))))) + (unless (eobp) (forward-char 1)))))) (defun rfc2047-unfold-region (b e) - "Unfold lines in the region." + "Unfold lines in region B to E." (save-restriction (narrow-to-region b e) (goto-char (point-min)) diff --git a/texi/ChangeLog b/texi/ChangeLog index 876127f..6f6173a 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,13 @@ +2001-03-15 Kai Gro,A_(Bjohann + + * gnus.texi (Hiding Headers): Typos. Reported by Sriram Karra + . + +2001-03-11 Kai Gro,A_(Bjohann + + * message.texi (Message Headers): Update doc for + `message-generate-headers-first'. + 2001-03-14 15:00:00 ShengHuo ZHU From Nevin Kapur diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 4c7904d..aec0138 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -8848,7 +8848,7 @@ Gnus $B$O%X%C%@!<$NJB$YBX$((B(sort)$B$b9T$$$^$9(B ($B$3$l$O%G%#%U%)%k%H$G9T @code{To} $BMs$,0l$D$h$j$bB?$1$l$P!"$=$l$i$rA4$F>C5n$7$^$9!#(B @end table -$B>e5-$N:G=i$N;M$D$NMWAG$rF~$l$?$1$l$P!"$3$s$JIw$K$J$j$^$9!#(B +$B$3$l$i$N;0$D$NMWAG$rF~$l$?$1$l$P!"$3$s$JIw$K$J$j$^$9!#(B @lisp (setq gnus-boring-article-headers diff --git a/texi/gnus.texi b/texi/gnus.texi index 113b647..a57de5b 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -9266,7 +9266,7 @@ Remove the @code{To} header if it is very long. Remove all @code{To} headers if there are more than one. @end table -To include the four three elements, you could say something like; +To include these three elements, you could say something like; @lisp (setq gnus-boring-article-headers diff --git a/texi/message-ja.texi b/texi/message-ja.texi index e54e134..1fcee67 100644 --- a/texi/message-ja.texi +++ b/texi/message-ja.texi @@ -923,6 +923,9 @@ Message $B$O%a%C%;!<%8:n@.ItJ,$K4X$7$F$OHs>o$K@Q6KE*$G$9!#$=$l$OC$5$l$?$j:n$jD>$5$l$?$j$7$^$9!#$3$l$K(B +$B$OJQ?t(B @code{message-deletable-headers} ($B8e=R(B) $B$,4X78$7$^$9!#(B + @item message-from-style @vindex message-from-style @code{From} $B%X%C%@!<$,$I$N$h$&$K8+$($k$+$r;XDj$7$^$9!#(B4$B$D$N9gK!E*CM$,$"(B diff --git a/texi/message.texi b/texi/message.texi index 7ab4b14..ecfc841 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -945,6 +945,9 @@ compose the message. The variables @code{message-required-mail-headers} and @code{message-required-news-headers} specify which headers are required. +Note that some headers will be removed and re-generated before posting, +because of the variable @code{message-deletable-headers} (see below). + @item message-from-style @vindex message-from-style Specifies how @code{From} headers should look. There are four valid -- 1.7.10.4