Update smtpmail.el to recent CVS version. Requested by Aleksey Cheusov

in PR pkg/34455. Bump PKGREVISION.

4 files changed, 861 insertions, 5 deletions

diff --git a/editors/emacs/Makefile b/editors/emacs/Makefile
index 70384b8f0de..b0b11471a6c 100644
--- a/editors/emacs/Makefile
+++ b/editors/emacs/Makefile
@@ -1,7 +1,7 @@
-# $NetBSD: Makefile,v 1.100 2007/01/25 20:52:29 markd Exp $
+# $NetBSD: Makefile,v 1.101 2007/01/25 20:59:15 markd Exp $
 
 DISTNAME=	emacs-${EMACSVERSION}a
-PKGREVISION=	8
+PKGREVISION=	9
 CATEGORIES=	editors
 COMMENT=	GNU editing macros (editor)
 
diff --git a/editors/emacs/Makefile.common b/editors/emacs/Makefile.common
index c9028a8d77b..d44b0a6ea2d 100644
--- a/editors/emacs/Makefile.common
+++ b/editors/emacs/Makefile.common
@@ -1,4 +1,4 @@
-# $NetBSD: Makefile.common,v 1.11 2006/11/03 07:01:54 wiz Exp $
+# $NetBSD: Makefile.common,v 1.12 2007/01/25 20:59:15 markd Exp $
 
 MASTER_SITES=	${MASTER_SITE_GNU:=emacs/}
 MAINTAINER=	markd@NetBSD.org
@@ -72,7 +72,9 @@ post-extract:
 
 # for patch-ba
 post-build:
-	(cd ${WRKSRC}/lisp; ${MAKE_PROGRAM} sort.elc)
+	cd ${WRKSRC}/lisp && \
+	   rm sort.elc && ${MAKE_PROGRAM} sort.elc && \
+	   rm mail/smtpmail.elc && ${MAKE_PROGRAM} mail/smtpmail.elc
 
 pre-install:
 	@${FIND} ${WRKSRC} -type f -name "*.orig" -print | ${XARGS} ${RM} -f
diff --git a/editors/emacs/distinfo b/editors/emacs/distinfo
index fdc154b0913..d35ff181dc0 100644
--- a/editors/emacs/distinfo
+++ b/editors/emacs/distinfo
@@ -1,4 +1,4 @@
-$NetBSD: distinfo,v 1.31 2007/01/25 20:52:29 markd Exp $
+$NetBSD: distinfo,v 1.32 2007/01/25 20:59:15 markd Exp $
 
 SHA1 (emacs-21.4a.tar.gz) = cdb33731180fe4a912838af805dd35e3f55394d4
 RMD160 (emacs-21.4a.tar.gz) = c312e739935b56d08783bbfe97992297a363cb8a
@@ -26,5 +26,6 @@ SHA1 (patch-au) = e5d90961b4d78c37dec196097a16e0b6ac22e3bb
 SHA1 (patch-av) = 9b6ea439df406a55310e2ca1af45ed56f1663263
 SHA1 (patch-az) = 43753accb1b9ffc2c63e638c31236b8e4880080b
 SHA1 (patch-ba) = ae05985ce8cabffdfbfb84905e1d6b0de7690b25
+SHA1 (patch-bb) = bf748292c57459b1240da01f9d3df16e4dc40fa2
 SHA1 (patch-bg) = 567ccce83e2b6d898a87f20763d5ff4b19c30deb
 SHA1 (patch-xx) = cf1cb21e0bd96202622ff54e39d202bdae78c942
diff --git a/editors/emacs/patches/patch-bb b/editors/emacs/patches/patch-bb
new file mode 100644
index 00000000000..214286fa8b2
--- /dev/null
+++ b/editors/emacs/patches/patch-bb
@@ -0,0 +1,853 @@
+$NetBSD: patch-bb,v 1.4 2007/01/25 20:59:15 markd Exp $
+
+--- lisp/mail/smtpmail.el.orig	2006-09-02 00:23:45.000000000 +0300
++++ lisp/mail/smtpmail.el
+@@ -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,
++;;   2006 Free Software Foundation, Inc.
+ 
+ ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
+-;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
++;; Maintainer: Simon Josefsson <simon@josefsson.org>
++;; w32 Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
+ ;; ESMTP support: Simon Leinen <simon@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@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@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@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@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 @@ buffer includes an exchange like:
+   :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 @@ and sent with `smtpmail-send-queued-mail
+   :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@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 @@ This is relative to `smtpmail-queue-dir'
+ (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 @@ This is relative to `smtpmail-queue-dir'
+ 	(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 @@ This is relative to `smtpmail-queue-dir'
+ 	    ;; 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 @@ This is relative to `smtpmail-queue-dir'
+ 			 (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 @@ This is relative to `smtpmail-queue-dir'
+ 	    (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 @@ This is relative to `smtpmail-queue-dir'
+ 			    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-substring tembuf)
+ 		(write-file file-data)
+ 		(set-buffer buffer-elisp)
+ 		(erase-buffer)
+@@ -299,35 +391,33 @@ This is relative to `smtpmail-queue-dir'
+ (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,175 @@ This is relative to `smtpmail-queue-dir'
+       (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)
++	;; We used to send an empty initial request, and wait for an
++	;; empty response, and then send the password, but this
++	;; violate a SHOULD in RFC 2222 paragraph 5.1.  Note that this
++	;; is not sent if the server did not advertise AUTH PLAIN in
++	;; the EHLO response.  See RFC 2554 for more info.
++	(smtpmail-send-command process
++			       (concat "AUTH PLAIN "
++				       (base64-encode-string
++					(concat "\0"
++						(smtpmail-cred-user cred)
++						"\0"
++						passwd))))
++	(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 +606,18 @@ This is relative to `smtpmail-queue-dir'
+ 		(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
++	    (setq buffer-undo-list t)
+ 	    (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 +629,58 @@ This is relative to `smtpmail-queue-dir'
+ 		(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 +691,7 @@ This is relative to `smtpmail-queue-dir'
+ 			  (>= (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 +709,17 @@ This is relative to `smtpmail-queue-dir'
+ 			  (>= (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 +739,8 @@ This is relative to `smtpmail-queue-dir'
+ 			 "")
+ 		     "")))
+ ;	      (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 +750,10 @@ This is relative to `smtpmail-queue-dir'
+ 		  (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 +791,7 @@ This is relative to `smtpmail-queue-dir'
+ ;		 (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 +800,13 @@ This is relative to `smtpmail-queue-dir'
+ ;		    (>= (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 +816,49 @@ This is relative to `smtpmail-queue-dir'
+ 	(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 +891,21 @@ This is relative to `smtpmail-queue-dir'
+   )
+ 
+ (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 +916,11 @@ This is relative to `smtpmail-queue-dir'
+ 	  (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 +935,7 @@ This is relative to `smtpmail-queue-dir'
+ 			  (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 +977,5 @@ many continuation lines."
+ 
+ (provide 'smtpmail)
+ 
++;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
+ ;;; smtpmail.el ends here