mail/smtpmail.el

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