mail/smtpmail.el

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