rpms/emacs/devel etags-update-to-cvs.patch, NONE, 1.1 smtpmail-cvs-update.patch, NONE, 1.1 emacs.spec, 1.57, 1.58 lang-coding-systems-init.el, 1.4, 1.5 etags-14.21-17.11-diff.patch, 1.1, NONE
fedora-cvs-commits at redhat.com
fedora-cvs-commits at redhat.com
Tue Nov 22 04:12:25 UTC 2005
Author: petersen
Update of /cvs/dist/rpms/emacs/devel
In directory cvs.devel.redhat.com:/tmp/cvs-serv13763
Modified Files:
emacs.spec lang-coding-systems-init.el
Added Files:
etags-update-to-cvs.patch smtpmail-cvs-update.patch
Removed Files:
etags-14.21-17.11-diff.patch
Log Message:
- fix keyboard-coding-system on console for utf-8 (Dawid Gajownik, #173855)
- update etags to latest cvs (Hideki Iwamoto, #173023)
- replace etags-14.21-17.11-diff.patch with etags-update-to-cvs.patch
- update smtpmail.el to latest cvs version for better authentication support
with smtpmail-cvs-update.patch (Alberto Brizio, #167804)
etags-update-to-cvs.patch:
etags.c | 58 +++++++++++++++++++++++++++++++++-------------------------
1 files changed, 33 insertions(+), 25 deletions(-)
--- NEW FILE etags-update-to-cvs.patch ---
--- emacs-21.4/lib-src/etags.c 2005-11-22 11:41:29.000000000 +0900
+++ emacs-cvs/lib-src/etags.c 2005-11-22 11:41:29.000000000 +0900
@@ -1,6 +1,7 @@
/* Tags file maker to go with GNU Emacs -*- coding: latin-1 -*-
- Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2004
- Free Software Foundation, Inc. and Ken Arnold
+ Copyright (C) 1984, 1987, 1988, 1989, 1993, 1994, 1995,
+ 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ 2005 Free Software Foundation, Inc. and Ken Arnold
This file is not considered part of GNU Emacs.
@@ -16,7 +17,7 @@
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
/*
* Authors:
@@ -40,7 +41,7 @@
* configuration file containing regexp definitions for etags.
*/
-char pot_etags_version[] = "@(#) pot revision number is 17.11";
+char pot_etags_version[] = "@(#) pot revision number is 17.15";
#define TRUE 1
#define FALSE 0
@@ -476,6 +477,11 @@
static bool ignoreindent; /* -I: ignore indentation in C */
static bool packages_only; /* --packages-only: in Ada, only tag packages*/
+/* STDIN is defined in LynxOS system headers */
+#ifdef STDIN
+# undef STDIN
+#endif
+
#define STDIN 0x1001 /* returned by getopt_long on --parse-stdin */
static bool parsing_stdin; /* --parse-stdin used */
@@ -489,6 +495,7 @@
#if LONG_OPTIONS
static struct option longopts[] =
{
+ { "append", no_argument, NULL, 'a' },
{ "packages-only", no_argument, &packages_only, TRUE },
{ "c++", no_argument, NULL, 'C' },
{ "declarations", no_argument, &declarations, TRUE },
@@ -508,7 +515,7 @@
{ "parse-stdin", required_argument, NULL, STDIN },
{ "version", no_argument, NULL, 'V' },
-#if CTAGS /* Etags options */
+#if CTAGS /* Ctags options */
{ "backward-search", no_argument, NULL, 'B' },
{ "cxref", no_argument, NULL, 'x' },
{ "defines", no_argument, NULL, 'd' },
@@ -519,8 +526,7 @@
{ "vgrind", no_argument, NULL, 'v' },
{ "no-warn", no_argument, NULL, 'w' },
-#else /* Ctags options */
- { "append", no_argument, NULL, 'a' },
+#else /* Etags options */
{ "no-defines", no_argument, NULL, 'D' },
{ "no-globals", no_argument, &globals, FALSE },
{ "include", required_argument, NULL, 'i' },
@@ -888,8 +894,7 @@
Absolute names are stored in the output file as they are.\n\
Relative ones are stored relative to the output file's directory.\n");
- if (!CTAGS)
- puts ("-a, --append\n\
+ puts ("-a, --append\n\
Append tag entries to existing tags file.");
puts ("--packages-only\n\
@@ -989,9 +994,9 @@
if (CTAGS)
{
puts ("-v, --vgrind\n\
- Generates an index of items intended for human consumption,\n\
- similar to the output of vgrind. The index is sorted, and\n\
- gives the page number of each item.");
+ Print on the standard output an index of items intended for\n\
+ human consumption, similar to the output of vgrind. The index\n\
+ is sorted, and gives the page number of each item.");
puts ("-w, --no-warn\n\
Suppress warning messages about entries defined in multiple\n\
files.");
@@ -1196,10 +1201,10 @@
if (!LONG_OPTIONS)
optstring += 1; /* remove the initial '-' */
optstring = concat (optstring,
- "Cf:Il:o:SVhH",
- (CTAGS) ? "BxdtTuvw" : "aDi:");
+ "aCf:Il:o:SVhH",
+ (CTAGS) ? "BxdtTuvw" : "Di:");
- while ((opt = getopt_long (argc, argv, optstring, longopts, 0)) != EOF)
+ while ((opt = getopt_long (argc, argv, optstring, longopts, NULL)) != EOF)
switch (opt)
{
case 0:
@@ -1227,6 +1232,7 @@
break;
/* Common options. */
+ case 'a': append_to_tagfile = TRUE; break;
case 'C': cplusplus = TRUE; break;
case 'f': /* for compatibility with old makefiles */
case 'o':
@@ -1276,7 +1282,6 @@
break;
/* Etags options */
- case 'a': append_to_tagfile = TRUE; break;
case 'D': constantypedefs = FALSE; break;
case 'i': included_files[nincluded_files++] = optarg; break;
@@ -1423,7 +1428,8 @@
if (!CTAGS || cxref_style)
{
- put_entries (nodehead); /* write the remainig tags (ETAGS) */
+ /* Write the remaining tags to tagf (ETAGS) or stdout (CXREF). */
+ put_entries (nodehead);
free_tree (nodehead);
nodehead = NULL;
if (!CTAGS)
@@ -1437,10 +1443,11 @@
while (nincluded_files-- > 0)
fprintf (tagf, "\f\n%s,include\n", *included_files++);
+
+ if (fclose (tagf) == EOF)
+ pfatal (tagfile);
}
- if (fclose (tagf) == EOF)
- pfatal (tagfile);
exit (EXIT_SUCCESS);
}
@@ -1475,12 +1482,13 @@
if (fclose (tagf) == EOF)
pfatal (tagfile);
- if (update)
- {
- char cmd[2*BUFSIZ+10];
- sprintf (cmd, "sort -o %.*s %.*s", BUFSIZ, tagfile, BUFSIZ, tagfile);
- exit (system (cmd));
- }
+ if (CTAGS)
+ if (append_to_tagfile || update)
+ {
+ char cmd[2*BUFSIZ+10];
+ sprintf (cmd, "sort -o %.*s %.*s", BUFSIZ, tagfile, BUFSIZ, tagfile);
+ exit (system (cmd));
+ }
return EXIT_SUCCESS;
}
smtpmail-cvs-update.patch:
smtpmail.el | 560 +++++++++++++++++++++++++++++++++++++++++++-----------------
1 files changed, 403 insertions(+), 157 deletions(-)
--- NEW FILE smtpmail-cvs-update.patch ---
diff -u emacs-21.4/lisp/mail/smtpmail.el emacs-cvs/lisp/mail/smtpmail.el
--- emacs-21.4/lisp/mail/smtpmail.el 2005-11-22 12:16:47.000000000 +0900
+++ emacs-cvs/lisp/mail/smtpmail.el 2005-11-22 12:16:47.000000000 +0900
@@ -1,12 +1,15 @@
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
-;; Copyright (C) 1995, 1996, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005
+;; Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani at rbc.ncl.omron.co.jp>
-;; Maintainer: Brian D. Carlstrom <bdc at ai.mit.edu>
+;; Maintainer: Simon Josefsson <simon at josefsson.org>
+;; w32 Maintainer: Brian D. Carlstrom <bdc at ai.mit.edu>
;; ESMTP support: Simon Leinen <simon at switch.ch>
;; Hacked by Mike Taylor, 11th October 1999 to add support for
;; automatically appending a domain to RCPT TO: addresses.
+;; AUTH=LOGIN support: Stephen Cranefield <scranefield at infoscience.otago.ac.nz>
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -23,8 +26,8 @@
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
@@ -33,20 +36,48 @@
;; Please add these lines in your .emacs(_emacs) or use customize.
;;
;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
-;;(setq message-send-mail-function 'smtpmail-send-it) ; if you are using Gnus.
+;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
;;(setq smtpmail-debug-info t) ; only to debug problems
+;;(setq smtpmail-auth-credentials ; or use ~/.authinfo
+;; '(("YOUR SMTP HOST" 25 "username" "password")))
+;;(setq smtpmail-starttls-credentials
+;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert")))
+;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an
+;; integer or a string, just as long as they match (eq).
;; To queue mail, set smtpmail-queue-mail to t and use
;; smtpmail-send-queued-mail to send.
+;; Modified by Stephen Cranefield <scranefield at infoscience.otago.ac.nz>,
+;; 22/6/99, to support SMTP Authentication by the AUTH=LOGIN mechanism.
+;; See http://help.netscape.com/products/server/messaging/3x/info/smtpauth.html
+;; Rewritten by Simon Josefsson to use same credential variable as AUTH
+;; support below.
+
+;; Modified by Simon Josefsson <jas at pdc.kth.se>, 22/2/99, to support SMTP
+;; Authentication by the AUTH mechanism.
+;; See http://www.ietf.org/rfc/rfc2554.txt
+
+;; Modified by Simon Josefsson <simon at josefsson.org>, 2000-10-07, to support
+;; STARTTLS. Requires external program
+;; ftp://ftp.opaopa.org/pub/elisp/starttls-*.tar.gz.
+;; See http://www.ietf.org/rfc/rfc2246.txt, http://www.ietf.org/rfc/rfc2487.txt
;;; Code:
(require 'sendmail)
-(require 'time-stamp)
+(autoload 'starttls-open-stream "starttls")
+(autoload 'starttls-negotiate "starttls")
+(autoload 'mail-strip-quoted-names "mail-utils")
+(autoload 'message-make-date "message")
+(autoload 'message-make-message-id "message")
+(autoload 'rfc2104-hash "rfc2104")
+(autoload 'netrc-parse "netrc")
+(autoload 'netrc-machine "netrc")
+(autoload 'netrc-get "netrc")
;;;
(defgroup smtpmail nil
@@ -55,7 +86,8 @@
(defcustom smtpmail-default-smtp-server nil
- "*Specify default SMTP server."
+ "*Specify default SMTP server.
+This only has effect if you specify it before loading the smtpmail library."
:type '(choice (const nil) string)
:group 'smtpmail)
@@ -66,8 +98,9 @@
:group 'smtpmail)
(defcustom smtpmail-smtp-service 25
- "*SMTP service port number. smtp or 25 ."
- :type 'integer
+ "*SMTP service port number.
+The default value would be \"smtp\" or 25 ."
+ :type '(choice (integer :tag "Port") (string :tag "Service"))
:group 'smtpmail)
(defcustom smtpmail-local-domain nil
@@ -94,7 +127,15 @@
:group 'smtpmail)
(defcustom smtpmail-debug-info nil
- "*smtpmail debug info printout. messages and process buffer."
+ "Whether to print info in buffer *trace of SMTP session to <somewhere>*.
+See also `smtpmail-debug-verb' which determines if the SMTP protocol should
+be verbose as well."
+ :type 'boolean
+ :group 'smtpmail)
+
+(defcustom smtpmail-debug-verb nil
+ "Whether this library sends the SMTP VERB command or not.
+The commands enables verbose information from the SMTP server."
:type 'boolean
:group 'smtpmail)
@@ -115,6 +156,34 @@
:type 'directory
:group 'smtpmail)
+(defcustom smtpmail-auth-credentials "~/.authinfo"
+ "Specify username and password for servers, directly or via .netrc file.
+This variable can either be a filename pointing to a file in netrc(5)
+format, or list of four-element lists that contain, in order,
+`servername' (a string), `port' (an integer), `user' (a string) and
+`password' (a string, or nil to query the user when needed). If you
+need to enter a `realm' too, add it to the user string, so that it
+looks like `user at realm'."
+ :type '(choice file
+ (repeat (list (string :tag "Server")
+ (integer :tag "Port")
+ (string :tag "Username")
+ (choice (const :tag "Query when needed" nil)
+ (string :tag "Password")))))
+ :version "22.1"
+ :group 'smtpmail)
+
+(defcustom smtpmail-starttls-credentials '(("" 25 "" ""))
+ "Specify STARTTLS keys and certificates for servers.
+This is a list of four-element list with `servername' (a string),
+`port' (an integer), `key' (a filename) and `certificate' (a filename)."
+ :type '(repeat (list (string :tag "Server")
+ (integer :tag "Port")
+ (file :tag "Key")
+ (file :tag "Certificate")))
+ :version "21.1"
+ :group 'smtpmail)
+
(defcustom smtpmail-warn-about-unknown-extensions nil
"*If set, print warnings about unknown SMTP extensions.
This is mainly useful for development purposes, to learn about
@@ -130,19 +199,26 @@
(defvar smtpmail-address-buffer)
(defvar smtpmail-recipient-address-list)
+(defvar smtpmail-queue-counter 0)
+
;; Buffer-local variable.
(defvar smtpmail-read-point)
(defvar smtpmail-queue-index (concat smtpmail-queue-dir
smtpmail-queue-index-file))
+(defconst smtpmail-auth-supported '(cram-md5 plain login)
+ "List of supported SMTP AUTH mechanisms.")
+
;;;
;;;
;;;
+(defvar smtpmail-mail-address nil
+ "Value to use for envelope-from address for mail from ambient buffer.")
+
;;;###autoload
(defun smtpmail-send-it ()
- (require 'mail-utils)
(let ((errbuf (if mail-interactive
(generate-new-buffer " smtpmail errors")
0))
@@ -150,6 +226,11 @@
(case-fold-search nil)
delimline
(mailbuf (current-buffer))
+ ;; Examine this variable now, so that
+ ;; local binding in the mail buffer will take effect.
+ (smtpmail-mail-address
+ (or (and mail-specify-envelope-from (mail-envelope-from))
+ user-mail-address))
(smtpmail-code-conv-from
(if enable-multibyte-characters
(let ((sendmail-coding-system smtpmail-code-conv-from))
@@ -190,7 +271,7 @@
;; they put one in themselves.
(goto-char (point-min))
(if (not (re-search-forward "^From:" delimline t))
- (let* ((login user-mail-address)
+ (let* ((login smtpmail-mail-address)
(fullname (user-full-name)))
(cond ((eq mail-from-style 'angles)
(insert "From: " fullname)
@@ -232,6 +313,14 @@
(insert ")\n"))
((null mail-from-style)
(insert "From: " login "\n")))))
+ ;; Insert a `Message-Id:' field if there isn't one yet.
+ (goto-char (point-min))
+ (unless (re-search-forward "^Message-Id:" delimline t)
+ (insert "Message-Id: " (message-make-message-id) "\n"))
+ ;; Insert a `Date:' field if there isn't one yet.
+ (goto-char (point-min))
+ (unless (re-search-forward "^Date:" delimline t)
+ (insert "Date: " (message-make-date) "\n"))
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
@@ -242,8 +331,7 @@
(if (re-search-forward "^FCC:" delimline t)
(mail-do-fcc delimline))
(if mail-interactive
- (save-excursion
- (set-buffer errbuf)
+ (with-current-buffer errbuf
(erase-buffer))))
;;
;;
@@ -261,19 +349,23 @@
smtpmail-recipient-address-list tembuf))
(error "Sending failed; SMTP protocol error"))
(error "Sending failed; no recipients"))
- (let* ((file-data (concat
- smtpmail-queue-dir
- (concat (time-stamp-yyyy-mm-dd)
- "_" (time-stamp-hh:mm:ss))))
- (file-data (convert-standard-filename file-data))
- (file-elisp (concat file-data ".el"))
+ (let* ((file-data
+ (expand-file-name
+ (format "%s_%i"
+ (format-time-string "%Y-%m-%d_%H:%M:%S")
+ (setq smtpmail-queue-counter
+ (1+ smtpmail-queue-counter)))
+ smtpmail-queue-dir))
+ (file-data (convert-standard-filename file-data))
+ (file-elisp (concat file-data ".el"))
(buffer-data (create-file-buffer file-data))
(buffer-elisp (create-file-buffer file-elisp))
(buffer-scratch "*queue-mail*"))
- (save-excursion
- (set-buffer buffer-data)
+ (unless (file-exists-p smtpmail-queue-dir)
+ (make-directory smtpmail-queue-dir t))
+ (with-current-buffer buffer-data
(erase-buffer)
- (insert-buffer tembuf)
+ (insert-buffer-contents tembuf)
(write-file file-data)
(set-buffer buffer-elisp)
(erase-buffer)
@@ -299,35 +391,33 @@
(defun smtpmail-send-queued-mail ()
"Send mail that was queued as a result of setting `smtpmail-queue-mail'."
(interactive)
- ;;; Get index, get first mail, send it, get second mail, etc...
- (let ((buffer-index (find-file-noselect smtpmail-queue-index))
- (file-msg "")
- (tembuf nil))
- (save-excursion
- (set-buffer buffer-index)
- (beginning-of-buffer)
+ (with-temp-buffer
+ ;;; Get index, get first mail, send it, update index, get second
+ ;;; mail, send it, etc...
+ (let ((file-msg ""))
+ (insert-file-contents smtpmail-queue-index)
+ (goto-char (point-min))
(while (not (eobp))
- (setq file-msg (buffer-substring (point) (save-excursion
- (end-of-line)
- (point))))
+ (setq file-msg (buffer-substring (point) (line-end-position)))
(load file-msg)
;; Insert the message literally: it is already encoded as per
;; the MIME headers, and code conversions might guess the
;; encoding wrongly.
- (setq tembuf (find-file-noselect file-msg nil t))
- (if (not (null smtpmail-recipient-address-list))
- (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
- tembuf))
- (error "Sending failed; SMTP protocol error"))
- (error "Sending failed; no recipients"))
+ (with-temp-buffer
+ (let ((coding-system-for-read 'no-conversion))
+ (insert-file-contents file-msg))
+ (let ((smtpmail-mail-address
+ (or (and mail-specify-envelope-from (mail-envelope-from))
+ user-mail-address)))
+ (if (not (null smtpmail-recipient-address-list))
+ (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
+ (current-buffer)))
+ (error "Sending failed; SMTP protocol error"))
+ (error "Sending failed; no recipients"))))
(delete-file file-msg)
(delete-file (concat file-msg ".el"))
- (kill-buffer tembuf)
- (kill-line 1))
- (set-buffer buffer-index)
- (save-buffer smtpmail-queue-index)
- (kill-buffer buffer-index)
- )))
+ (delete-region (point-at-bol) (point-at-bol 2)))
+ (write-region (point-min) (point-max) smtpmail-queue-index))))
;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
@@ -336,17 +426,173 @@
(concat (system-name) "." smtpmail-local-domain)
(system-name)))
+(defsubst smtpmail-cred-server (cred)
+ (nth 0 cred))
+
+(defsubst smtpmail-cred-port (cred)
+ (nth 1 cred))
+
+(defsubst smtpmail-cred-key (cred)
+ (nth 2 cred))
+
+(defsubst smtpmail-cred-user (cred)
+ (nth 2 cred))
+
+(defsubst smtpmail-cred-cert (cred)
+ (nth 3 cred))
+
+(defsubst smtpmail-cred-passwd (cred)
+ (nth 3 cred))
+
+(defun smtpmail-find-credentials (cred server port)
+ (catch 'done
+ (let ((l cred) el)
+ (while (setq el (pop l))
+ (when (and (equal server (smtpmail-cred-server el))
+ (equal port (smtpmail-cred-port el)))
+ (throw 'done el))))))
+
(defun smtpmail-maybe-append-domain (recipient)
(if (or (not smtpmail-sendto-domain)
(string-match "@" recipient))
recipient
(concat recipient "@" smtpmail-sendto-domain)))
+(defun smtpmail-intersection (list1 list2)
+ (let ((result nil))
+ (dolist (el2 list2)
+ (when (memq el2 list1)
+ (push el2 result)))
+ (nreverse result)))
+
+(defvar starttls-extra-args)
+(defvar starttls-extra-arguments)
+
+(defun smtpmail-open-stream (process-buffer host port)
+ (let ((cred (smtpmail-find-credentials
+ smtpmail-starttls-credentials host port)))
+ (if (null (and cred (condition-case ()
+ (with-no-warnings
+ (require 'starttls)
+ (call-process (if starttls-use-gnutls
+ starttls-gnutls-program
+ starttls-program)))
+ (error nil))))
+ ;; The normal case.
+ (open-network-stream "SMTP" process-buffer host port)
+ (let* ((cred-key (smtpmail-cred-key cred))
+ (cred-cert (smtpmail-cred-cert cred))
+ (starttls-extra-args
+ (append
+ starttls-extra-args
+ (when (and (stringp cred-key) (stringp cred-cert)
+ (file-regular-p
+ (setq cred-key (expand-file-name cred-key)))
+ (file-regular-p
+ (setq cred-cert (expand-file-name cred-cert))))
+ (list "--key-file" cred-key "--cert-file" cred-cert))))
+ (starttls-extra-arguments
+ (append
+ starttls-extra-arguments
+ (when (and (stringp cred-key) (stringp cred-cert)
+ (file-regular-p
+ (setq cred-key (expand-file-name cred-key)))
+ (file-regular-p
+ (setq cred-cert (expand-file-name cred-cert))))
+ (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
+ (starttls-open-stream "SMTP" process-buffer host port)))))
+
+(defun smtpmail-try-auth-methods (process supported-extensions host port)
+ (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
+ (mech (car (smtpmail-intersection smtpmail-auth-supported mechs)))
+ (cred (if (stringp smtpmail-auth-credentials)
+ (let* ((netrc (netrc-parse smtpmail-auth-credentials))
+ (port-name (format "%s" (or port "smtp")))
+ (hostentry (netrc-machine netrc host port-name
+ port-name)))
+ (when hostentry
+ (list host port
+ (netrc-get hostentry "login")
+ (netrc-get hostentry "password"))))
+ (smtpmail-find-credentials
+ smtpmail-auth-credentials host port)))
+ (passwd (when cred
+ (or (smtpmail-cred-passwd cred)
+ (read-passwd
+ (format "SMTP password for %s:%s: "
+ (smtpmail-cred-server cred)
+ (smtpmail-cred-port cred))))))
+ ret)
+ (when (and cred mech)
+ (cond
+ ((eq mech 'cram-md5)
+ (smtpmail-send-command process (upcase (format "AUTH %s" mech)))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil))
+ (when (eq (car ret) 334)
+ (let* ((challenge (substring (cadr ret) 4))
+ (decoded (base64-decode-string challenge))
+ (hash (rfc2104-hash 'md5 64 16 passwd decoded))
+ (response (concat (smtpmail-cred-user cred) " " hash))
+ (encoded (base64-encode-string response)))
+ (smtpmail-send-command process (format "%s" encoded))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil)))))
+ ((eq mech 'login)
+ (smtpmail-send-command process "AUTH LOGIN")
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil))
+ (smtpmail-send-command
+ process (base64-encode-string (smtpmail-cred-user cred)))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil))
+ (smtpmail-send-command process (base64-encode-string passwd))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (>= (car ret) 400))
+ (throw 'done nil)))
+ ((eq mech 'plain)
+ (smtpmail-send-command process "AUTH PLAIN")
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (not (equal (car ret) 334)))
+ (throw 'done nil))
+ (smtpmail-send-command process (base64-encode-string
+ (concat "\0"
+ (smtpmail-cred-user cred)
+ "\0"
+ (smtpmail-cred-passwd cred))))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (not (equal (car ret) 235)))
+ (throw 'done nil)))
+
+ (t
+ (error "Mechanism %s not implemented" mech)))
+ ;; Remember the password.
+ (when (and (not (stringp smtpmail-auth-credentials))
+ (null (smtpmail-cred-passwd cred)))
+ (setcar (cdr (cdr (cdr cred))) passwd)))))
+
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
(let ((process nil)
(host (or smtpmail-smtp-server
(error "`smtpmail-smtp-server' not defined")))
(port smtpmail-smtp-service)
+ ;; smtpmail-mail-address should be set to the appropriate
+ ;; buffer-local value by the caller, but in case not:
+ (envelope-from (or smtpmail-mail-address
+ (and mail-specify-envelope-from
+ (mail-envelope-from))
+ user-mail-address))
response-code
greeting
process-buffer
@@ -358,19 +604,17 @@
(get-buffer-create (format "*trace of SMTP session to %s*" host)))
;; clear the trace buffer of old output
- (save-excursion
- (set-buffer process-buffer)
+ (with-current-buffer process-buffer
(erase-buffer))
;; open the connection to the server
- (setq process (open-network-stream "SMTP" process-buffer host port))
+ (setq process (smtpmail-open-stream process-buffer host port))
(and (null process) (throw 'done nil))
;; set the send-filter
(set-process-filter process 'smtpmail-process-filter)
- (save-excursion
- (set-buffer process-buffer)
+ (with-current-buffer process-buffer
(set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
(make-local-variable 'smtpmail-read-point)
(setq smtpmail-read-point (point-min))
@@ -382,32 +626,58 @@
(throw 'done nil)
)
+ (let ((do-ehlo t)
+ (do-starttls t))
+ (while do-ehlo
;; EHLO
(smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn)))
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
+ (if (or (null (car (setq response-code
+ (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(progn
;; HELO
- (smtpmail-send-command process (format "HELO %s" (smtpmail-fqdn)))
+ (smtpmail-send-command
+ process (format "HELO %s" (smtpmail-fqdn)))
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
+ (if (or (null (car (setq response-code
+ (smtpmail-read-response process))))
(not (integerp (car response-code)))
(>= (car response-code) 400))
(throw 'done nil)))
- (let ((extension-lines (cdr (cdr response-code))))
- (while extension-lines
- (let ((name (intern (downcase (car (split-string (substring (car extension-lines) 4) "[ ]"))))))
+ (dolist (line (cdr (cdr response-code)))
+ (let ((name (mapcar (lambda (s) (intern (downcase s)))
+ (split-string (substring line 4) "[ ]"))))
+ (and (eq (length name) 1)
+ (setq name (car name)))
(and name
- (cond ((memq name '(verb xvrb 8bitmime onex xone
+ (cond ((memq (if (consp name) (car name) name)
+ '(verb xvrb 8bitmime onex xone
expn size dsn etrn
- help xusr))
+ enhancedstatuscodes
+ help xusr
+ auth=login auth starttls))
(setq supported-extensions
(cons name supported-extensions)))
(smtpmail-warn-about-unknown-extensions
- (message "Unknown extension %s" name)))))
- (setq extension-lines (cdr extension-lines)))))
+ (message "Unknown extension %s" name)))))))
+
+ (if (and do-starttls
+ (smtpmail-find-credentials smtpmail-starttls-credentials host port)
+ (member 'starttls supported-extensions)
+ (numberp (process-id process)))
+ (progn
+ (smtpmail-send-command process (format "STARTTLS"))
+ (if (or (null (car (setq response-code (smtpmail-read-response process))))
+ (not (integerp (car response-code)))
+ (>= (car response-code) 400))
+ (throw 'done nil))
+ (starttls-negotiate process)
+ (setq do-starttls nil))
+ (setq do-ehlo nil))))
+
+ (smtpmail-try-auth-methods process supported-extensions host port)
(if (or (member 'onex supported-extensions)
(member 'xone supported-extensions))
@@ -418,7 +688,7 @@
(>= (car response-code) 400))
(throw 'done nil))))
- (if (and smtpmail-debug-info
+ (if (and smtpmail-debug-verb
(or (member 'verb supported-extensions)
(member 'xvrb supported-extensions)))
(progn
@@ -436,22 +706,17 @@
(>= (car response-code) 400))
(throw 'done nil))))
- ;; MAIL FROM: <sender>
+ ;; MAIL FROM:<sender>
(let ((size-part
- (if (member 'size supported-extensions)
+ (if (or (member 'size supported-extensions)
+ (assoc 'size supported-extensions))
(format " SIZE=%d"
- (save-excursion
- (set-buffer smtpmail-text-buffer)
+ (with-current-buffer smtpmail-text-buffer
;; size estimate:
(+ (- (point-max) (point-min))
;; Add one byte for each change-of-line
- ;; because or CR-LF representation:
- (count-lines (point-min) (point-max))
- ;; For some reason, an empty line is
- ;; added to the message. Maybe this
- ;; is a bug, but it can't hurt to add
- ;; those two bytes anyway:
- 2)))
+ ;; because of CR-LF representation:
+ (count-lines (point-min) (point-max)))))
""))
(body-part
(if (member '8bitmime supported-extensions)
@@ -471,8 +736,8 @@
"")
"")))
; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
- (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s"
- user-mail-address
+ (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
+ envelope-from
size-part
body-part))
@@ -482,10 +747,10 @@
(throw 'done nil)
))
- ;; RCPT TO: <recipient>
+ ;; RCPT TO:<recipient>
(let ((n 0))
(while (not (null (nth n recipient)))
- (smtpmail-send-command process (format "RCPT TO: <%s>" (smtpmail-maybe-append-domain (nth n recipient))))
+ (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
(setq n (1+ n))
(setq response-code (smtpmail-read-response process))
@@ -523,8 +788,7 @@
; (throw 'done nil))
t ))
(if process
- (save-excursion
- (set-buffer (process-buffer process))
+ (with-current-buffer (process-buffer process)
(smtpmail-send-command process "QUIT")
(smtpmail-read-response process)
@@ -533,12 +797,13 @@
; (>= (car response-code) 400))
; (throw 'done nil)
; )
- (delete-process process))))))
+ (delete-process process)
+ (unless smtpmail-debug-info
+ (kill-buffer process-buffer)))))))
(defun smtpmail-process-filter (process output)
- (save-excursion
- (set-buffer (process-buffer process))
+ (with-current-buffer (process-buffer process)
(goto-char (point-max))
(insert output)))
@@ -548,49 +813,49 @@
(response-continue t)
(return-value '(nil ()))
match-end)
-
- (while response-continue
- (goto-char smtpmail-read-point)
- (while (not (search-forward "\r\n" nil t))
- (accept-process-output process)
- (goto-char smtpmail-read-point))
-
- (setq match-end (point))
- (setq response-strings
- (cons (buffer-substring smtpmail-read-point (- match-end 2))
- response-strings))
-
- (goto-char smtpmail-read-point)
- (if (looking-at "[0-9]+ ")
- (let ((begin (match-beginning 0))
- (end (match-end 0)))
- (if smtpmail-debug-info
- (message "%s" (car response-strings)))
-
- (setq smtpmail-read-point match-end)
-
- ;; ignore lines that start with "0"
- (if (looking-at "0[0-9]+ ")
- nil
+ (catch 'done
+ (while response-continue
+ (goto-char smtpmail-read-point)
+ (while (not (search-forward "\r\n" nil t))
+ (unless (memq (process-status process) '(open run))
+ (throw 'done nil))
+ (accept-process-output process)
+ (goto-char smtpmail-read-point))
+
+ (setq match-end (point))
+ (setq response-strings
+ (cons (buffer-substring smtpmail-read-point (- match-end 2))
+ response-strings))
+
+ (goto-char smtpmail-read-point)
+ (if (looking-at "[0-9]+ ")
+ (let ((begin (match-beginning 0))
+ (end (match-end 0)))
+ (if smtpmail-debug-info
+ (message "%s" (car response-strings)))
+
+ (setq smtpmail-read-point match-end)
+
+ ;; ignore lines that start with "0"
+ (if (looking-at "0[0-9]+ ")
+ nil
+ (setq response-continue nil)
+ (setq return-value
+ (cons (string-to-number
+ (buffer-substring begin end))
+ (nreverse response-strings)))))
+
+ (if (looking-at "[0-9]+-")
+ (progn (if smtpmail-debug-info
+ (message "%s" (car response-strings)))
+ (setq smtpmail-read-point match-end)
+ (setq response-continue t))
+ (progn
+ (setq smtpmail-read-point match-end)
(setq response-continue nil)
(setq return-value
- (cons (string-to-int
- (buffer-substring begin end))
- (nreverse response-strings)))))
-
- (if (looking-at "[0-9]+-")
- (progn (if smtpmail-debug-info
- (message "%s" (car response-strings)))
- (setq smtpmail-read-point match-end)
- (setq response-continue t))
- (progn
- (setq smtpmail-read-point match-end)
- (setq response-continue nil)
- (setq return-value
- (cons nil (nreverse response-strings)))
- )
- )))
- (setq smtpmail-read-point match-end)
+ (cons nil (nreverse response-strings)))))))
+ (setq smtpmail-read-point match-end))
return-value))
@@ -623,41 +888,21 @@
)
(defun smtpmail-send-data (process buffer)
- (let
- ((data-continue t)
- (sending-data nil)
- this-line
- this-line-end)
-
- (save-excursion
- (set-buffer buffer)
+ (let ((data-continue t) sending-data)
+ (with-current-buffer buffer
(goto-char (point-min)))
-
(while data-continue
- (save-excursion
- (set-buffer buffer)
- (beginning-of-line)
- (setq this-line (point))
- (end-of-line)
- (setq this-line-end (point))
- (setq sending-data nil)
- (setq sending-data (buffer-substring this-line this-line-end))
- (if (/= (forward-line 1) 0)
- (setq data-continue nil)))
-
- (smtpmail-send-data-1 process sending-data)
- )
- )
- )
-
+ (with-current-buffer buffer
+ (setq sending-data (buffer-substring (point-at-bol) (point-at-eol)))
+ (end-of-line 2)
+ (setq data-continue (not (eobp))))
+ (smtpmail-send-data-1 process sending-data))))
(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
"Get address list suitable for smtp RCPT TO: <address>."
- (require 'mail-utils) ;; pick up mail-strip-quoted-names
-
(unwind-protect
- (save-excursion
- (set-buffer smtpmail-address-buffer) (erase-buffer)
+ (with-current-buffer smtpmail-address-buffer
+ (erase-buffer)
(let
((case-fold-search t)
(simple-address-list "")
@@ -668,9 +913,11 @@
(goto-char (point-min))
;; RESENT-* fields should stop processing of regular fields.
(save-excursion
- (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" header-end t)
- (setq addr-regexp "^Resent-\\(to\\|cc\\|bcc\\):")
- (setq addr-regexp "^\\(To:\\|Cc:\\|Bcc:\\)")))
+ (setq addr-regexp
+ (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):"
+ header-end t)
+ "^Resent-\\(to\\|cc\\|bcc\\):"
+ "^\\(To:\\|Cc:\\|Bcc:\\)")))
(while (re-search-forward addr-regexp header-end t)
(replace-match "")
@@ -685,9 +932,7 @@
(mail-strip-quoted-names (buffer-substring this-line this-line-end))))
)
(erase-buffer)
- (insert-string " ")
- (insert-string simple-address-list)
- (insert-string "\n")
+ (insert " " simple-address-list "\n")
(subst-char-in-region (point-min) (point-max) 10 ? t);; newline --> blank
(subst-char-in-region (point-min) (point-max) ?, ? t);; comma --> blank
(subst-char-in-region (point-min) (point-max) 9 ? t);; tab --> blank
@@ -729,4 +974,5 @@
(provide 'smtpmail)
+;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
;;; smtpmail.el ends here
Index: emacs.spec
===================================================================
RCS file: /cvs/dist/rpms/emacs/devel/emacs.spec,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- emacs.spec 15 Nov 2005 21:53:43 -0000 1.57
+++ emacs.spec 22 Nov 2005 04:12:23 -0000 1.58
@@ -11,7 +11,7 @@
Summary: GNU Emacs text editor
Name: emacs
Version: 21.4
-Release: 8
+Release: 9
License: GPL
URL: http://www.gnu.org/software/emacs/
Group: Applications/Editors
@@ -101,7 +101,7 @@
Patch25: scroll-margin.dpatch
Patch26: xfree86-4.3-modifiers.dpatch
# generated from ftp://fly.isti.cnr.it/pub/etags.c.gz
-Patch27: etags-14.21-17.11-diff.patch
+Patch27: etags-update-to-cvs.patch
Patch28: emacs-21-personality-linux32-101818.patch
%endif
@@ -123,6 +123,7 @@
Patch121: python-completion-ignored-extensions.dpatch
# * maybe needs updating for emacs22 *
Patch122: save-buffer.dpatch
+Patch123: smtpmail-cvs-update.patch
%endif
%description
@@ -257,6 +258,8 @@
%patch121 -p1
# save-buffer
%patch122 -p1
+# smtpmail update
+%patch123 -p1
%endif
# install rest of site-lisp files
@@ -526,6 +529,13 @@
%endif
%changelog
+* Tue Nov 22 2005 Jens Petersen <petersen at redhat.com> - 21.4-9
+- fix keyboard-coding-system on console for utf-8 (Dawid Gajownik, #173855)
+- update etags to latest cvs (Hideki Iwamoto, #173023)
+ - replace etags-14.21-17.11-diff.patch with etags-update-to-cvs.patch
+- update smtpmail.el to latest cvs version for better authentication support
+ with smtpmail-cvs-update.patch (Alberto Brizio, #167804)
+
* Mon Nov 14 2005 Jeremy Katz <katzj at redhat.com> - 21.4-8
- update dep for new xorg fonts packages
Index: lang-coding-systems-init.el
===================================================================
RCS file: /cvs/dist/rpms/emacs/devel/lang-coding-systems-init.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- lang-coding-systems-init.el 25 Feb 2005 13:20:13 -0000 1.4
+++ lang-coding-systems-init.el 22 Nov 2005 04:12:23 -0000 1.5
@@ -22,7 +22,9 @@
(require 'un-define))
(set-default-coding-systems 'utf-8)
(set-terminal-coding-system 'utf-8)
- (if (equal (getenv "TERM") "xterm")
+ (let ((term (getenv "TERM")))
+ (when (or (equal term "linux")
+ (equal term "xterm"))
(set-keyboard-coding-system 'utf-8)))
((equal lang "ja")
(set-default-coding-systems 'euc-jp)
--- etags-14.21-17.11-diff.patch DELETED ---
More information about the fedora-cvs-commits
mailing list