From: yamaoka Date: Wed, 26 May 2004 22:01:09 +0000 (+0000) Subject: Synch to No Gnus 200405261743. X-Git-Tag: t-gnus-6_17_4-quimby-~893 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=df80b810ea523c5fa351cd9d4652d4bc917d3b67;p=elisp%2Fgnus.git- Synch to No Gnus 200405261743. --- diff --git a/contrib/ChangeLog b/contrib/ChangeLog index 75c263d..47a26e1 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,7 @@ +2004-05-26 Simon Josefsson + + * starttls.el: Sync with proposed Emacs version. + 2004-05-13 TSUCHIYA Masatoshi * gnus-namazu.el (gnus-namazu/setup): Do not update indices diff --git a/contrib/starttls.el b/contrib/starttls.el index e34a671..1b798a3 100644 --- a/contrib/starttls.el +++ b/contrib/starttls.el @@ -1,9 +1,11 @@ -;;; starttls.el --- STARTTLS support via wrapper around GNU TLS +;;; starttls.el --- STARTTLS functions -;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. +;; Author: Daiki Ueno ;; Author: Simon Josefsson -;; Keywords: comm, tls, gnutls, ssl +;; Created: 1999/11/20 +;; Keywords: TLS, SSL, OpenSSL, GNUTLS, mail, news ;; This file is part of GNU Emacs. @@ -24,53 +26,84 @@ ;;; Commentary: -;; This package implements a simple wrapper around the GNU TLS command -;; line application "gnutls-cli" to make Emacs support STARTTLS. It -;; is backwards compatible (same API functions) with the "starttls.el" -;; that is part of Emacs 21 written by Daiki Ueno . -;; (That version used an external program "starttls" that isn't widely -;; installed, and was based on OpenSSL.) +;; This module defines some utility functions for STARTTLS profiles. -;; This package require GNUTLS 0.9.90 (released 2003-10-08) or later. +;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP" +;; by Chris Newman (1999/06) -;; Usage is similar to `open-network-stream'. Evaluating the following: +;; This file now contain a combination of the two previous +;; implementations both called "starttls.el". The first one is Daiki +;; Ueno's starttls.el which uses his own "starttls" command line tool, +;; and the second one is Simon Josefsson's starttls.el which uses +;; "gnutls-cli" from GNUTLS. ;; -;; (progn -;; (setq tmp (open-starttls-stream "test" (current-buffer) "mail.example.com" 143)) -;; (process-send-string tmp ". starttls\n") -;; (sit-for 4) -;; (message "STARTTLS output:\n%s" (negotiate-starttls tmp)) -;; (process-send-string tmp ". capability\n")) +;; If "gnutls-cli" is available, it is prefered by the code over +;; "starttls". Use `starttls-use-gnutls' to toggle between +;; implementations if you have both tools installed. + +;; The GNUTLS support require GNUTLS 0.9.90 (released 2003-10-08) or +;; later, from , or "starttls" +;; from . + +;; Usage is similar to `open-network-stream'. For example: ;; -;; in, e.g., the *scratch* buffer, yields the following output: +;; (when (setq tmp (starttls-open-stream +;; "test" (current-buffer) "yxa.extundo.com" 25)) +;; (accept-process-output tmp 15) +;; (process-send-string tmp "STARTTLS\n") +;; (accept-process-output tmp 15) +;; (message "STARTTLS output:\n%s" (starttls-negotiate tmp)) +;; (process-send-string tmp "EHLO foo\n")) + +;; An example run yield the following output: ;; -;; * OK imap.example.com Cyrus IMAP4 v2.1.15 server ready -;; . OK Begin TLS negotiation now -;; * CAPABILITY IMAP4 IMAP4rev1 ACL QUOTA ... -;; . OK Completed +;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65] +;; 220 2.0.0 Ready to start TLS +;; 250-yxa.extundo.com Hello c494102a.s-bi.bostream.se [217.215.27.65], pleased to meet you +;; 250-ENHANCEDSTATUSCODES +;; 250-PIPELINING +;; 250-EXPN +;; 250-VERB +;; 250-8BITMIME +;; 250-SIZE +;; 250-DSN +;; 250-ETRN +;; 250-AUTH DIGEST-MD5 CRAM-MD5 PLAIN LOGIN +;; 250-DELIVERBY +;; 250 HELP ;; nil ;; -;; And the message buffer contains: +;; With the message buffer containing: ;; ;; STARTTLS output: ;; *** Starting TLS handshake ;; - Server's trusted authorities: -;; [0]: O=Sendmail,OU=Sendmail Server,CN=imap.example.com,EMAIL=admin@imap.example.com +;; [0]: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com ;; - Certificate type: X.509 -;; - Got a certificate list of 1 certificates. +;; - Got a certificate list of 2 certificates. ;; ;; - Certificate[0] info: -;; # The hostname in the certificate matches 'imap.example.com'. -;; # valid since: Wed Aug 28 12:47:00 CEST 2002 -;; # expires at: Thu Aug 28 12:47:00 CEST 2003 +;; # The hostname in the certificate matches 'yxa.extundo.com'. +;; # valid since: Wed May 26 12:16:00 CEST 2004 +;; # expires at: Wed Jul 26 12:16:00 CEST 2023 +;; # serial number: 04 +;; # fingerprint: 7c 04 4b c1 fa 26 9b 5d 90 22 52 3c 65 3d 85 3a +;; # version: #1 +;; # public key algorithm: RSA +;; # Modulus: 1024 bits +;; # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=Mail server,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com +;; # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com +;; +;; - Certificate[1] info: +;; # valid since: Sun May 23 11:35:00 CEST 2004 +;; # expires at: Sun Jul 23 11:35:00 CEST 2023 ;; # serial number: 00 -;; # fingerprint: 06 3f 25 cb 44 aa 5c 1e 79 d7 63 86 f8 b1 9a cf +;; # fingerprint: fc 76 d8 63 1a c9 0b 3b fa 40 fe ed 47 7a 58 ae ;; # version: #3 ;; # public key algorithm: RSA ;; # Modulus: 1024 bits -;; # Subject's DN: O=Sendmail,OU=Sendmail Server,CN=imap.example.com,EMAIL=admin@imap.example.com -;; # Issuer's DN: O=Sendmail,OU=Sendmail Server,CN=imap.example.com,EMAIL=admin@imap.example.com -;; +;; # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com +;; # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com ;; ;; - Peer's certificate issuer is unknown ;; - Peer's certificate is NOT trusted @@ -80,32 +113,47 @@ ;; - MAC: SHA ;; - Compression: NULL -;; Revision history: -;; -;; 2003-09-20: Added to Gnus CVS. -;; 2003-10-02: Minor fixes. -;; 2003-11-15: Cleanup, and posted to gnu.emacs.sources. -;; 2003-11-28: Fixes variable name conflicts, various other fixes, posted g.e.s. - ;;; Code: (defgroup starttls nil - "Negotiated Transport Layer Security (STARTTLS) parameters." - :group 'comm) - -(defcustom starttls-file-name "gnutls-cli" - "Name of the program to run in a subprocess to open an STARTTLS connection. -The program should read input on stdin, write output to stdout, -and initiate TLS negotiation when receiving the SIGALRM signal. -Also see `starttls-connect', `starttls-failure', and -`starttls-success' for what the program should output after -initial connection and successful negotiation respectively." + "Support for `Transport Layer Security' protocol." + :version "21.1" + :group 'mail) + +(defcustom starttls-gnutls-program "gnutls-cli" + "Name of GNUTLS command line tool. +This program is used when GNUTLS is used, i.e. when +`starttls-use-gnutls' is non-nil." :type 'string :group 'starttls) +(defcustom starttls-program "starttls" + "The program to run in a subprocess to open an TLSv1 connection. +This program is used when the `starttls' command is used, +i.e. when `starttls-use-gnutls' is nil." + :type 'string + :group 'starttls) + +(defcustom starttls-use-gnutls (not (executable-find starttls-program)) + "*Whether to use GNUTLS instead of the `starttls' command." + :type 'boolean + :group 'starttls) + +(defcustom starttls-extra-args nil + "Extra arguments to `starttls-program'. +This program is used when the `starttls' command is used, +i.e. when `starttls-use-gnutls' is nil." + :type '(repeat string) + :group 'starttls) + (defcustom starttls-extra-arguments nil - "List of extra arguments to `starttls-file-name'. -E.g., (\"--protocols\" \"ssl3\")." + "Extra arguments to `starttls-program'. +This program is used when GNUTLS is used, i.e. when +`starttls-use-gnutls' is non-nil. + +For example, non-TLS compliant servers may require +'(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to +find out which parameters are available." :type '(repeat string) :group 'starttls) @@ -141,7 +189,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." :type 'regexp :group 'starttls) -(defun negotiate-starttls (process) +(defun starttls-negotiate-gnutls (process) "Negotiate TLS on process opened by `open-starttls-stream'. This should typically only be done once. It typically return a multi-line informational message with information about the @@ -173,24 +221,18 @@ handshake, or NIL on failure." (message "STARTTLS negotiation failed: %s" info) nil)))))) -(defun open-starttls-stream (name buffer host service) - "Open a TLS 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. -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." +(defun starttls-negotiate (process) + (if starttls-use-gnutls + (starttls-negotiate-gnutls process) + (signal-process (process-id process) 'SIGALRM))) + +(defun starttls-open-stream-gnutls (name buffer host service) (message "Opening STARTTLS connection to `%s'..." host) (let* (done (old-max (with-current-buffer buffer (point-max))) (process-connection-type starttls-process-connection-type) (process (apply #'start-process name buffer - starttls-file-name "-s" host + starttls-gnutls-program "-s" host "-p" (if (integerp service) (int-to-string service) service) @@ -214,13 +256,29 @@ specifying a port number to connect to." host (if done "done" "failed")) process)) -;; Compatibility with starttls.el by Daiki Ueno : -(defvaralias 'starttls-program 'starttls-file-name) -(make-obsolete-variable 'starttls-program 'starttls-file-name) -(defvaralias 'starttls-extra-args 'starttls-extra-arguments) -(make-obsolete-variable 'starttls-extra-args 'starttls-extra-arguments) -(defalias 'starttls-open-stream 'open-starttls-stream) -(defalias 'starttls-negotiate 'negotiate-starttls) +(defun starttls-open-stream (name buffer host service) + "Open a TLS 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 starttls-use-gnutls + (starttls-open-stream-gnutls name buffer host service) + (let* ((process-connection-type starttls-process-connection-type) + (process (apply #'start-process + name buffer starttls-program + host (format "%s" service) + starttls-extra-args))) + (process-kill-without-query process) + process))) (provide 'starttls) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1d64b71..d9e0704 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2004-05-26 Teodor Zlatanov + + * spam.el (spam-mark-junk-as-spam-routine) + (spam-mark-new-messages-in-spam-group-as-spam): allow user to + disable assigning the spam-mark to new messages + (spam-ham-copy-or-move-routine): todo decleared twice (tiny + change). From Adam Sj,Ax(Bgren . + 2004-05-26 Katsumi Yamaoka * dgnushack.el: Autoload customize-set-variable for XEmacs. diff --git a/lisp/spam.el b/lisp/spam.el index 06833ee..a158364 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -87,6 +87,11 @@ spam groups." :type 'boolean :group 'spam) +(defcustom spam-mark-new-messages-in-spam-group-as-spam t + "Whether new messages in a spam group should get the spam-mark." + :type 'boolean + :group 'spam) + (defcustom spam-process-ham-in-nonham-groups nil "Whether ham should be processed in non-ham groups." :type 'boolean @@ -970,8 +975,10 @@ When either list is nil, the other is returned." (let ((articles (if spam-mark-only-unseen-as-spam gnus-newsgroup-unseen gnus-newsgroup-unreads))) - (dolist (article articles) - (gnus-summary-mark-article article gnus-spam-mark))))) + (if spam-mark-new-messages-in-spam-group-as-spam + (dolist (article articles) + (gnus-summary-mark-article article gnus-spam-mark)) + (gnus-message 9 "Did not mark new messages as spam."))))) (defun spam-mark-spam-as-expired-and-move-routine (&rest groups) (if (and (car-safe groups) (listp (car-safe groups))) @@ -1020,7 +1027,7 @@ When either list is nil, the other is returned." (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)) (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) - article mark todo deletep respool) + article mark deletep respool) (when (member 'respool groups) (setq respool t) ; boolean for later