comparison lisp/mail/smtpmail.el @ 103287:e501499f857c

* mail/smtpmail.el: Indent code properly to make it more readable.

103286:b05973aa4a3f

;;(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 <[e-mail]>,
;; 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

Don't bother to set this unless you have get an error like:
	Sending failed; SMTP protocol error
when sending mail, and the *trace of SMTP session to <somewhere>*
buffer includes an exchange like:
	RCPT TO: <someone>
	501 <someone>: recipient address must contain a domain
"
  :type '(choice (const nil) string)
  :group 'smtpmail)

(defcustom smtpmail-debug-info nil
  "Whether to print info in buffer *trace of SMTP session to <somewhere>*.

`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 "" ""))

	       (select-message-coding-system)))))
    (unwind-protect
	(save-excursion
	  (set-buffer tembuf)
	  (erase-buffer)
	  ;; Use the same buffer-file-coding-system as in the mail
	  ;; buffer, otherwise any write-region invocations (e.g., in
	  ;; mail-do-fcc below) will annoy with asking for a suitable
	  ;; encoding.
	  (set-buffer-file-coding-system smtpmail-code-conv-from nil t)
	  (insert-buffer-substring mailbuf)
	  (goto-char (point-max))

	  (or (= (preceding-char) ?\n)
	      (insert ?\n))
	  ;; Change header-delimiter to be what sendmail expects.
	  (mail-sendmail-undelimit-header)
	  (setq delimline (point-marker))
;;	  (sendmail-synch-aliases)
	  (if mail-aliases
	      (expand-mail-aliases (point-min) delimline))
	  (goto-char (point-min))
	  ;; ignore any blank lines in the header
	  (while (and (re-search-forward "\n\n\n*" delimline t)
		      (< (point) delimline))
	    (replace-match "\n"))
	  (let ((case-fold-search t))
	    ;; We used to process Resent-... headers here,
	    ;; but it was not done properly, and the job
	    ;; is done correctly in smtpmail-deduce-address-list.
	    ;; Don't send out a blank subject line
	    (goto-char (point-min))
	    (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
		(replace-match "")
	      ;; This one matches a Subject just before the header delimiter.

	    (if (eval mail-mailer-swallows-blank-line)
		(newline))
	    ;; Find and handle any FCC fields.
	    (goto-char (point-min))
	    (if (re-search-forward "^FCC:" delimline t)
		;; Force mail-do-fcc to use the encoding of the mail
		;; buffer to encode outgoing messages on FCC files.
		(let ((coding-system-for-write smtpmail-code-conv-from))
		  (mail-do-fcc delimline)))
	    (if mail-interactive
		(with-current-buffer errbuf
		  (erase-buffer))))
	  ;;
	  ;;
	  ;;
	  (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
	  (setq smtpmail-recipient-address-list
		    (smtpmail-deduce-address-list tembuf (point-min) delimline))
	  (kill-buffer smtpmail-address-buffer)

	  (smtpmail-do-bcc delimline)
	  ; 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"))

;;;###autoload
(defun smtpmail-send-queued-mail ()
  "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
  (interactive)
  (with-temp-buffer
    ;;; Get index, get first mail, send it, update index, get second
    ;;; 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))

	(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)
    (system-name)))

			  (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)))

						      port-name)))
		       (when hostentry
			 (list host port
			       (netrc-get hostentry "login")
			       (netrc-get hostentry "password"))))
		   ;; else, try smtpmail-find-credentials since
		   ;; smtpmail-auth-credentials is not a string
		   (smtpmail-find-credentials
		    smtpmail-auth-credentials host port))))
	 (prompt (when cred (format "SMTP password for %s:%s: "
				    (smtpmail-cred-server cred)
				    (smtpmail-cred-port cred))))

		 ;; new line characters) as a response from the
		 ;; client, and the rest as distinct commands.

		 ;; In my case, the response string is 80 characters
		 ;; long.  Without the no-line-break option for
		 ;; base64-encode-sting, only the first 76 characters
		 ;; 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))))

(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))

	    (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))

		       ;; 8BITMIME.
		       (if nil
			   " 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 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)))))))

  (setq smtpmail-read-point (point))
  ;; Escape "." at start of a line
  (if (eq (string-to-char data) ?.)
      (process-send-string process "."))
  (process-send-string process data)
  (process-send-string process "\r\n")
  )

(defun smtpmail-send-data (process buffer)
  (let ((data-continue t) sending-data)
    (with-current-buffer buffer
      (goto-char (point-min)))

(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
  "Get address list suitable for smtp RCPT TO: <address>."
  (unwind-protect
      (with-current-buffer smtpmail-address-buffer
	(erase-buffer)
	(let
	    ((case-fold-search t)
	     (simple-address-list "")
	     this-line
	     this-line-end
	     addr-regexp)
	  (insert-buffer-substring smtpmail-text-buffer header-start header-end)
	  (goto-char (point-min))
	  ;; RESENT-* fields should stop processing of regular fields.
	  (save-excursion
	    (setq addr-regexp

	    (while (and (looking-at "^[ \t]+") (< (point) header-end))
	      (forward-line 1))
	    (setq this-line-end (point-marker))
	    (setq simple-address-list
		  (concat simple-address-list " "
			  (mail-strip-quoted-names (buffer-substring this-line this-line-end))))
	    )
	  (erase-buffer)
	  (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

	  (goto-char (point-min))
	  ;; tidyness in case hook is not robust when it looks at this
	  (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))

	  (goto-char (point-min))
	  (let (recipient-address-list)
	    (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
	      (backward-char 1)
	      (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
						 recipient-address-list))
	      )
	    (setq smtpmail-recipient-address-list recipient-address-list))

	  )
	)
    )
  )


(defun smtpmail-do-bcc (header-end)
  "Delete [Resent-]BCC: and their continuation lines from the header area.
There may be multiple BCC: lines, and each may have arbitrarily
many continuation lines."

		       (progn (forward-line 1) (point)))
	;; get rid of any continuation lines
	(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
	  (replace-match ""))))))


(provide 'smtpmail)

;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
;;; smtpmail.el ends here

103287:e501499f857c

;;(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 <[e-mail]>,
;; 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

Don't bother to set this unless you have get an error like:
	Sending failed; SMTP protocol error
when sending mail, and the *trace of SMTP session to <somewhere>*
buffer includes an exchange like:
	RCPT TO: <someone>
	501 <someone>: recipient address must contain a domain."
  :type '(choice (const nil) string)
  :group 'smtpmail)

(defcustom smtpmail-debug-info nil
  "Whether to print info in buffer *trace of SMTP session to <somewhere>*.

`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 "" ""))

	       (select-message-coding-system)))))
    (unwind-protect
	(save-excursion
	  (set-buffer tembuf)
	  (erase-buffer)
	  ;; Use the same `buffer-file-coding-system' as in the mail
	  ;; buffer, otherwise any `write-region' invocations (e.g., in
	  ;; mail-do-fcc below) will annoy with asking for a suitable
	  ;; encoding.
	  (set-buffer-file-coding-system smtpmail-code-conv-from nil t)
	  (insert-buffer-substring mailbuf)
	  (goto-char (point-max))

	  (or (= (preceding-char) ?\n)
	      (insert ?\n))
	  ;; Change header-delimiter to be what sendmail expects.
	  (mail-sendmail-undelimit-header)
	  (setq delimline (point-marker))
          ;; (sendmail-synch-aliases)
	  (if mail-aliases
	      (expand-mail-aliases (point-min) delimline))
	  (goto-char (point-min))
	  ;; ignore any blank lines in the header
	  (while (and (re-search-forward "\n\n\n*" delimline t)
		      (< (point) delimline))
	    (replace-match "\n"))
	  (let ((case-fold-search t))
	    ;; We used to process Resent-... headers here,
	    ;; but it was not done properly, and the job
	    ;; is done correctly in `smtpmail-deduce-address-list'.
	    ;; Don't send out a blank subject line
	    (goto-char (point-min))
	    (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
		(replace-match "")
	      ;; This one matches a Subject just before the header delimiter.

	    (if (eval mail-mailer-swallows-blank-line)
		(newline))
	    ;; Find and handle any FCC fields.
	    (goto-char (point-min))
	    (if (re-search-forward "^FCC:" delimline t)
		;; Force `mail-do-fcc' to use the encoding of the mail
		;; buffer to encode outgoing messages on FCC files.
		(let ((coding-system-for-write smtpmail-code-conv-from))
		  (mail-do-fcc delimline)))
	    (if mail-interactive
		(with-current-buffer errbuf
		  (erase-buffer))))
	  ;;
	  (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
	  (setq smtpmail-recipient-address-list
                (smtpmail-deduce-address-list tembuf (point-min) delimline))
	  (kill-buffer smtpmail-address-buffer)

	  (smtpmail-do-bcc delimline)
          ;; 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"))

;;;###autoload
(defun smtpmail-send-queued-mail ()
  "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
  (interactive)
  (with-temp-buffer
    ;; Get index, get first mail, send it, update index, get second
    ;; 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))

	(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)
    (system-name)))

			  (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)))

						      port-name)))
		       (when hostentry
			 (list host port
			       (netrc-get hostentry "login")
			       (netrc-get hostentry "password"))))
		   ;; else, try `smtpmail-find-credentials' since
		   ;; `smtpmail-auth-credentials' is not a string
		   (smtpmail-find-credentials
		    smtpmail-auth-credentials host port))))
	 (prompt (when cred (format "SMTP password for %s:%s: "
				    (smtpmail-cred-server cred)
				    (smtpmail-cred-port cred))))

		 ;; new line characters) as a response from the
		 ;; client, and the rest as distinct commands.

		 ;; In my case, the response string is 80 characters
		 ;; long.  Without the no-line-break option for
		 ;; `base64-encode-string', only the first 76 characters
		 ;; 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))))

(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))

	    (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))

		       ;; 8BITMIME.
		       (if nil
			   " 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 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)))))))

  (setq smtpmail-read-point (point))
  ;; Escape "." at start of a line
  (if (eq (string-to-char data) ?.)
      (process-send-string process "."))
  (process-send-string process data)
  (process-send-string process "\r\n"))

(defun smtpmail-send-data (process buffer)
  (let ((data-continue t) sending-data)
    (with-current-buffer buffer
      (goto-char (point-min)))

(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
  "Get address list suitable for smtp RCPT TO: <address>."
  (unwind-protect
      (with-current-buffer smtpmail-address-buffer
	(erase-buffer)
	(let ((case-fold-search t)
              (simple-address-list "")
              this-line
              this-line-end
              addr-regexp)
	  (insert-buffer-substring smtpmail-text-buffer header-start header-end)
	  (goto-char (point-min))
	  ;; RESENT-* fields should stop processing of regular fields.
	  (save-excursion
	    (setq addr-regexp

	    (while (and (looking-at "^[ \t]+") (< (point) header-end))
	      (forward-line 1))
	    (setq this-line-end (point-marker))
	    (setq simple-address-list
		  (concat simple-address-list " "
			  (mail-strip-quoted-names (buffer-substring this-line this-line-end)))))
	  (erase-buffer)
	  (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

	  (goto-char (point-min))
	  ;; tidyness in case hook is not robust when it looks at this
	  (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))

	  (goto-char (point-min))
	  (let (recipient-address-list)
	    (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
	      (backward-char 1)
	      (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
						 recipient-address-list)))
	    (setq smtpmail-recipient-address-list recipient-address-list))))))

(defun smtpmail-do-bcc (header-end)
  "Delete [Resent-]BCC: and their continuation lines from the header area.
There may be multiple BCC: lines, and each may have arbitrarily
many continuation lines."

		       (progn (forward-line 1) (point)))
	;; get rid of any continuation lines
	(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
	  (replace-match ""))))))

(provide 'smtpmail)

;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
;;; smtpmail.el ends here