smtp.el

   1 ;;; smtp.el --- basic functions to send mail with SMTP server
   2
   3 ;; Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
   6 ;;      Simon Leinen <simon@switch.ch> (ESMTP support)
   7 ;;      Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
   8 ;;      Daiki Ueno <ueno@unixuser.org>
   9 ;; Keywords: SMTP, mail
  10
  11 ;; This file is part of FLIM (Faithful Library about Internet Message).
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28
  29 ;;; Commentary:
  30 ;;
  31
  32 ;;; Code:
  33
  34 (require 'custom)
  35 (require 'mail-utils)                   ; mail-strip-quoted-names
  36 (require 'sasl)
  37 (require 'luna)
  38 (require 'mel) ; binary-funcall
  39
  40 (defgroup smtp nil
  41   "SMTP protocol for sending mail."
  42   :group 'mail)
  43
  44 (defgroup smtp-extensions nil
  45   "SMTP service extensions (RFC1869)."
  46   :group 'smtp)
  47
  48 (defcustom smtp-default-server nil
  49   "Specify default SMTP server."
  50   :type '(choice (const nil) string)
  51   :group 'smtp)
  52
  53 (defcustom smtp-server (or (getenv "SMTPSERVER") smtp-default-server)
  54   "The name of the host running SMTP server.
  55 It can also be a function
  56 called from `smtp-via-smtp' with arguments SENDER and RECIPIENTS."
  57   :type '(choice (string :tag "Name")
  58                  (function :tag "Function"))
  59   :group 'smtp)
  60
  61 (defcustom smtp-service "smtp"
  62   "SMTP service port number.  \"smtp\" or 25."
  63   :type '(choice (integer :tag "25" 25)
  64                  (string :tag "smtp" "smtp"))
  65   :group 'smtp)
  66
  67 (defcustom smtp-local-domain nil
  68   "Local domain name without a host name.
  69 If the function (system-name) returns the full internet address,
  70 don't define this value."
  71   :type '(choice (const nil) string)
  72   :group 'smtp)
  73
  74 (defcustom smtp-fqdn nil
  75   "Fully qualified domain name used for Message-ID."
  76   :type '(choice (const nil) string)
  77   :group 'smtp)
  78
  79 (defcustom smtp-use-8bitmime t
  80   "If non-nil, use ESMTP 8BITMIME (RFC1652) if available."
  81   :type 'boolean
  82   :group 'smtp-extensions)
  83
  84 (defcustom smtp-use-size t
  85   "If non-nil, use ESMTP SIZE (RFC1870) if available."
  86   :type 'boolean
  87   :group 'smtp-extensions)
  88
  89 (defcustom smtp-use-starttls nil
  90   "If non-nil, use STARTTLS (RFC2595) if available."
  91   :type 'boolean
  92   :group 'smtp-extensions)
  93
  94 (defcustom smtp-use-sasl nil
  95   "If non-nil, use SMTP Authentication (RFC2554) if available."
  96   :type 'boolean
  97   :group 'smtp-extensions)
  98
  99 (defcustom smtp-sasl-user-name (user-login-name)
 100   "Identification to be used for authorization."
 101   :type 'string
 102   :group 'smtp-extensions)
 103
 104 (defcustom smtp-sasl-properties nil
 105   "Properties set to SASL client."
 106   :type 'string
 107   :group 'smtp-extensions)
 108
 109 (defcustom smtp-sasl-mechanisms nil
 110   "List of authentication mechanisms."
 111   :type '(repeat string)
 112   :group 'smtp-extensions)
 113
 114 (defvar sasl-mechanisms)
 115
 116 ;;;###autoload
 117 (defvar smtp-open-connection-function #'open-network-stream
 118   "*Function used for connecting to a SMTP server.
 119 The function will be called with the same four arguments as
 120 `open-network-stream' and should return a process object.
 121 Here is an example:
 122
 123 \(setq smtp-open-connection-function
 124       #'(lambda (name buffer host service)
 125           (let ((process-connection-type nil))
 126             (start-process name buffer \"ssh\" \"-C\" host
 127                            \"nc\" host service))))
 128
 129 It connects to a SMTP server using \"ssh\" before actually connecting
 130 to the SMTP port.  Where the command \"nc\" is the netcat executable;
 131 see http://www.atstake.com/research/tools/index.html#network_utilities
 132 for details.  In addition, you will have to modify the value for
 133 `smtp-end-of-line' to \"\\n\" if you use \"telnet\" instead of \"nc\".")
 134
 135 (defvar smtp-read-point nil)
 136
 137 (defvar smtp-connection-alist nil)
 138
 139 (defvar smtp-submit-package-function #'smtp-submit-package)
 140
 141 (defvar smtp-end-of-line "\r\n"
 142   "*String to use as end-of-line marker when talking to a SMTP server.
 143 This is \"\\r\\n\" by default, but it may have to be \"\\n\" when using a non
 144 native connection function.  See also `smtp-open-connection-function'.")
 145
 146 ;;; @ SMTP package
 147 ;;; A package contains a mail message, an envelope sender address,
 148 ;;; and one or more envelope recipient addresses.  In ESMTP model
 149 ;;; the current sending package should be guaranteed to be accessible
 150 ;;; anywhere from the hook methods (or SMTP commands).
 151
 152 (eval-and-compile
 153   (luna-define-class smtp-package ()
 154                      (sender
 155                       recipients
 156                       buffer))
 157
 158   (luna-define-internal-accessors 'smtp-package))
 159
 160 (defun smtp-make-package (sender recipients buffer)
 161   "Create a new package structure.
 162 A package is a unit of SMTP message
 163 SENDER specifies the package sender, a string.
 164 RECIPIENTS is a list of recipients.
 165 BUFFER may be a buffer or a buffer name which contains mail message."
 166   (luna-make-entity 'smtp-package :sender sender :recipients recipients :buffer buffer))
 167
 168 (defun smtp-package-buffer-internal-size (package)
 169   "Return the size of PACKAGE, an integer."
 170   (save-excursion
 171     (set-buffer (smtp-package-buffer-internal package))
 172     (let ((size
 173            (+ (buffer-size)
 174               ;; Add one byte for each change-of-line
 175               ;; because or CR-LF representation:
 176               (count-lines (point-min) (point-max))
 177               ;; For some reason, an empty line is
 178               ;; added to the message.  Maybe this
 179               ;; is a bug, but it can't hurt to add
 180               ;; those two bytes anyway:
 181               2)))
 182       (goto-char (point-min))
 183       (while (re-search-forward "^\\." nil t)
 184         (setq size (1+ size)))
 185       size)))
 186
 187 ;;; @ SMTP connection
 188 ;;; We should consider the function `open-network-stream' is a emulation
 189 ;;; for another network stream.  They are likely to be implemented with an
 190 ;;; external program and the function `process-contact' returns the
 191 ;;; process id instead of `(HOST SERVICE)' pair.
 192
 193 (eval-and-compile
 194   (luna-define-class smtp-connection ()
 195                      (process
 196                       server
 197                       service
 198                       extensions
 199                       encoder
 200                       decoder))
 201
 202   (luna-define-internal-accessors 'smtp-connection))
 203
 204 (defun smtp-make-connection (process server service)
 205   "Create a new connection structure.
 206 PROCESS is an internal subprocess-object.  SERVER is name of the host
 207 to connect to.  SERVICE is name of the service desired."
 208   (luna-make-entity 'smtp-connection :process process :server server :service service))
 209
 210 (luna-define-generic smtp-connection-opened (connection)
 211   "Say whether the CONNECTION to server has been opened.")
 212
 213 (luna-define-generic smtp-close-connection (connection)
 214   "Close the CONNECTION to server.")
 215
 216 (luna-define-method smtp-connection-opened ((connection smtp-connection))
 217   (let ((process (smtp-connection-process-internal connection)))
 218     (if (memq (process-status process) '(open run))
 219         t)))
 220
 221 (luna-define-method smtp-close-connection ((connection smtp-connection))
 222   (let ((process (smtp-connection-process-internal connection)))
 223     (delete-process process)))
 224
 225 (defun smtp-make-fqdn ()
 226   "Return user's fully qualified domain name."
 227   (if smtp-fqdn
 228       smtp-fqdn
 229     (let ((system-name (system-name)))
 230       (cond
 231        (smtp-local-domain
 232         (concat system-name "." smtp-local-domain))
 233        ((string-match "[^.]\\.[^.]" system-name)
 234         system-name)
 235        (t
 236         (error "Cannot generate valid FQDN"))))))
 237
 238 (defun smtp-find-connection (buffer)
 239   "Find the connection delivering to BUFFER."
 240   (let ((entry (assq buffer smtp-connection-alist))
 241         connection)
 242     (when entry
 243       (setq connection (nth 1 entry))
 244       (if (smtp-connection-opened connection)
 245           connection
 246         (setq smtp-connection-alist
 247               (delq entry smtp-connection-alist))
 248         nil))))
 249
 250 (eval-and-compile
 251   (autoload 'starttls-open-stream "starttls")
 252   (autoload 'starttls-negotiate "starttls"))
 253
 254 (defun smtp-open-connection (buffer server service)
 255   "Open a SMTP connection for a service to a host.
 256 Return a newly allocated connection-object.
 257 BUFFER is the buffer to associate with the connection.  SERVER is name
 258 of the host to connect to.  SERVICE is name of the service desired."
 259   (let ((process
 260          (binary-funcall smtp-open-connection-function
 261                          "SMTP" buffer server service))
 262         connection)
 263     (when process
 264       (setq connection (smtp-make-connection process server service))
 265       (set-process-filter process 'smtp-process-filter)
 266       (setq smtp-connection-alist
 267             (cons (list buffer connection)
 268                   smtp-connection-alist))
 269       connection)))
 270
 271 ;;;###autoload
 272 (defun smtp-via-smtp (sender recipients buffer)
 273   "Like `smtp-send-buffer', but sucks in any errors."
 274   (condition-case nil
 275       (progn
 276         (smtp-send-buffer sender recipients buffer)
 277         t)
 278     (smtp-error)))
 279
 280 (make-obsolete 'smtp-via-smtp "It's old API.")
 281
 282 ;;;###autoload
 283 (defun smtp-send-buffer (sender recipients buffer)
 284   "Send a message.
 285 SENDER is an envelope sender address.
 286 RECIPIENTS is a list of envelope recipient addresses.
 287 BUFFER may be a buffer or a buffer name which contains mail message."
 288   (let ((server
 289          (if (functionp smtp-server)
 290              (funcall smtp-server sender recipients)
 291            smtp-server))
 292         (package
 293          (smtp-make-package sender recipients buffer))
 294         (smtp-open-connection-function
 295          (if smtp-use-starttls
 296              #'starttls-open-stream
 297            smtp-open-connection-function)))
 298     (save-excursion
 299       (set-buffer
 300        (get-buffer-create
 301         (format "*trace of SMTP session to %s*" server)))
 302       (erase-buffer)
 303       (buffer-disable-undo)
 304       (unless (smtp-find-connection (current-buffer))
 305         (smtp-open-connection (current-buffer) server smtp-service))
 306       (make-local-variable 'smtp-read-point)
 307       (setq smtp-read-point (point-min))
 308       (funcall smtp-submit-package-function package))))
 309
 310 (defun smtp-submit-package (package)
 311   (unwind-protect
 312       (progn
 313         (smtp-primitive-greeting package)
 314         (condition-case nil
 315             (smtp-primitive-ehlo package)
 316           (smtp-response-error
 317            (smtp-primitive-helo package)))
 318         (if smtp-use-starttls
 319             (progn
 320               (smtp-primitive-starttls package)
 321               (smtp-primitive-ehlo package)))
 322         (if smtp-use-sasl
 323             (smtp-primitive-auth package))
 324         (smtp-primitive-mailfrom package)
 325         (smtp-primitive-rcptto package)
 326         (smtp-primitive-data package))
 327     (let ((connection (smtp-find-connection (current-buffer))))
 328       (when (smtp-connection-opened connection)
 329         (smtp-primitive-quit package)
 330         (smtp-close-connection connection)))))
 331
 332 ;;; @ hook methods for `smtp-submit-package'
 333 ;;;
 334
 335 (defun smtp-primitive-greeting (package)
 336   (let* ((connection
 337           (smtp-find-connection (current-buffer)))
 338          (response
 339           (smtp-read-response connection)))
 340     (if (/= (car response) 220)
 341         (smtp-response-error response))))
 342
 343 (defun smtp-primitive-ehlo (package)
 344   (let* ((connection
 345           (smtp-find-connection (current-buffer)))
 346          response)
 347     (smtp-send-command connection (format "EHLO %s" (smtp-make-fqdn)))
 348     (setq response (smtp-read-response connection))
 349     (if (/= (car response) 250)
 350         (smtp-response-error response))
 351     (smtp-connection-set-extensions-internal
 352      connection (mapcar
 353                  (lambda (extension)
 354                    (let ((extensions
 355                           (split-string extension)))
 356                      (setcar extensions
 357                              (car (read-from-string
 358                                    (downcase (car extensions)))))
 359                      extensions))
 360                  (cdr response)))))
 361
 362 (defun smtp-primitive-helo (package)
 363   (let* ((connection
 364           (smtp-find-connection (current-buffer)))
 365          response)
 366     (smtp-send-command connection (format "HELO %s" (smtp-make-fqdn)))
 367     (setq response (smtp-read-response connection))
 368     (if (/= (car response) 250)
 369         (smtp-response-error response))))
 370
 371 (defun smtp-primitive-auth (package)
 372   (let* ((connection
 373           (smtp-find-connection (current-buffer)))
 374          (mechanisms
 375           (cdr (assq 'auth (smtp-connection-extensions-internal connection))))
 376          (sasl-mechanisms
 377           (or smtp-sasl-mechanisms sasl-mechanisms))
 378          (mechanism
 379           (sasl-find-mechanism mechanisms))
 380          client
 381          name
 382          step
 383          response)
 384     (unless mechanism
 385       (error "No authentication mechanism available"))
 386     (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp"
 387                                    (smtp-connection-server-internal connection)))
 388     (if smtp-sasl-properties
 389         (sasl-client-set-properties client smtp-sasl-properties))
 390     (setq name (sasl-mechanism-name mechanism)
 391           ;; Retrieve the initial response
 392           step (sasl-next-step client nil))
 393     (smtp-send-command
 394      connection
 395      (if (sasl-step-data step)
 396          (format "AUTH %s %s" name (base64-encode-string (sasl-step-data step) t))
 397        (format "AUTH %s" name)))
 398     (catch 'done
 399       (while t
 400         (setq response (smtp-read-response connection))
 401         (when (= (car response) 235)
 402           ;; The authentication process is finished.
 403           (setq step (sasl-next-step client step))
 404           (if (null step)
 405               (throw 'done nil))
 406           (smtp-response-error response)) ;Bogus server?
 407         (if (/= (car response) 334)
 408             (smtp-response-error response))
 409         (sasl-step-set-data step (base64-decode-string (nth 1 response)))
 410         (setq step (sasl-next-step client step))
 411         (smtp-send-command
 412          connection
 413          (if (sasl-step-data step)
 414              (base64-encode-string (sasl-step-data step) t)
 415            ""))))
 416 ;;;    (smtp-connection-set-encoder-internal
 417 ;;;     connection (sasl-client-encoder client))
 418 ;;;    (smtp-connection-set-decoder-internal
 419 ;;;     connection (sasl-client-decoder client))
 420     ))
 421
 422 (defun smtp-primitive-starttls (package)
 423   (let* ((connection
 424           (smtp-find-connection (current-buffer)))
 425          response)
 426     ;; STARTTLS --- begin a TLS negotiation (RFC 2595)
 427     (smtp-send-command connection "STARTTLS")
 428     (setq response (smtp-read-response connection))
 429     (if (/= (car response) 220)
 430         (smtp-response-error response))
 431     (starttls-negotiate (smtp-connection-process-internal connection))))
 432
 433 (defun smtp-primitive-mailfrom (package)
 434   (let* ((connection
 435           (smtp-find-connection (current-buffer)))
 436          (extensions
 437           (smtp-connection-extensions-internal
 438            connection))
 439          (sender
 440           (smtp-package-sender-internal package))
 441          extension
 442          response)
 443     ;; SIZE --- Message Size Declaration (RFC1870)
 444     (if (and smtp-use-size
 445              (assq 'size extensions))
 446         (setq extension (format "SIZE=%d" (smtp-package-buffer-internal-size package))))
 447     ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652)
 448     (if (and smtp-use-8bitmime
 449              (assq '8bitmime extensions))
 450         (setq extension (concat extension " BODY=8BITMIME")))
 451     (smtp-send-command
 452      connection
 453      (if extension
 454          (format "MAIL FROM:<%s> %s" sender extension)
 455        (format "MAIL FROM:<%s>" sender)))
 456     (setq response (smtp-read-response connection))
 457     (if (/= (car response) 250)
 458         (smtp-response-error response))))
 459
 460 (defun smtp-primitive-rcptto (package)
 461   (let* ((connection
 462           (smtp-find-connection (current-buffer)))
 463          (recipients
 464           (smtp-package-recipients-internal package))
 465          response)
 466     (while recipients
 467       (smtp-send-command
 468        connection (format "RCPT TO:<%s>" (pop recipients)))
 469       (setq response (smtp-read-response connection))
 470       (unless (memq (car response) '(250 251))
 471         (smtp-response-error response)))))
 472
 473 (defun smtp-primitive-data (package)
 474   (let* ((connection
 475           (smtp-find-connection (current-buffer)))
 476          response)
 477     (smtp-send-command connection "DATA")
 478     (setq response (smtp-read-response connection))
 479     (if (/= (car response) 354)
 480         (smtp-response-error response))
 481     (save-excursion
 482       (set-buffer (smtp-package-buffer-internal package))
 483       (goto-char (point-min))
 484       (while (not (eobp))
 485         (smtp-send-data
 486          connection (buffer-substring (point) (progn (end-of-line)(point))))
 487         (beginning-of-line 2)))
 488     (smtp-send-command connection ".")
 489     (setq response (smtp-read-response connection))
 490     (if (/= (car response) 250)
 491         (smtp-response-error response))))
 492
 493 (defun smtp-primitive-quit (package)
 494   (let* ((connection
 495           (smtp-find-connection (current-buffer)))
 496          response)
 497     (smtp-send-command connection "QUIT")
 498     (setq response (smtp-read-response connection))
 499     (if (/= (car response) 221)
 500         (smtp-response-error response))))
 501
 502 ;;; @ low level process manipulating function
 503 ;;;
 504 (defun smtp-process-filter (process output)
 505   (save-excursion
 506     (set-buffer (process-buffer process))
 507     (goto-char (point-max))
 508     (insert output)))
 509
 510 (put 'smtp-error 'error-message "SMTP error")
 511 (put 'smtp-error 'error-conditions '(smtp-error error))
 512
 513 (put 'smtp-response-error 'error-message "SMTP response error")
 514 (put 'smtp-response-error 'error-conditions '(smtp-response-error smtp-error error))
 515
 516 (defun smtp-response-error (response)
 517   (signal 'smtp-response-error response))
 518
 519 (defun smtp-read-response (connection)
 520   (let ((decoder
 521          (smtp-connection-decoder-internal connection))
 522         (response-continue t)
 523         response)
 524     (while response-continue
 525       (goto-char smtp-read-point)
 526       (while (not (search-forward smtp-end-of-line nil t))
 527         (accept-process-output (smtp-connection-process-internal connection))
 528         (goto-char smtp-read-point))
 529       (if decoder
 530           (let ((string (buffer-substring smtp-read-point (- (point) 2))))
 531             (delete-region smtp-read-point (point))
 532             (insert (funcall decoder string) smtp-end-of-line)))
 533       (setq response
 534             (nconc response
 535                    (list (buffer-substring
 536                           (+ 4 smtp-read-point)
 537                           (- (point) 2)))))
 538       (goto-char
 539        (prog1 smtp-read-point
 540          (setq smtp-read-point (point))))
 541       (if (looking-at "[1-5][0-9][0-9] ")
 542           (setq response (cons (read (point-marker)) response)
 543                 response-continue nil)))
 544     response))
 545
 546 (defun smtp-send-command (connection command)
 547   (save-excursion
 548     (let ((process
 549            (smtp-connection-process-internal connection))
 550           (encoder
 551            (smtp-connection-encoder-internal connection)))
 552       (set-buffer (process-buffer process))
 553       (goto-char (point-max))
 554       (setq command (concat command smtp-end-of-line))
 555       (insert command)
 556       (setq smtp-read-point (point))
 557       (if encoder
 558           (setq command (funcall encoder command)))
 559       (process-send-string process command))))
 560
 561 (defun smtp-send-data (connection data)
 562   (let ((process
 563          (smtp-connection-process-internal connection))
 564         (encoder
 565          (smtp-connection-encoder-internal connection)))
 566     ;; Escape "." at start of a line.
 567     (if (eq (string-to-char data) ?.)
 568         (setq data (concat "." data smtp-end-of-line))
 569       (setq data (concat data smtp-end-of-line)))
 570     (if encoder
 571         (setq data (funcall encoder data)))
 572     (process-send-string process data)))
 573
 574 (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
 575   "Get address list suitable for smtp RCPT TO:<address>."
 576   (let ((simple-address-list "")
 577         this-line
 578         this-line-end
 579         addr-regexp
 580         (smtp-address-buffer (generate-new-buffer " *smtp-mail*")))
 581     (unwind-protect
 582         (save-excursion
 583           ;;
 584           (set-buffer smtp-address-buffer)
 585           (setq case-fold-search t)
 586           (erase-buffer)
 587           (insert (save-excursion
 588                     (set-buffer smtp-text-buffer)
 589                     (buffer-substring-no-properties header-start header-end)))
 590           (goto-char (point-min))
 591           ;; RESENT-* fields should stop processing of regular fields.
 592           (save-excursion
 593             (if (re-search-forward "^RESENT-TO:" header-end t)
 594                 (setq addr-regexp
 595                       "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)")
 596               (setq addr-regexp  "^\\(TO:\\|CC:\\|BCC:\\)")))
 597
 598           (while (re-search-forward addr-regexp header-end t)
 599             (replace-match "")
 600             (setq this-line (match-beginning 0))
 601             (forward-line 1)
 602             ;; get any continuation lines.
 603             (while (and (looking-at "^[ \t]+") (< (point) header-end))
 604               (forward-line 1))
 605             (setq this-line-end (point-marker))
 606             (setq simple-address-list
 607                   (concat simple-address-list " "
 608                           (mail-strip-quoted-names
 609                            (buffer-substring this-line this-line-end)))))
 610           (erase-buffer)
 611           (insert-string " ")
 612           (insert-string simple-address-list)
 613           (insert-string "\n")
 614           ;; newline --> blank
 615           (subst-char-in-region (point-min) (point-max) 10 ?  t)
 616           ;; comma   --> blank
 617           (subst-char-in-region (point-min) (point-max) ?, ?  t)
 618           ;; tab     --> blank
 619           (subst-char-in-region (point-min) (point-max)  9 ?  t)
 620
 621           (goto-char (point-min))
 622           ;; tidyness in case hook is not robust when it looks at this
 623           (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
 624
 625           (goto-char (point-min))
 626           (let (recipient-address-list)
 627             (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
 628               (backward-char 1)
 629               (setq recipient-address-list
 630                     (cons (buffer-substring (match-beginning 1) (match-end 1))
 631                           recipient-address-list)))
 632             recipient-address-list))
 633       (kill-buffer smtp-address-buffer))))
 634
 635 (provide 'smtp)
 636
 637 ;;; smtp.el ends here