lisp/mail/smtpmail.el

   1 ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
   2
   3 ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
   4
   5 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
   6 ;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
   7 ;; ESMTP support: Simon Leinen <simon@switch.ch>
   8 ;; Keywords: mail
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Send Mail to smtp host from smtpmail temp buffer.
  30
  31 ;; Please add these lines in your .emacs(_emacs).
  32 ;;
  33 ;;(setq send-mail-function 'smtpmail-send-it)
  34 ;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
  35 ;;(setq smtpmail-smtp-service "smtp")
  36 ;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
  37 ;;(setq smtpmail-debug-info t)
  38 ;;(load-library "smtpmail")
  39 ;;(setq smtpmail-code-conv-from nil)
  40 ;;(setq user-full-name "YOUR NAME HERE")
  41
  42 ;; To queue mail, set smtpmail-queue-mail to t and use
  43 ;; smtpmail-send-queued-mail to send.
  44
  45
  46 ;;; Code:
  47
  48 (require 'sendmail)
  49 (require 'time-stamp)
  50
  51 ;;;
  52 (defgroup smtpmail nil
  53   "SMTP protocol for sending mail."
  54   :group 'mail)
  55
  56
  57 (defcustom smtpmail-default-smtp-server nil
  58   "*Specify default SMTP server."
  59   :type '(choice (const nil) string)
  60   :group 'smtpmail)
  61
  62 (defcustom smtpmail-smtp-server
  63   (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
  64   "*The name of the host running SMTP server."
  65   :type '(choice (const nil) string)
  66   :group 'smtpmail)
  67
  68 (defcustom smtpmail-smtp-service 25
  69   "*SMTP service port number. smtp or 25 ."
  70   :type 'integer
  71   :group 'smtpmail)
  72
  73 (defcustom smtpmail-local-domain nil
  74   "*Local domain name without a host name.
  75 If the function (system-name) returns the full internet address,
  76 don't define this value."
  77   :type '(choice (const nil) string)
  78   :group 'smtpmail)
  79
  80 (defcustom smtpmail-debug-info nil
  81   "*smtpmail debug info printout. messages and process buffer."
  82   :type 'boolean
  83   :group 'smtpmail)
  84
  85 (defcustom smtpmail-code-conv-from nil ;; *junet*
  86   "*smtpmail code convert from this code to *internal*..for tiny-mime.."
  87   :type 'boolean
  88   :group 'smtpmail)
  89
  90 (defcustom smtpmail-queue-mail nil
  91   "*Specify if mail is queued (if t) or sent immediately (if nil).
  92 If queued, it is stored in the directory `smtpmail-queue-dir'
  93 and sent with `smtpmail-send-queued-mail'."
  94   :type 'boolean
  95   :group 'smtpmail)
  96
  97 (defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
  98   "*Directory where `smtpmail.el' stores queued mail."
  99   :type 'directory
 100   :group 'smtpmail)
 101
 102 (defvar smtpmail-queue-index-file "index"
 103   "File name of queued mail index,
 104 This is relative to `smtpmail-queue-dir'.")
 105
 106 (defvar smtpmail-queue-index (concat smtpmail-queue-dir
 107                                      smtpmail-queue-index-file))
 108
 109 ;;;
 110 ;;;
 111 ;;;
 112
 113 (defun smtpmail-send-it ()
 114   (require 'mail-utils)
 115   (let ((errbuf (if mail-interactive
 116                     (generate-new-buffer " smtpmail errors")
 117                   0))
 118         (tembuf (generate-new-buffer " smtpmail temp"))
 119         (case-fold-search nil)
 120         delimline
 121         (mailbuf (current-buffer)))
 122     (unwind-protect
 123         (save-excursion
 124           (set-buffer tembuf)
 125           (erase-buffer)
 126           (insert-buffer-substring mailbuf)
 127           (goto-char (point-max))
 128           ;; require one newline at the end.
 129           (or (= (preceding-char) ?\n)
 130               (insert ?\n))
 131           ;; Change header-delimiter to be what sendmail expects.
 132           (goto-char (point-min))
 133           (re-search-forward
 134             (concat "^" (regexp-quote mail-header-separator) "\n"))
 135           (replace-match "\n")
 136           (backward-char 1)
 137           (setq delimline (point-marker))
 138 ;;        (sendmail-synch-aliases)
 139           (if mail-aliases
 140               (expand-mail-aliases (point-min) delimline))
 141           (goto-char (point-min))
 142           ;; ignore any blank lines in the header
 143           (while (and (re-search-forward "\n\n\n*" delimline t)
 144                       (< (point) delimline))
 145             (replace-match "\n"))
 146           (let ((case-fold-search t))
 147             ;; We used to process Resent-... headers here,
 148             ;; but it was not done properly, and the job
 149             ;; is done correctly in smtpmail-deduce-address-list.
 150             ;; Don't send out a blank subject line
 151             (goto-char (point-min))
 152             (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
 153                 (replace-match "")
 154               ;; This one matches a Subject just before the header delimiter.
 155               (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
 156                        (= (match-end 0) delimline))
 157                   (replace-match "")))
 158             ;; Put the "From:" field in unless for some odd reason
 159             ;; they put one in themselves.
 160             (goto-char (point-min))
 161             (if (not (re-search-forward "^From:" delimline t))
 162                 (let* ((login user-mail-address)
 163                        (fullname (user-full-name)))
 164                   (cond ((eq mail-from-style 'angles)
 165                          (insert "From: " fullname)
 166                          (let ((fullname-start (+ (point-min) 6))
 167                                (fullname-end (point-marker)))
 168                            (goto-char fullname-start)
 169                            ;; Look for a character that cannot appear unquoted
 170                            ;; according to RFC 822.
 171                            (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
 172                                                   fullname-end 1)
 173                                (progn
 174                                  ;; Quote fullname, escaping specials.
 175                                  (goto-char fullname-start)
 176                                  (insert "\"")
 177                                  (while (re-search-forward "[\"\\]"
 178                                                            fullname-end 1)
 179                                    (replace-match "\\\\\\&" t))
 180                                  (insert "\""))))
 181                          (insert " <" login ">\n"))
 182                         ((eq mail-from-style 'parens)
 183                          (insert "From: " login " (")
 184                          (let ((fullname-start (point)))
 185                            (insert fullname)
 186                            (let ((fullname-end (point-marker)))
 187                              (goto-char fullname-start)
 188                              ;; RFC 822 says \ and nonmatching parentheses
 189                              ;; must be escaped in comments.
 190                              ;; Escape every instance of ()\ ...
 191                              (while (re-search-forward "[()\\]" fullname-end 1)
 192                                (replace-match "\\\\\\&" t))
 193                              ;; ... then undo escaping of matching parentheses,
 194                              ;; including matching nested parentheses.
 195                              (goto-char fullname-start)
 196                              (while (re-search-forward
 197                                      "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
 198                                      fullname-end 1)
 199                                (replace-match "\\1(\\3)" t)
 200                                (goto-char fullname-start))))
 201                          (insert ")\n"))
 202                         ((null mail-from-style)
 203                          (insert "From: " login "\n")))))
 204             ;; Insert an extra newline if we need it to work around
 205             ;; Sun's bug that swallows newlines.
 206             (goto-char (1+ delimline))
 207             (if (eval mail-mailer-swallows-blank-line)
 208                 (newline))
 209             ;; Find and handle any FCC fields.
 210             (goto-char (point-min))
 211             (if (re-search-forward "^FCC:" delimline t)
 212                 (mail-do-fcc delimline))
 213             (if mail-interactive
 214                 (save-excursion
 215                   (set-buffer errbuf)
 216                   (erase-buffer))))
 217           ;;
 218           ;;
 219           ;;
 220           (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
 221           (setq smtpmail-recipient-address-list
 222                     (smtpmail-deduce-address-list tembuf (point-min) delimline))
 223           (kill-buffer smtpmail-address-buffer)
 224
 225           (smtpmail-do-bcc delimline)
 226           ; Send or queue
 227           (if (not smtpmail-queue-mail)
 228               (if (not (null smtpmail-recipient-address-list))
 229                   (if (not (smtpmail-via-smtp
 230                             smtpmail-recipient-address-list tembuf))
 231                       (error "Sending failed; SMTP protocol error"))
 232                 (error "Sending failed; no recipients"))
 233             (let* ((file-data (concat
 234                                smtpmail-queue-dir
 235                                (concat (time-stamp-yyyy-mm-dd)
 236                                        "_" (time-stamp-hh:mm:ss))))
 237                    (file-elisp (concat file-data ".el"))
 238                    (buffer-data (create-file-buffer file-data))
 239                    (buffer-elisp (create-file-buffer file-elisp))
 240                    (buffer-scratch "*queue-mail*"))
 241               (save-excursion
 242                 (set-buffer buffer-data)
 243                 (erase-buffer)
 244                 (insert-buffer tembuf)
 245                 (write-file file-data)
 246                 (set-buffer buffer-elisp)
 247                 (erase-buffer)
 248                 (insert (concat
 249                          "(setq smtpmail-recipient-address-list '"
 250                          (prin1-to-string smtpmail-recipient-address-list)
 251                          ")\n"))
 252                 (write-file file-elisp)
 253                 (set-buffer (generate-new-buffer buffer-scratch))
 254                 (insert (concat file-data "\n"))
 255                 (append-to-file (point-min)
 256                                 (point-max)
 257                                 smtpmail-queue-index)
 258                 )
 259               (kill-buffer buffer-scratch)
 260               (kill-buffer buffer-data)
 261               (kill-buffer buffer-elisp))))
 262       (kill-buffer tembuf)
 263       (if (bufferp errbuf)
 264           (kill-buffer errbuf)))))
 265
 266 (defun smtpmail-send-queued-mail ()
 267   "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
 268   (interactive)
 269   ;;; Get index, get first mail, send it, get second mail, etc...
 270   (let ((buffer-index (find-file-noselect smtpmail-queue-index))
 271         (file-msg "")
 272         (tembuf nil))
 273     (save-excursion
 274       (set-buffer buffer-index)
 275       (beginning-of-buffer)
 276       (while (not (eobp))
 277         (setq file-msg (buffer-substring (point) (save-excursion
 278                                                    (end-of-line)
 279                                                    (point))))
 280         (load file-msg)
 281         (setq tembuf (find-file-noselect file-msg))
 282         (if (not (null smtpmail-recipient-address-list))
 283             (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
 284                                         tembuf))
 285                 (error "Sending failed; SMTP protocol error"))
 286           (error "Sending failed; no recipients"))
 287         (delete-file file-msg)
 288         (delete-file (concat file-msg ".el"))
 289         (kill-buffer tembuf)
 290         (kill-line 1))
 291       (set-buffer buffer-index)
 292       (save-buffer smtpmail-queue-index)
 293       (kill-buffer buffer-index)
 294       )))
 295
 296 ;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
 297
 298 (defun smtpmail-fqdn ()
 299   (if smtpmail-local-domain
 300       (concat (system-name) "." smtpmail-local-domain)
 301     (system-name)))
 302
 303 (defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
 304   (let ((process nil)
 305         (host smtpmail-smtp-server)
 306         (port smtpmail-smtp-service)
 307         response-code
 308         greeting
 309         process-buffer
 310         (supported-extensions '()))
 311     (unwind-protect
 312         (catch 'done
 313           ;; get or create the trace buffer
 314           (setq process-buffer
 315                 (get-buffer-create (format "*trace of SMTP session to %s*" host)))
 316
 317           ;; clear the trace buffer of old output
 318           (save-excursion
 319             (set-buffer process-buffer)
 320             (erase-buffer))
 321
 322           ;; open the connection to the server
 323           (setq process (open-network-stream "SMTP" process-buffer host port))
 324           (and (null process) (throw 'done nil))
 325
 326           ;; set the send-filter
 327           (set-process-filter process 'smtpmail-process-filter)
 328
 329           (save-excursion
 330             (set-buffer process-buffer)
 331             (make-local-variable 'smtpmail-read-point)
 332             (setq smtpmail-read-point (point-min))
 333
 334
 335             (if (or (null (car (setq greeting (smtpmail-read-response process))))
 336                     (not (integerp (car greeting)))
 337                     (>= (car greeting) 400))
 338                 (throw 'done nil)
 339               )
 340
 341             ;; EHLO
 342             (smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn)))
 343
 344             (if (or (null (car (setq response-code (smtpmail-read-response process))))
 345                     (not (integerp (car response-code)))
 346                     (>= (car response-code) 400))
 347                 (progn
 348                   ;; HELO
 349                   (smtpmail-send-command process (format "HELO %s" (smtpmail-fqdn)))
 350
 351                   (if (or (null (car (setq response-code (smtpmail-read-response process))))
 352                           (not (integerp (car response-code)))
 353                           (>= (car response-code) 400))
 354                       (throw 'done nil)))
 355               (let ((extension-lines (cdr (cdr response-code))))
 356                 (while extension-lines
 357                   (let ((name (intern (downcase (substring (car extension-lines) 4)))))
 358                     (and name
 359                          (cond ((memq name '(verb xvrb 8bitmime onex xone
 360                                                   expn size dsn etrn
 361                                                   help xusr))
 362                                 (setq supported-extensions
 363                                       (cons name supported-extensions)))
 364                                (t (message "unknown extension %s"
 365                                            name)))))
 366                   (setq extension-lines (cdr extension-lines)))))
 367
 368             (if (or (member 'onex supported-extensions)
 369                     (member 'xone supported-extensions))
 370                 (progn
 371                   (smtpmail-send-command process (format "ONEX"))
 372                   (if (or (null (car (setq response-code (smtpmail-read-response process))))
 373                           (not (integerp (car response-code)))
 374                           (>= (car response-code) 400))
 375                       (throw 'done nil))))
 376
 377             (if (and smtpmail-debug-info
 378                      (or (member 'verb supported-extensions)
 379                          (member 'xvrb supported-extensions)))
 380                 (progn
 381                   (smtpmail-send-command process (format "VERB"))
 382                   (if (or (null (car (setq response-code (smtpmail-read-response process))))
 383                           (not (integerp (car response-code)))
 384                           (>= (car response-code) 400))
 385                       (throw 'done nil))))
 386
 387             (if (member 'xusr supported-extensions)
 388                 (progn
 389                   (smtpmail-send-command process (format "XUSR"))
 390                   (if (or (null (car (setq response-code (smtpmail-read-response process))))
 391                           (not (integerp (car response-code)))
 392                           (>= (car response-code) 400))
 393                       (throw 'done nil))))
 394
 395             ;; MAIL FROM: <sender>
 396             (let ((size-part
 397                    (if (member 'size supported-extensions)
 398                        (format " SIZE=%d"
 399                                (save-excursion
 400                                  (set-buffer smtpmail-text-buffer)
 401                                  ;; size estimate:
 402                                  (+ (- (point-max) (point-min))
 403                                     ;; Add one byte for each change-of-line
 404                                     ;; because or CR-LF representation:
 405                                     (count-lines (point-min) (point-max))
 406                                     ;; For some reason, an empty line is
 407                                     ;; added to the message.  Maybe this
 408                                     ;; is a bug, but it can't hurt to add
 409                                     ;; those two bytes anyway:
 410                                     2)))
 411                      ""))
 412                   (body-part
 413                    (if (member '8bitmime supported-extensions)
 414                        ;; FIXME:
 415                        ;; Code should be added here that transforms
 416                        ;; the contents of the message buffer into
 417                        ;; something the receiving SMTP can handle.
 418                        ;; For a receiver that supports 8BITMIME, this
 419                        ;; may mean converting BINARY to BASE64, or
 420                        ;; adding Content-Transfer-Encoding and the
 421                        ;; other MIME headers.  The code should also
 422                        ;; return an indication of what encoding the
 423                        ;; message buffer is now, i.e. ASCII or
 424                        ;; 8BITMIME.
 425                        (if nil
 426                            " BODY=8BITMIME"
 427                          "")
 428                      "")))
 429 ;             (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
 430               (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s"
 431                                                      user-mail-address
 432                                                      size-part
 433                                                      body-part))
 434
 435               (if (or (null (car (setq response-code (smtpmail-read-response process))))
 436                       (not (integerp (car response-code)))
 437                       (>= (car response-code) 400))
 438                   (throw 'done nil)
 439                 ))
 440
 441             ;; RCPT TO: <recipient>
 442             (let ((n 0))
 443               (while (not (null (nth n recipient)))
 444                 (smtpmail-send-command process (format "RCPT TO: <%s>" (nth n recipient)))
 445                 (setq n (1+ n))
 446
 447                 (setq response-code (smtpmail-read-response process))
 448                 (if (or (null (car response-code))
 449                         (not (integerp (car response-code)))
 450                         (>= (car response-code) 400))
 451                     (throw 'done nil)
 452                   )
 453                 ))
 454
 455             ;; DATA
 456             (smtpmail-send-command process "DATA")
 457
 458             (if (or (null (car (setq response-code (smtpmail-read-response process))))
 459                     (not (integerp (car response-code)))
 460                     (>= (car response-code) 400))
 461                 (throw 'done nil)
 462               )
 463
 464             ;; Mail contents
 465             (smtpmail-send-data process smtpmail-text-buffer)
 466
 467             ;;DATA end "."
 468             (smtpmail-send-command process ".")
 469
 470             (if (or (null (car (setq response-code (smtpmail-read-response process))))
 471                     (not (integerp (car response-code)))
 472                     (>= (car response-code) 400))
 473                 (throw 'done nil)
 474               )
 475
 476             ;;QUIT
 477 ;           (smtpmail-send-command process "QUIT")
 478 ;           (and (null (car (smtpmail-read-response process)))
 479 ;                (throw 'done nil))
 480             t ))
 481       (if process
 482           (save-excursion
 483             (set-buffer (process-buffer process))
 484             (smtpmail-send-command process "QUIT")
 485             (smtpmail-read-response process)
 486
 487 ;           (if (or (null (car (setq response-code (smtpmail-read-response process))))
 488 ;                   (not (integerp (car response-code)))
 489 ;                   (>= (car response-code) 400))
 490 ;               (throw 'done nil)
 491 ;             )
 492             (delete-process process))))))
 493
 494
 495 (defun smtpmail-process-filter (process output)
 496   (save-excursion
 497     (set-buffer (process-buffer process))
 498     (goto-char (point-max))
 499     (insert output)))
 500
 501 (defun smtpmail-read-response (process)
 502   (let ((case-fold-search nil)
 503         (response-strings nil)
 504         (response-continue t)
 505         (return-value '(nil ()))
 506         match-end)
 507
 508     (while response-continue
 509       (goto-char smtpmail-read-point)
 510       (while (not (search-forward "\r\n" nil t))
 511         (accept-process-output process)
 512         (goto-char smtpmail-read-point))
 513
 514       (setq match-end (point))
 515       (setq response-strings
 516             (cons (buffer-substring smtpmail-read-point (- match-end 2))
 517                   response-strings))
 518
 519       (goto-char smtpmail-read-point)
 520       (if (looking-at "[0-9]+ ")
 521           (let ((begin (match-beginning 0))
 522                 (end (match-end 0)))
 523             (if smtpmail-debug-info
 524                 (message "%s" (car response-strings)))
 525
 526             (setq smtpmail-read-point match-end)
 527
 528             ;; ignore lines that start with "0"
 529             (if (looking-at "0[0-9]+ ")
 530                 nil
 531               (setq response-continue nil)
 532               (setq return-value
 533                     (cons (string-to-int
 534                            (buffer-substring begin end))
 535                           (nreverse response-strings)))))
 536
 537         (if (looking-at "[0-9]+-")
 538             (progn (if smtpmail-debug-info
 539                      (message "%s" (car response-strings)))
 540                    (setq smtpmail-read-point match-end)
 541                    (setq response-continue t))
 542           (progn
 543             (setq smtpmail-read-point match-end)
 544             (setq response-continue nil)
 545             (setq return-value
 546                   (cons nil (nreverse response-strings)))
 547             )
 548           )))
 549     (setq smtpmail-read-point match-end)
 550     return-value))
 551
 552
 553 (defun smtpmail-send-command (process command)
 554   (goto-char (point-max))
 555   (if (= (aref command 0) ?P)
 556       (insert "PASS <omitted>\r\n")
 557     (insert command "\r\n"))
 558   (setq smtpmail-read-point (point))
 559   (process-send-string process command)
 560   (process-send-string process "\r\n"))
 561
 562 (defun smtpmail-send-data-1 (process data)
 563   (goto-char (point-max))
 564
 565   (if (not (null smtpmail-code-conv-from))
 566       (setq data (code-convert-string data smtpmail-code-conv-from *internal*)))
 567
 568   (if smtpmail-debug-info
 569       (insert data "\r\n"))
 570
 571   (setq smtpmail-read-point (point))
 572   ;; Escape "." at start of a line
 573   (if (eq (string-to-char data) ?.)
 574       (process-send-string process "."))
 575   (process-send-string process data)
 576   (process-send-string process "\r\n")
 577   )
 578
 579 (defun smtpmail-send-data (process buffer)
 580   (let
 581       ((data-continue t)
 582        (sending-data nil)
 583        this-line
 584        this-line-end)
 585
 586     (save-excursion
 587       (set-buffer buffer)
 588       (goto-char (point-min)))
 589
 590     (while data-continue
 591       (save-excursion
 592         (set-buffer buffer)
 593         (beginning-of-line)
 594         (setq this-line (point))
 595         (end-of-line)
 596         (setq this-line-end (point))
 597         (setq sending-data nil)
 598         (setq sending-data (buffer-substring this-line this-line-end))
 599         (if (/= (forward-line 1) 0)
 600             (setq data-continue nil)))
 601
 602       (smtpmail-send-data-1 process sending-data)
 603       )
 604     )
 605   )
 606
 607
 608 (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
 609   "Get address list suitable for smtp RCPT TO: <address>."
 610   (require 'mail-utils)  ;; pick up mail-strip-quoted-names
 611   (let
 612       ((case-fold-search t)
 613        (simple-address-list "")
 614        this-line
 615        this-line-end
 616        addr-regexp)
 617
 618     (unwind-protect
 619         (save-excursion
 620           ;;
 621           (set-buffer smtpmail-address-buffer) (erase-buffer)
 622           (insert-buffer-substring smtpmail-text-buffer header-start header-end)
 623           (goto-char (point-min))
 624           ;; RESENT-* fields should stop processing of regular fields.
 625           (save-excursion
 626             (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" header-end t)
 627                 (setq addr-regexp "^Resent-\\(to\\|cc\\|bcc\\):")
 628               (setq addr-regexp  "^\\(To:\\|Cc:\\|Bcc:\\)")))
 629
 630           (while (re-search-forward addr-regexp header-end t)
 631             (replace-match "")
 632             (setq this-line (match-beginning 0))
 633             (forward-line 1)
 634             ;; get any continuation lines
 635             (while (and (looking-at "^[ \t]+") (< (point) header-end))
 636               (forward-line 1))
 637             (setq this-line-end (point-marker))
 638             (setq simple-address-list
 639                   (concat simple-address-list " "
 640                           (mail-strip-quoted-names (buffer-substring this-line this-line-end))))
 641             )
 642           (erase-buffer)
 643           (insert-string " ")
 644           (insert-string simple-address-list)
 645           (insert-string "\n")
 646           (subst-char-in-region (point-min) (point-max) 10 ?  t);; newline --> blank
 647           (subst-char-in-region (point-min) (point-max) ?, ?  t);; comma   --> blank
 648           (subst-char-in-region (point-min) (point-max)  9 ?  t);; tab     --> blank
 649
 650           (goto-char (point-min))
 651           ;; tidyness in case hook is not robust when it looks at this
 652           (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
 653
 654           (goto-char (point-min))
 655           (let (recipient-address-list)
 656             (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
 657               (backward-char 1)
 658               (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
 659                                                  recipient-address-list))
 660               )
 661             (setq smtpmail-recipient-address-list recipient-address-list))
 662
 663           )
 664       )
 665     )
 666   )
 667
 668
 669 (defun smtpmail-do-bcc (header-end)
 670   "Delete [Resent-]BCC: and their continuation lines from the header area.
 671 There may be multiple BCC: lines, and each may have arbitrarily
 672 many continuation lines."
 673   (let ((case-fold-search t))
 674         (save-excursion (goto-char (point-min))
 675           ;; iterate over all BCC: lines
 676           (while (re-search-forward "^\(RESENT-\)?BCC:" header-end t)
 677                 (delete-region (match-beginning 0) (progn (forward-line 1) (point)))
 678                 ;; get rid of any continuation lines
 679                 (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
 680                   (replace-match ""))
 681                 )
 682           ) ;; save-excursion
 683         ) ;; let
 684   )
 685
 686
 687
 688 (provide 'smtpmail)
 689
 690 ;;; smtpmail.el ends here