=== modified file 'lisp/mail/smtpmail.el'
*** lisp/mail/smtpmail.el	2011-05-30 17:23:47 +0000
--- lisp/mail/smtpmail.el	2011-06-15 20:33:56 +0000
***************
*** 34,47 ****
  ;;
  ;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
  ;;(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).
  
--- 34,45 ----
  ;;
  ;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
  ;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
! ;;(setq smtpmail-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")))
  ;; 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).
  
***************
*** 58,74 ****
  ;; 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)
- (autoload 'starttls-any-program-available "starttls")
- (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")
--- 56,64 ----
***************
*** 85,95 ****
    :group 'mail)
  
  
! (defcustom smtpmail-default-smtp-server nil
    "Specify default SMTP server.
! This only has effect if you specify it before loading the smtpmail library."
!   :type '(choice (const nil) string)
!   :group 'smtpmail)
  
  (defcustom smtpmail-smtp-server
    (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
--- 75,83 ----
    :group 'mail)
  
  
! (defvar smtpmail-default-smtp-server nil
    "Specify default SMTP server.
! This only has effect if you specify it before loading the smtpmail library.")
  
  (defcustom smtpmail-smtp-server
    (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
***************
*** 110,115 ****
--- 98,113 ----
    :type '(choice (const nil) string)
    :group 'smtpmail)
  
+ (defcustom smtpmail-stream-type nil
+   "Connection type SMTP connections.
+ This may be either nil (plain connection) or `starttls' (use the
+ starttls mechanism to turn on TLS security after opening the
+ stream)."
+   :version "24.1"
+   :group 'smtpmail
+   :type '(choice (const :tag "Plain" nil)
+ 		 (const starttls)))
+ 
  (defcustom smtpmail-sendto-domain nil
    "Local domain name without a host name.
  This is appended (with an @-sign) to any specified recipients which do
***************
*** 174,195 ****
    :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).
- If you do not have a certificate/key pair, leave the `key' and
- `certificate' fields as `nil'.  A key/certificate pair is only
- needed if you want to use X.509 client authenticated
- connections."
-   :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
--- 172,177 ----
***************
*** 230,235 ****
--- 212,218 ----
  	(tembuf (generate-new-buffer " smtpmail temp"))
  	(case-fold-search nil)
  	delimline
+ 	result
  	(mailbuf (current-buffer))
          ;; Examine this variable now, so that
  	;; local binding in the mail buffer will take effect.
***************
*** 373,381 ****
            ;; Send or queue
  	  (if (not smtpmail-queue-mail)
  	      (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"))
  	    (let* ((file-data
  		    (expand-file-name
--- 356,365 ----
            ;; Send or queue
  	  (if (not smtpmail-queue-mail)
  	      (if (not (null smtpmail-recipient-address-list))
! 		  (when (setq result
! 			      (smtpmail-via-smtp
! 			       smtpmail-recipient-address-list tembuf))
! 		    (error "Sending failed: %s" result))
  		(error "Sending failed; no recipients"))
  	    (let* ((file-data
  		    (expand-file-name
***************
*** 432,438 ****
      ;; mail, send it, etc...
      (let ((file-msg "")
            (qfile (expand-file-name smtpmail-queue-index-file
!                                    smtpmail-queue-dir)))
        (insert-file-contents qfile)
        (goto-char (point-min))
        (while (not (eobp))
--- 416,423 ----
      ;; mail, send it, etc...
      (let ((file-msg "")
            (qfile (expand-file-name smtpmail-queue-index-file
!                                    smtpmail-queue-dir))
! 	  result)
        (insert-file-contents qfile)
        (goto-char (point-min))
        (while (not (eobp))
***************
*** 448,464 ****
                   (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"))
  	(delete-region (point-at-bol) (point-at-bol 2)))
        (write-region (point-min) (point-max) qfile))))
  
- ;; (defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
- 
  (defun smtpmail-fqdn ()
    (if smtpmail-local-domain
        (concat (system-name) "." smtpmail-local-domain)
--- 433,448 ----
                   (or (and mail-specify-envelope-from (mail-envelope-from))
                       user-mail-address)))
              (if (not (null smtpmail-recipient-address-list))
!                 (when (setq result (smtpmail-via-smtp
! 				    smtpmail-recipient-address-list
! 				    (current-buffer)))
! 		  (error "Sending failed: %s" result))
                (error "Sending failed; no recipients"))))
  	(delete-file file-msg)
  	(delete-file (concat file-msg ".el"))
  	(delete-region (point-at-bol) (point-at-bol 2)))
        (write-region (point-min) (point-max) qfile))))
  
  (defun smtpmail-fqdn ()
    (if smtpmail-local-domain
        (concat (system-name) "." smtpmail-local-domain)
***************
*** 503,548 ****
  	(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 (starttls-any-program-available)))
- 	;; 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)))))
- 
  ;; `password-read' autoloads password-cache.
  (declare-function password-cache-add "password-cache" (key password))
  
! (defun smtpmail-try-auth-methods (process supported-extensions host port)
    (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
  	 (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
           (auth-info (auth-source-search :max 1
                                          :host host
!                                         :port (or port "smtp")))
           (auth-user (plist-get (nth 0 auth-info) :user))
           (auth-pass (plist-get (nth 0 auth-info) :secret))
           (auth-pass (if (functionp auth-pass)
--- 487,511 ----
  	(push el2 result)))
      (nreverse result)))
  
  ;; `password-read' autoloads password-cache.
  (declare-function password-cache-add "password-cache" (key password))
  
! (defun smtpmail-command-or-throw (process string &optional code)
!   (let (ret)
!     (smtpmail-send-command process string)
!     (unless (smtpmail-ok-p (setq ret (smtpmail-read-response process))
! 			   code)
!       (throw 'done (smtpmail-response-text ret)))
!     ret))
! 
! (defun smtpmail-try-auth-methods (process supported-extensions host port
! 					  &optional ask-for-password)
    (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
  	 (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
           (auth-info (auth-source-search :max 1
                                          :host host
!                                         :port (or port "smtp")
! 					:create ask-for-password))
           (auth-user (plist-get (nth 0 auth-info) :user))
           (auth-pass (plist-get (nth 0 auth-info) :secret))
           (auth-pass (if (functionp auth-pass)
***************
*** 571,584 ****
  		   (or (smtpmail-cred-passwd cred)
  		       (password-read prompt prompt))))
  	 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))
--- 534,545 ----
  		   (or (smtpmail-cred-passwd cred)
  		       (password-read prompt prompt))))
  	 ret)
!     (if (not (and cred mech))
! 	mech
        (cond
         ((eq mech 'cram-md5)
! 	(setq ret (smtpmail-command-or-throw
! 		   process (format "AUTH %s" (upcase mech))))
  	(when (eq (car ret) 334)
  	  (let* ((challenge (substring (cadr ret) 4))
  		 (decoded (base64-decode-string challenge))
***************
*** 596,648 ****
  		 ;; are taken as a response to the server, and the
  		 ;; authentication fails.
  		 (encoded (base64-encode-string response t)))
! 	    (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) t))
! 	(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 t))
! 	(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) t)))
! 	(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 (null (smtpmail-cred-passwd cred))
! 	(password-cache-add prompt passwd)))))
  
! (defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
    (let ((process nil)
  	(host (or smtpmail-smtp-server
  		  (error "`smtpmail-smtp-server' not defined")))
--- 557,610 ----
  		 ;; are taken as a response to the server, and the
  		 ;; authentication fails.
  		 (encoded (base64-encode-string response t)))
! 	    (smtpmail-command-or-throw process encoded))))
         ((eq mech 'login)
! 	(smtpmail-command-or-throw process "AUTH LOGIN")
! 	(smtpmail-command-or-throw
  	 process (base64-encode-string (smtpmail-cred-user cred) t))
! 	(smtpmail-command-or-throw process (base64-encode-string passwd t)))
         ((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-command-or-throw
! 	 process
! 	 (concat "AUTH PLAIN "
! 		 (base64-encode-string
! 		  (concat "\0"
! 			  (smtpmail-cred-user cred)
! 			  "\0"
! 			  passwd) t))
! 	 235))
         (t
  	(error "Mechanism %s not implemented" mech)))
        ;; Remember the password.
        (when (null (smtpmail-cred-passwd cred))
! 	(password-cache-add prompt passwd))
!       nil)))
! 
! (defun smtpmail-response-code (string)
!   (when string
!     (with-temp-buffer
!       (insert string)
!       (goto-char (point-min))
!       (and (re-search-forward "^\\([0-9]+\\) " nil t)
! 	   (string-to-number (match-string 1))))))
! 
! (defun smtpmail-ok-p (response &optional code)
!   (and (car response)
!        (integerp (car response))
!        (< (car response) 400)
!        (or (null code)
! 	   (= code (car response)))))
! 
! (defun smtpmail-response-text (response)
!   (mapconcat 'identity (cdr response) "\n"))
  
! (defun smtpmail-via-smtp (recipient smtpmail-text-buffer
! 				    &optional ask-for-password)
    (let ((process nil)
  	(host (or smtpmail-smtp-server
  		  (error "`smtpmail-smtp-server' not defined")))
***************
*** 654,667 ****
                                  (mail-envelope-from))
                             user-mail-address))
  	response-code
- 	greeting
  	process-buffer
  	(supported-extensions '()))
      (unwind-protect
  	(catch 'done
  	  ;; get or create the trace buffer
  	  (setq process-buffer
! 		(get-buffer-create (format "*trace of SMTP session to %s*" host)))
  
  	  ;; clear the trace buffer of old output
  	  (with-current-buffer process-buffer
--- 616,631 ----
                                  (mail-envelope-from))
                             user-mail-address))
  	response-code
  	process-buffer
+ 	result
+ 	auth-mechanisms
  	(supported-extensions '()))
      (unwind-protect
  	(catch 'done
  	  ;; get or create the trace buffer
  	  (setq process-buffer
! 		(get-buffer-create
! 		 (format "*trace of SMTP session to %s*" host)))
  
  	  ;; clear the trace buffer of old output
  	  (with-current-buffer process-buffer
***************
*** 669,773 ****
  	    (erase-buffer))
  
  	  ;; open the connection to the server
! 	  (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)
  
  	  (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))
  
! 
! 	    (if (or (null (car (setq greeting (smtpmail-read-response process))))
! 		    (not (integerp (car greeting)))
! 		    (>= (car greeting) 400))
! 		(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))))
!                         (not (integerp (car response-code)))
!                         (>= (car response-code) 400))
!                     (progn
!                       ;; HELO
!                       (smtpmail-send-command
!                        process (format "HELO %s" (smtpmail-fqdn)))
! 
!                       (if (or (null (car (setq response-code
!                                                (smtpmail-read-response process))))
!                               (not (integerp (car response-code)))
!                               (>= (car response-code) 400))
!                           (throw 'done nil)))
!                   (dolist (line (cdr (cdr response-code)))
!                     (let ((name
!                            (with-case-table ascii-case-table
!                              (mapcar (lambda (s) (intern (downcase s)))
!                                      (split-string (substring line 4) "[ ]")))))
!                       (and (eq (length name) 1)
!                            (setq name (car name)))
!                       (and name
!                            (cond ((memq (if (consp name) (car name) name)
!                                         '(verb xvrb 8bitmime onex xone
!                                                expn size dsn etrn
!                                                enhancedstatuscodes
!                                                help xusr
!                                                auth=login auth starttls))
!                                   (setq supported-extensions
!                                         (cons name supported-extensions)))
!                                  (smtpmail-warn-about-unknown-extensions
!                                   (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))
! 		(progn
! 		  (smtpmail-send-command process (format "ONEX"))
! 		  (if (or (null (car (setq response-code (smtpmail-read-response process))))
! 			  (not (integerp (car response-code)))
! 			  (>= (car response-code) 400))
! 		      (throw 'done nil))))
! 
! 	    (if (and smtpmail-debug-verb
! 		     (or (member 'verb supported-extensions)
! 			 (member 'xvrb supported-extensions)))
! 		(progn
! 		  (smtpmail-send-command process (format "VERB"))
! 		  (if (or (null (car (setq response-code (smtpmail-read-response process))))
! 			  (not (integerp (car response-code)))
! 			  (>= (car response-code) 400))
! 		      (throw 'done nil))))
! 
! 	    (if (member 'xusr supported-extensions)
! 		(progn
! 		  (smtpmail-send-command process (format "XUSR"))
! 		  (if (or (null (car (setq response-code (smtpmail-read-response process))))
! 			  (not (integerp (car response-code)))
! 			  (>= (car response-code) 400))
! 		      (throw 'done nil))))
! 
  	    ;; MAIL FROM:<sender>
  	    (let ((size-part
  		   (if (or (member 'size supported-extensions)
--- 633,719 ----
  	    (erase-buffer))
  
  	  ;; open the connection to the server
! 	  (setq result
! 		(open-network-stream
! 		 "smtpmail" process-buffer host port
! 		 :type smtpmail-stream-type
! 		 :return-list t
! 		 :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
! 		 :end-of-command "^[0-9]+ .*\r\n"
! 		 :success "^2.*\n"
! 		 :always-query-capabilities t
! 		 :starttls-function
! 		 (lambda (capabilities)
! 		   (and (string-match "-STARTTLS" capabilities)
! 			"STARTTLS\r\n"))))
! 
! 	  ;; If we couldn't access the server at all, we give up.
! 	  (unless (setq process (car result))
! 	    (throw 'done "Unable to contact server"))
  
  	  ;; set the send-filter
  	  (set-process-filter process 'smtpmail-process-filter)
  
+ 	  (let* ((greeting (plist-get (cdr result) :greeting))
+ 		 (code (smtpmail-response-code greeting)))
+ 	    (unless code
+ 	      (throw 'done (format "No greeting: %s" greeting)))
+ 	    (when (>= code 400)
+ 	      (throw 'done (format "Connection not allowed: %s" greeting))))
+ 	  
  	  (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))
  
! 	    (let* ((capabilities (plist-get (cdr result) :capabilities))
! 		   (code (smtpmail-response-code capabilities)))
! 	      (if (or (null code)
! 		      (>= code 400))
! 		  ;; The server didn't accept EHLO, so we fall back on HELO.
! 		  (smtpmail-command-or-throw
! 		   process (format "HELO %s" (smtpmail-fqdn)))
! 		;; EHLO was successful, so we parse the extensions.
! 		(dolist (line (delete
! 			       ""
! 			       (split-string
! 				(plist-get (cdr result) :capabilities)
! 				"\r\n")))
! 		  (let ((name
! 			 (with-case-table ascii-case-table
! 			   (mapcar (lambda (s) (intern (downcase s)))
! 				   (split-string (substring line 4) "[ ]")))))
! 		    (when (= (length name) 1)
! 		      (setq name (car name)))
! 		    (when name
! 		      (cond ((memq (if (consp name) (car name) name)
! 				   '(verb xvrb 8bitmime onex xone
! 					  expn size dsn etrn
! 					  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 auth-mechanisms
! 		  (smtpmail-try-auth-methods
! 		   process supported-extensions host port
! 		   ask-for-password))
! 
! 	    (when (or (member 'onex supported-extensions)
! 		      (member 'xone supported-extensions))
! 	      (smtpmail-command-or-throw process (format "ONEX")))
! 
! 	    (when (and smtpmail-debug-verb
! 		       (or (member 'verb supported-extensions)
! 			   (member 'xvrb supported-extensions)))
! 	      (smtpmail-command-or-throw process (format "VERB")))
! 
! 	    (when (member 'xusr supported-extensions)
! 	      (smtpmail-command-or-throw process (format "XUSR")))
! 	    
  	    ;; MAIL FROM:<sender>
  	    (let ((size-part
  		   (if (or (member 'size supported-extensions)
***************
*** 797,861 ****
  			   " BODY=8BITMIME"
  			 "")
  		     "")))
!               ;; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
! 	      (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
!                                                      envelope-from
! 						     size-part
! 						     body-part))
! 
! 	      (if (or (null (car (setq response-code (smtpmail-read-response process))))
! 		      (not (integerp (car response-code)))
! 		      (>= (car response-code) 400))
! 		  (throw 'done nil)))
  
  	    ;; 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))))
! 		(setq n (1+ n))
! 
! 		(setq response-code (smtpmail-read-response process))
! 		(if (or (null (car response-code))
! 			(not (integerp (car response-code)))
! 			(>= (car response-code) 400))
! 		    (throw 'done nil))))
! 
! 	    ;; DATA
! 	    (smtpmail-send-command process "DATA")
! 
! 	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
! 		    (not (integerp (car response-code)))
! 		    (>= (car response-code) 400))
! 		(throw 'done nil))
  
! 	    ;; Mail contents
  	    (smtpmail-send-data process smtpmail-text-buffer)
- 
  	    ;; DATA end "."
! 	    (smtpmail-send-command process ".")
! 
! 	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
! 		    (not (integerp (car response-code)))
! 		    (>= (car response-code) 400))
! 		(throw 'done nil))
! 
! 	    ;; QUIT
!             ;; (smtpmail-send-command process "QUIT")
!             ;; (and (null (car (smtpmail-read-response process)))
!             ;;      (throw 'done nil))
! 	    t))
!       (if process
! 	  (with-current-buffer (process-buffer process)
! 	    (smtpmail-send-command process "QUIT")
! 	    (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))
! 	    (delete-process process)
! 	    (unless smtpmail-debug-info
! 	      (kill-buffer process-buffer)))))))
  
  
  (defun smtpmail-process-filter (process output)
--- 743,795 ----
  			   " BODY=8BITMIME"
  			 "")
  		     "")))
! 	      (smtpmail-command-or-throw
! 	       process (format "MAIL FROM:<%s>%s%s"
! 			       envelope-from size-part body-part)))
  
  	    ;; 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))))
! 		(cond
! 		 ((smtpmail-ok-p (setq result (smtpmail-read-response process)))
! 		  ;; Success.
! 		  nil)
! 		 ((and auth-mechanisms
! 		       (not ask-for-password)
! 		       (= (car result) 550))
! 		  ;; We got a "550 relay not permitted", and the server
! 		  ;; accepts credentials, so we try again, but ask for a
! 		  ;; password first.
! 		  (smtpmail-send-command process "QUIT")
! 		  (smtpmail-read-response process)
! 		  (delete-process process)
! 		  (throw 'done
! 			 (smtpmail-via-smtp recipient smtpmail-text-buffer t)))
! 		 (t
! 		  ;; Return the error code.
! 		  (throw 'done
! 			 (smtpmail-response-text result))))
! 		(setq n (1+ n))))
  
! 	    ;; Send the contents.
! 	    (smtpmail-command-or-throw process "DATA")
  	    (smtpmail-send-data process smtpmail-text-buffer)
  	    ;; DATA end "."
! 	    (smtpmail-command-or-throw process ".")
! 	    ;; Return success.
! 	    nil))
!       (when (and process
! 		 (buffer-live-p process-buffer))
! 	(with-current-buffer (process-buffer process)
! 	  (smtpmail-send-command process "QUIT")
! 	  (smtpmail-read-response process)
! 	  (delete-process process)
! 	  (unless smtpmail-debug-info
! 	    (kill-buffer process-buffer)))))))
  
  
  (defun smtpmail-process-filter (process output)