smtpmail.el 37 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
Richard M. Stallman's avatar
Richard M. Stallman committed
2

3
;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2008, 2009, 2010  Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5 6

;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
7 8
;; Maintainer: Simon Josefsson <simon@josefsson.org>
;; w32 Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
9
;; ESMTP support: Simon Leinen <simon@switch.ch>
10 11
;; Hacked by Mike Taylor, 11th October 1999 to add support for
;; automatically appending a domain to RCPT TO: addresses.
12
;; AUTH=LOGIN support: Stephen Cranefield <scranefield@infoscience.otago.ac.nz>
Richard M. Stallman's avatar
Richard M. Stallman committed
13 14 15 16
;; Keywords: mail

;; This file is part of GNU Emacs.

17
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
18
;; it under the terms of the GNU General Public License as published by
19 20
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
21 22 23 24 25 26 27

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
28
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
29 30 31 32 33

;;; Commentary:

;; Send Mail to smtp host from smtpmail temp buffer.

34
;; Please add these lines in your .emacs(_emacs) or use customize.
Richard M. Stallman's avatar
Richard M. Stallman committed
35
;;
36
;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
37
;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
Richard M. Stallman's avatar
Richard M. Stallman committed
38 39
;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
40
;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
41
;;(setq smtpmail-debug-info t) ; only to debug problems
42
;;(setq smtpmail-auth-credentials  ; or use ~/.authinfo
43 44 45
;;      '(("YOUR SMTP HOST" 25 "username" "password")))
;;(setq smtpmail-starttls-credentials
;;      '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert")))
46 47
;; 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).
Richard M. Stallman's avatar
Richard M. Stallman committed
48

49 50
;; To queue mail, set `smtpmail-queue-mail' to t and use
;; `smtpmail-send-queued-mail' to send.
Richard M. Stallman's avatar
Richard M. Stallman committed
51

52 53 54 55 56 57 58 59 60 61 62 63 64 65
;; 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
Richard M. Stallman's avatar
Richard M. Stallman committed
66

Richard M. Stallman's avatar
Richard M. Stallman committed
67 68 69
;;; Code:

(require 'sendmail)
70
(autoload 'starttls-any-program-available "starttls")
71 72 73
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
(autoload 'mail-strip-quoted-names "mail-utils")
Stefan Monnier's avatar
Stefan Monnier committed
74 75
(autoload 'message-make-date "message")
(autoload 'message-make-message-id "message")
76
(autoload 'rfc2104-hash "rfc2104")
77
(autoload 'netrc-parse "netrc")
78 79
(autoload 'netrc-machine "netrc")
(autoload 'netrc-get "netrc")
80
(autoload 'password-read "password-cache")
81
(autoload 'auth-source-user-or-password "auth-source")
Ted Zlatanov's avatar
Ted Zlatanov committed
82

Richard M. Stallman's avatar
Richard M. Stallman committed
83
;;;
84 85 86
(defgroup smtpmail nil
  "SMTP protocol for sending mail."
  :group 'mail)
Richard M. Stallman's avatar
Richard M. Stallman committed
87

88 89

(defcustom smtpmail-default-smtp-server nil
90
  "Specify default SMTP server.
91
This only has effect if you specify it before loading the smtpmail library."
92 93 94
  :type '(choice (const nil) string)
  :group 'smtpmail)

95
(defcustom smtpmail-smtp-server
96
  (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
97
  "The name of the host running SMTP server."
98 99
  :type '(choice (const nil) string)
  :group 'smtpmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
100

101
(defcustom smtpmail-smtp-service 25
102
  "SMTP service port number.
103
The default value would be \"smtp\" or 25."
104
  :type '(choice (integer :tag "Port") (string :tag "Service"))
105
  :group 'smtpmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
106

107
(defcustom smtpmail-local-domain nil
108
  "Local domain name without a host name.
109
If the function `system-name' returns the full internet address,
110 111 112 113
don't define this value."
  :type '(choice (const nil) string)
  :group 'smtpmail)

114
(defcustom smtpmail-sendto-domain nil
115
  "Local domain name without a host name.
116 117 118 119 120 121 122 123 124
This is appended (with an @-sign) to any specified recipients which do
not include an @-sign, so that each RCPT TO address is fully qualified.
\(Some configurations of sendmail require this.)

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>
125
	501 <someone>: recipient address must contain a domain."
126 127 128
  :type '(choice (const nil) string)
  :group 'smtpmail)

129
(defcustom smtpmail-debug-info nil
130 131 132 133 134 135 136 137 138
  "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."
139 140 141
  :type 'boolean
  :group 'smtpmail)

142 143 144 145 146
(defcustom smtpmail-code-conv-from nil
  "Coding system for encoding outgoing mail.
Used for the value of `sendmail-coding-system' when
`select-message-coding-system' is called. "
  :type 'coding-system
147
  :group 'smtpmail)
Richard M. Stallman's avatar
Richard M. Stallman committed
148

149
(defcustom smtpmail-queue-mail nil
150
  "Non-nil means mail is queued; otherwise it is sent immediately.
Richard M. Stallman's avatar
Richard M. Stallman committed
151 152 153 154 155 156
If queued, it is stored in the directory `smtpmail-queue-dir'
and sent with `smtpmail-send-queued-mail'."
  :type 'boolean
  :group 'smtpmail)

(defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
157
  "Directory where `smtpmail.el' stores queued mail."
Richard M. Stallman's avatar
Richard M. Stallman committed
158 159 160
  :type 'directory
  :group 'smtpmail)

161 162 163 164
(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,
165
`servername' (a string), `port' (an integer), `user' (a string) and
166 167 168 169 170
`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")
171 172 173
                               (integer :tag "Port")
                               (string  :tag "Username")
                               (choice (const :tag "Query when needed" nil)
174
				       (string  :tag "Password")))))
175
  :version "22.1"
176 177 178 179 180
  :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),
181 182 183 184 185 186
`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."
187 188 189 190 191 192 193
  :type '(repeat (list (string  :tag "Server")
		       (integer :tag "Port")
		       (file    :tag "Key")
		       (file    :tag "Certificate")))
  :version "21.1"
  :group 'smtpmail)

194
(defcustom smtpmail-warn-about-unknown-extensions nil
195
  "If set, print warnings about unknown SMTP extensions.
196 197 198
This is mainly useful for development purposes, to learn about
new SMTP extensions that might be useful to support."
  :type 'boolean
199
  :version "21.1"
200 201
  :group 'smtpmail)

202
(defcustom smtpmail-queue-index-file "index"
203
  "File name of queued mail index.
204 205 206 207 208 209
This is relative to `smtpmail-queue-dir'."
  :type 'string
  :group 'smtpmail)

;; End of customizable variables.

Richard M. Stallman's avatar
Richard M. Stallman committed
210

211 212 213
(defvar smtpmail-address-buffer)
(defvar smtpmail-recipient-address-list)

214 215
(defvar smtpmail-queue-counter 0)

216 217 218
;; Buffer-local variable.
(defvar smtpmail-read-point)

219
(defconst smtpmail-auth-supported '(cram-md5 plain login)
220 221
  "List of supported SMTP AUTH mechanisms.
The list is in preference order.")
222

223
(defvar smtpmail-mail-address nil
224
  "Value to use for envelope-from address for mail from ambient buffer.")
225

226
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
227 228 229 230 231 232 233
(defun smtpmail-send-it ()
  (let ((errbuf (if mail-interactive
		    (generate-new-buffer " smtpmail errors")
		  0))
	(tembuf (generate-new-buffer " smtpmail temp"))
	(case-fold-search nil)
	delimline
Kenichi Handa's avatar
Kenichi Handa committed
234
	(mailbuf (current-buffer))
Glenn Morris's avatar
Glenn Morris committed
235 236
        ;; Examine this variable now, so that
	;; local binding in the mail buffer will take effect.
237 238 239
	(smtpmail-mail-address
         (or (and mail-specify-envelope-from (mail-envelope-from))
             user-mail-address))
Kenichi Handa's avatar
Kenichi Handa committed
240 241 242 243
	(smtpmail-code-conv-from
	 (if enable-multibyte-characters
	     (let ((sendmail-coding-system smtpmail-code-conv-from))
	       (select-message-coding-system)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
244
    (unwind-protect
245
	(with-current-buffer tembuf
Richard M. Stallman's avatar
Richard M. Stallman committed
246
	  (erase-buffer)
247 248
	  ;; Use the same `buffer-file-coding-system' as in the mail
	  ;; buffer, otherwise any `write-region' invocations (e.g., in
249 250 251
	  ;; mail-do-fcc below) will annoy with asking for a suitable
	  ;; encoding.
	  (set-buffer-file-coding-system smtpmail-code-conv-from nil t)
Richard M. Stallman's avatar
Richard M. Stallman committed
252 253 254 255 256 257
	  (insert-buffer-substring mailbuf)
	  (goto-char (point-max))
	  ;; require one newline at the end.
	  (or (= (preceding-char) ?\n)
	      (insert ?\n))
	  ;; Change header-delimiter to be what sendmail expects.
258
	  (mail-sendmail-undelimit-header)
Richard M. Stallman's avatar
Richard M. Stallman committed
259
	  (setq delimline (point-marker))
260
          ;; (sendmail-synch-aliases)
Richard M. Stallman's avatar
Richard M. Stallman committed
261 262 263 264 265 266 267 268
	  (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))
269 270
	    ;; We used to process Resent-... headers here,
	    ;; but it was not done properly, and the job
271
	    ;; is done correctly in `smtpmail-deduce-address-list'.
Richard M. Stallman's avatar
Richard M. Stallman committed
272 273
	    ;; Don't send out a blank subject line
	    (goto-char (point-min))
274 275 276 277 278 279
	    (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
		(replace-match "")
	      ;; This one matches a Subject just before the header delimiter.
	      (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
		       (= (match-end 0) delimline))
		  (replace-match "")))
280 281 282 283
	    ;; Put the "From:" field in unless for some odd reason
	    ;; they put one in themselves.
	    (goto-char (point-min))
	    (if (not (re-search-forward "^From:" delimline t))
284
		(let* ((login smtpmail-mail-address)
285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317
		       (fullname (user-full-name)))
		  (cond ((eq mail-from-style 'angles)
			 (insert "From: " fullname)
			 (let ((fullname-start (+ (point-min) 6))
			       (fullname-end (point-marker)))
			   (goto-char fullname-start)
			   ;; Look for a character that cannot appear unquoted
			   ;; according to RFC 822.
			   (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
						  fullname-end 1)
			       (progn
				 ;; Quote fullname, escaping specials.
				 (goto-char fullname-start)
				 (insert "\"")
				 (while (re-search-forward "[\"\\]"
							   fullname-end 1)
				   (replace-match "\\\\\\&" t))
				 (insert "\""))))
			 (insert " <" login ">\n"))
			((eq mail-from-style 'parens)
			 (insert "From: " login " (")
			 (let ((fullname-start (point)))
			   (insert fullname)
			   (let ((fullname-end (point-marker)))
			     (goto-char fullname-start)
			     ;; RFC 822 says \ and nonmatching parentheses
			     ;; must be escaped in comments.
			     ;; Escape every instance of ()\ ...
			     (while (re-search-forward "[()\\]" fullname-end 1)
			       (replace-match "\\\\\\&" t))
			     ;; ... then undo escaping of matching parentheses,
			     ;; including matching nested parentheses.
			     (goto-char fullname-start)
318
			     (while (re-search-forward
319 320 321 322 323 324 325
				     "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
				     fullname-end 1)
			       (replace-match "\\1(\\3)" t)
			       (goto-char fullname-start))))
			 (insert ")\n"))
			((null mail-from-style)
			 (insert "From: " login "\n")))))
Stefan Monnier's avatar
Stefan Monnier committed
326 327 328 329 330 331 332 333
	    ;; 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"))
334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
	    ;; Possibly add a MIME header for the current coding system
	    (let (charset)
	      (goto-char (point-min))
	      (and (eq mail-send-nonascii 'mime)
		   (not (re-search-forward "^MIME-version:" delimline t))
		   (progn (skip-chars-forward "\0-\177")
			  (/= (point) (point-max)))
		   smtpmail-code-conv-from
		   (setq charset
			 (coding-system-get smtpmail-code-conv-from
					    'mime-charset))
		   (goto-char delimline)
		   (insert "MIME-version: 1.0\n"
			   "Content-type: text/plain; charset="
			   (symbol-name charset)
			   "\nContent-Transfer-Encoding: 8bit\n")))
Richard M. Stallman's avatar
Richard M. Stallman committed
350 351 352 353 354
	    ;; Insert an extra newline if we need it to work around
	    ;; Sun's bug that swallows newlines.
	    (goto-char (1+ delimline))
	    (if (eval mail-mailer-swallows-blank-line)
		(newline))
355 356 357
	    ;; Find and handle any FCC fields.
	    (goto-char (point-min))
	    (if (re-search-forward "^FCC:" delimline t)
358
		;; Force `mail-do-fcc' to use the encoding of the mail
359 360 361
		;; buffer to encode outgoing messages on FCC files.
		(let ((coding-system-for-write smtpmail-code-conv-from))
		  (mail-do-fcc delimline)))
Richard M. Stallman's avatar
Richard M. Stallman committed
362
	    (if mail-interactive
Stefan Monnier's avatar
Stefan Monnier committed
363
		(with-current-buffer errbuf
Richard M. Stallman's avatar
Richard M. Stallman committed
364 365 366 367
		  (erase-buffer))))
	  ;;
	  (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
	  (setq smtpmail-recipient-address-list
368
                (smtpmail-deduce-address-list tembuf (point-min) delimline))
Richard M. Stallman's avatar
Richard M. Stallman committed
369
	  (kill-buffer smtpmail-address-buffer)
370

Richard M. Stallman's avatar
Richard M. Stallman committed
371
	  (smtpmail-do-bcc delimline)
372
          ;; Send or queue
Richard M. Stallman's avatar
Richard M. Stallman committed
373 374
	  (if (not smtpmail-queue-mail)
	      (if (not (null smtpmail-recipient-address-list))
375
		  (if (not (smtpmail-via-smtp
Richard M. Stallman's avatar
Richard M. Stallman committed
376 377 378
			    smtpmail-recipient-address-list tembuf))
		      (error "Sending failed; SMTP protocol error"))
		(error "Sending failed; no recipients"))
379 380 381
	    (let* ((file-data
		    (expand-file-name
		     (format "%s_%i"
382
			     (format-time-string "%Y-%m-%d_%H-%M-%S")
383 384 385 386 387
			     (setq smtpmail-queue-counter
				   (1+ smtpmail-queue-counter)))
		     smtpmail-queue-dir))
		   (file-data (convert-standard-filename file-data))
		   (file-elisp (concat file-data ".el"))
Richard M. Stallman's avatar
Richard M. Stallman committed
388 389 390
		   (buffer-data (create-file-buffer file-data))
		   (buffer-elisp (create-file-buffer file-elisp))
		   (buffer-scratch "*queue-mail*"))
391 392
	      (unless (file-exists-p smtpmail-queue-dir)
		(make-directory smtpmail-queue-dir t))
Stefan Monnier's avatar
Stefan Monnier committed
393
	      (with-current-buffer buffer-data
Richard M. Stallman's avatar
Richard M. Stallman committed
394
		(erase-buffer)
395
		(set-buffer-file-coding-system smtpmail-code-conv-from nil t)
396
		(insert-buffer-substring tembuf)
Richard M. Stallman's avatar
Richard M. Stallman committed
397 398 399 400 401 402
		(write-file file-data)
		(set-buffer buffer-elisp)
		(erase-buffer)
		(insert (concat
			 "(setq smtpmail-recipient-address-list '"
			 (prin1-to-string smtpmail-recipient-address-list)
403
			 ")\n"))
Richard M. Stallman's avatar
Richard M. Stallman committed
404 405 406
		(write-file file-elisp)
		(set-buffer (generate-new-buffer buffer-scratch))
		(insert (concat file-data "\n"))
407 408
		(append-to-file (point-min)
				(point-max)
409 410
                                (expand-file-name smtpmail-queue-index-file
                                                  smtpmail-queue-dir)))
Richard M. Stallman's avatar
Richard M. Stallman committed
411 412 413
	      (kill-buffer buffer-scratch)
	      (kill-buffer buffer-data)
	      (kill-buffer buffer-elisp))))
Richard M. Stallman's avatar
Richard M. Stallman committed
414 415 416 417
      (kill-buffer tembuf)
      (if (bufferp errbuf)
	  (kill-buffer errbuf)))))

418
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
419 420 421
(defun smtpmail-send-queued-mail ()
  "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
  (interactive)
422
  (with-temp-buffer
423 424
    ;; Get index, get first mail, send it, update index, get second
    ;; mail, send it, etc...
425 426 427 428
    (let ((file-msg "")
          (qfile (expand-file-name smtpmail-queue-index-file
                                   smtpmail-queue-dir)))
      (insert-file-contents qfile)
429
      (goto-char (point-min))
Richard M. Stallman's avatar
Richard M. Stallman committed
430
      (while (not (eobp))
Stefan Monnier's avatar
Stefan Monnier committed
431
	(setq file-msg (buffer-substring (point) (line-end-position)))
Richard M. Stallman's avatar
Richard M. Stallman committed
432
	(load file-msg)
433 434 435
	;; Insert the message literally: it is already encoded as per
	;; the MIME headers, and code conversions might guess the
	;; encoding wrongly.
436 437 438
	(with-temp-buffer
	  (let ((coding-system-for-read 'no-conversion))
	    (insert-file-contents file-msg))
Glenn Morris's avatar
Glenn Morris committed
439 440 441 442 443 444 445 446
          (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"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
447 448
	(delete-file file-msg)
	(delete-file (concat file-msg ".el"))
449
	(delete-region (point-at-bol) (point-at-bol 2)))
450
      (write-region (point-min) (point-max) qfile))))
Richard M. Stallman's avatar
Richard M. Stallman committed
451

452
;; (defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
453 454 455 456 457 458

(defun smtpmail-fqdn ()
  (if smtpmail-local-domain
      (concat (system-name) "." smtpmail-local-domain)
    (system-name)))

459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484
(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))))))

485 486 487 488 489 490
(defun smtpmail-maybe-append-domain (recipient)
  (if (or (not smtpmail-sendto-domain)
	  (string-match "@" recipient))
      recipient
    (concat recipient "@" smtpmail-sendto-domain)))

491 492 493 494 495 496 497
(defun smtpmail-intersection (list1 list2)
  (let ((result nil))
    (dolist (el2 list2)
      (when (memq el2 list1)
	(push el2 result)))
    (nreverse result)))

498 499 500
(defvar starttls-extra-args)
(defvar starttls-extra-arguments)

501 502 503
(defun smtpmail-open-stream (process-buffer host port)
  (let ((cred (smtpmail-find-credentials
	       smtpmail-starttls-credentials host port)))
504
    (if (null (and cred (starttls-any-program-available)))
505 506 507 508 509
	;; 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
510 511 512 513 514 515 516 517
	      (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))))
Simon Josefsson's avatar
Simon Josefsson committed
518
	     (starttls-extra-arguments
519 520 521 522 523 524 525 526
	      (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)))))
527 528
	(starttls-open-stream "SMTP" process-buffer host port)))))

529
;; `password-read' autoloads password-cache.
530 531
(declare-function password-cache-add "password-cache" (key password))

532 533
(defun smtpmail-try-auth-methods (process supported-extensions host port)
  (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
534
	 (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
535
	 (auth-user (auth-source-user-or-password
Ted Zlatanov's avatar
Ted Zlatanov committed
536
		     "login" host (or port "smtp")))
537
	 (auth-pass (auth-source-user-or-password
Ted Zlatanov's avatar
Ted Zlatanov committed
538 539 540 541 542 543 544 545 546 547 548 549 550
		     "password" host (or port "smtp")))
	 (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-*
		   (list host port auth-user auth-pass)
		 ;; else, if auth-source didn't return them...
		 (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"))))
551 552
		   ;; else, try `smtpmail-find-credentials' since
		   ;; `smtpmail-auth-credentials' is not a string
Ted Zlatanov's avatar
Ted Zlatanov committed
553 554
		   (smtpmail-find-credentials
		    smtpmail-auth-credentials host port))))
555 556 557
	 (prompt (when cred (format "SMTP password for %s:%s: "
				    (smtpmail-cred-server cred)
				    (smtpmail-cred-port cred))))
558 559
	 (passwd (when cred
		   (or (smtpmail-cred-passwd cred)
560
		       (password-read prompt prompt))))
561
	 ret)
562
    (when (and cred mech)
563 564
      (cond
       ((eq mech 'cram-md5)
Simon Josefsson's avatar
Simon Josefsson committed
565
	(smtpmail-send-command process (upcase (format "AUTH %s" mech)))
566 567 568 569 570 571 572 573 574
	(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))
Richard M. Stallman's avatar
Richard M. Stallman committed
575 576 577 578 579 580 581 582
		 ;; Osamu Yamane <yamane@green.ocn.ne.jp>:
		 ;; SMTP auth fails because the SMTP server identifies
		 ;; only the first part of the string (delimited by
		 ;; 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
583
		 ;; `base64-encode-string', only the first 76 characters
Richard M. Stallman's avatar
Richard M. Stallman committed
584 585
		 ;; are taken as a response to the server, and the
		 ;; authentication fails.
586
		 (encoded (base64-encode-string response t)))
587 588 589 590 591 592 593 594 595 596 597 598
	    (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
599
	 process (base64-encode-string (smtpmail-cred-user cred) t))
600 601 602 603
	(if (or (null (car (setq ret (smtpmail-read-response process))))
		(not (integerp (car ret)))
		(>= (car ret) 400))
	    (throw 'done nil))
604
	(smtpmail-send-command process (base64-encode-string passwd t))
605 606 607 608
	(if (or (null (car (setq ret (smtpmail-read-response process))))
		(not (integerp (car ret)))
		(>= (car ret) 400))
	    (throw 'done nil)))
609
       ((eq mech 'plain)
610 611 612 613 614
	;; 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.
615 616 617
	(smtpmail-send-command process
			       (concat "AUTH PLAIN "
				       (base64-encode-string
618 619 620
					(concat "\0"
						(smtpmail-cred-user cred)
						"\0"
621
						passwd) t)))
622 623 624 625 626
	(if (or (null (car (setq ret (smtpmail-read-response process))))
		(not (integerp (car ret)))
		(not (equal (car ret) 235)))
	    (throw 'done nil)))

627
       (t
628
	(error "Mechanism %s not implemented" mech)))
629
      ;; Remember the password.
630 631
      (when (null (smtpmail-cred-passwd cred))
	(password-cache-add prompt passwd)))))
632

Richard M. Stallman's avatar
Richard M. Stallman committed
633 634
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
  (let ((process nil)
635 636
	(host (or smtpmail-smtp-server
		  (error "`smtpmail-smtp-server' not defined")))
637
	(port smtpmail-smtp-service)
638
        ;; `smtpmail-mail-address' should be set to the appropriate
Glenn Morris's avatar
Glenn Morris committed
639 640 641 642 643
        ;; 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))
Richard M. Stallman's avatar
Richard M. Stallman committed
644
	response-code
645
	greeting
646 647
	process-buffer
	(supported-extensions '()))
Richard M. Stallman's avatar
Richard M. Stallman committed
648 649 650 651 652 653 654
    (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
Stefan Monnier's avatar
Stefan Monnier committed
655
	  (with-current-buffer process-buffer
656
	    (setq buffer-undo-list t)
Richard M. Stallman's avatar
Richard M. Stallman committed
657 658 659
	    (erase-buffer))

	  ;; open the connection to the server
660
	  (setq process (smtpmail-open-stream process-buffer host port))
Richard M. Stallman's avatar
Richard M. Stallman committed
661 662 663 664 665
	  (and (null process) (throw 'done nil))

	  ;; set the send-filter
	  (set-process-filter process 'smtpmail-process-filter)

Stefan Monnier's avatar
Stefan Monnier committed
666
	  (with-current-buffer process-buffer
667
	    (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
Richard M. Stallman's avatar
Richard M. Stallman committed
668 669 670
	    (make-local-variable 'smtpmail-read-point)
	    (setq smtpmail-read-point (point-min))

671

Richard M. Stallman's avatar
Richard M. Stallman committed
672 673 674
	    (if (or (null (car (setq greeting (smtpmail-read-response process))))
		    (not (integerp (car greeting)))
		    (>= (car greeting) 400))
675
		(throw 'done nil))
Richard M. Stallman's avatar
Richard M. Stallman committed
676

677 678 679
	    (let ((do-ehlo t)
		  (do-starttls t))
	      (while do-ehlo
680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728
                ;; 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))))
729

730
	    (smtpmail-try-auth-methods process supported-extensions host port)
731 732 733 734 735 736 737 738 739 740

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

741
	    (if (and smtpmail-debug-verb
742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757
		     (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))))
Richard M. Stallman's avatar
Richard M. Stallman committed
758

759
	    ;; MAIL FROM:<sender>
760
	    (let ((size-part
761 762
		   (if (or (member 'size supported-extensions)
			   (assoc 'size supported-extensions))
763
		       (format " SIZE=%d"
Stefan Monnier's avatar
Stefan Monnier committed
764
			       (with-current-buffer smtpmail-text-buffer
765 766 767
				 ;; size estimate:
				 (+ (- (point-max) (point-min))
				    ;; Add one byte for each change-of-line
768 769
				    ;; because of CR-LF representation:
				    (count-lines (point-min) (point-max)))))
770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787
		     ""))
		  (body-part
		   (if (member '8bitmime supported-extensions)
		       ;; FIXME:
		       ;; Code should be added here that transforms
		       ;; the contents of the message buffer into
		       ;; something the receiving SMTP can handle.
		       ;; For a receiver that supports 8BITMIME, this
		       ;; may mean converting BINARY to BASE64, or
		       ;; adding Content-Transfer-Encoding and the
		       ;; other MIME headers.  The code should also
		       ;; return an indication of what encoding the
		       ;; message buffer is now, i.e. ASCII or
		       ;; 8BITMIME.
		       (if nil
			   " BODY=8BITMIME"
			 "")
		     "")))
788
              ;; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
789
	      (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
Glenn Morris's avatar
Glenn Morris committed
790
                                                     envelope-from
791 792
						     size-part
						     body-part))
793

794 795 796
	      (if (or (null (car (setq response-code (smtpmail-read-response process))))
		      (not (integerp (car response-code)))
		      (>= (car response-code) 400))
797
		  (throw 'done nil)))
798

799
	    ;; RCPT TO:<recipient>
800 801
	    (let ((n 0))
	      (while (not (null (nth n recipient)))
802
		(smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
803 804
		(setq n (1+ n))

805 806
		(setq response-code (smtpmail-read-response process))
		(if (or (null (car response-code))
807 808
			(not (integerp (car response-code)))
			(>= (car response-code) 400))
809
		    (throw 'done nil))))
810

Richard M. Stallman's avatar
Richard M. Stallman committed
811 812 813 814 815 816
	    ;; 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))
817
		(throw 'done nil))
Richard M. Stallman's avatar
Richard M. Stallman committed
818 819 820 821

	    ;; Mail contents
	    (smtpmail-send-data process smtpmail-text-buffer)

822
	    ;; DATA end "."
Richard M. Stallman's avatar
Richard M. Stallman committed
823 824 825 826 827
	    (smtpmail-send-command process ".")

	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
		    (not (integerp (car response-code)))
		    (>= (car response-code) 400))
828 829 830 831 832 833 834
		(throw 'done nil))

	    ;; QUIT
            ;; (smtpmail-send-command process "QUIT")
            ;; (and (null (car (smtpmail-read-response process)))
            ;;      (throw 'done nil))
	    t))
Richard M. Stallman's avatar
Richard M. Stallman committed
835
      (if process
Stefan Monnier's avatar
Stefan Monnier committed
836
	  (with-current-buffer (process-buffer process)
Richard M. Stallman's avatar
Richard M. Stallman committed
837 838 839
	    (smtpmail-send-command process "QUIT")
	    (smtpmail-read-response process)

840 841 842 843
            ;; (if (or (null (car (setq response-code (smtpmail-read-response process))))
            ;;         (not (integerp (car response-code)))
            ;;         (>= (car response-code) 400))
            ;;	   (throw 'done nil))
844 845 846
	    (delete-process process)
	    (unless smtpmail-debug-info
	      (kill-buffer process-buffer)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
847 848 849


(defun smtpmail-process-filter (process output)
Stefan Monnier's avatar
Stefan Monnier committed
850
  (with-current-buffer (process-buffer process)
Richard M. Stallman's avatar
Richard M. Stallman committed
851 852 853 854 855
    (goto-char (point-max))
    (insert output)))

(defun smtpmail-read-response (process)
  (let ((case-fold-search nil)
856
	(response-strings nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
857
	(response-continue t)
858
	(return-value '(nil ()))
Richard M. Stallman's avatar
Richard M. Stallman committed
859
	match-end)
860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887
    (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
888
		      (cons (string-to-number
889 890 891 892 893 894 895 896 897 898
			     (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)
899 900
	      (setq response-continue nil)
	      (setq return-value
901 902
		    (cons nil (nreverse response-strings)))))))
      (setq smtpmail-read-point match-end))
Richard M. Stallman's avatar
Richard M. Stallman committed
903 904 905 906 907 908 909 910 911 912 913 914 915 916 917
    return-value))


(defun smtpmail-send-command (process command)
  (goto-char (point-max))
  (if (= (aref command 0) ?P)
      (insert "PASS <omitted>\r\n")
    (insert command "\r\n"))
  (setq smtpmail-read-point (point))
  (process-send-string process command)
  (process-send-string process "\r\n"))

(defun smtpmail-send-data-1 (process data)
  (goto-char (point-max))

Kenichi Handa's avatar
Kenichi Handa committed
918 919 920 921
  (if (and (multibyte-string-p data)
	   smtpmail-code-conv-from)
      (setq data (string-as-multibyte
		  (encode-coding-string data smtpmail-code-conv-from))))
922

Richard M. Stallman's avatar
Richard M. Stallman committed
923 924 925 926
  (if smtpmail-debug-info
      (insert data "\r\n"))

  (setq smtpmail-read-point (point))
927 928
  ;; Escape "." at start of a line
  (if (eq (string-to-char data) ?.)
Richard M. Stallman's avatar
Richard M. Stallman committed
929
      (process-send-string process "."))
930
  (process-send-string process data)
931
  (process-send-string process "\r\n"))
Richard M. Stallman's avatar
Richard M. Stallman committed
932 933

(defun smtpmail-send-data (process buffer)
934
  (let ((data-continue t) sending-data)
Stefan Monnier's avatar
Stefan Monnier committed
935
    (with-current-buffer buffer
Richard M. Stallman's avatar
Richard M. Stallman committed
936 937
      (goto-char (point-min)))
    (while data-continue
Stefan Monnier's avatar
Stefan Monnier committed
938
      (with-current-buffer buffer
939 940 941 942
        (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))))
Richard M. Stallman's avatar
Richard M. Stallman committed
943 944 945

(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
  "Get address list suitable for smtp RCPT TO: <address>."
946
  (unwind-protect
Stefan Monnier's avatar
Stefan Monnier committed
947 948
      (with-current-buffer smtpmail-address-buffer
	(erase-buffer)
949 950 951 952 953
	(let ((case-fold-search t)
              (simple-address-list "")
              this-line
              this-line-end
              addr-regexp)
Richard M. Stallman's avatar
Richard M. Stallman committed
954 955
	  (insert-buffer-substring smtpmail-text-buffer header-start header-end)
	  (goto-char (point-min))
956 957
	  ;; RESENT-* fields should stop processing of regular fields.
	  (save-excursion
Stefan Monnier's avatar
Stefan Monnier committed
958 959 960 961 962
	    (setq addr-regexp
		  (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):"
					 header-end t)
		      "^Resent-\\(to\\|cc\\|bcc\\):"
		    "^\\(To:\\|Cc:\\|Bcc:\\)")))
963 964

	  (while (re-search-forward addr-regexp header-end t)
Richard M. Stallman's avatar
Richard M. Stallman committed
965 966 967 968 969 970 971 972 973
	    (replace-match "")
	    (setq this-line (match-beginning 0))
	    (forward-line 1)
	    ;; get any continuation lines
	    (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 " "
974
			  (mail-strip-quoted-names (buffer-substring this-line this-line-end)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
975
	  (erase-buffer)
976
	  (insert " " simple-address-list "\n")
977 978 979
	  (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
Richard M. Stallman's avatar
Richard M. Stallman committed
980 981 982 983 984 985

	  (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))
986
	  (let (recipient-address-list)
987
	    (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
988
	      (backward-char 1)
989
	      (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
990 991
						 recipient-address-list)))
	    (setq smtpmail-recipient-address-list recipient-address-list))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
992 993

(defun smtpmail-do-bcc (header-end)
994
  "Delete [Resent-]BCC: and their continuation lines from the header area.
Richard M. Stallman's avatar
Richard M. Stallman committed
995 996 997
There may be multiple BCC: lines, and each may have arbitrarily
many continuation lines."
  (let ((case-fold-search t))
Karl Heuer's avatar
Karl Heuer committed
998 999 1000