smtp.el

   1 ;;; smtp.el --- basic functions to send mail with SMTP server
   2
   3 ;; Copyright (C) 1995, 1996, 1998, 1999 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 ;;      Kenichi OKADA <okada@opaopa.org> (SASL support)
   9 ;;      Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
  10 ;; Maintainer: Kenichi OKADA <okada@opaopa.org>
  11 ;; Keywords: SMTP, mail, SASL
  12
  13 ;; This file is part of FLIM (Faithful Library about Internet Message).
  14
  15 ;; This program is free software; you can redistribute it and/or
  16 ;; modify it under the terms of the GNU General Public License as
  17 ;; published by the Free Software Foundation; either version 2, or (at
  18 ;; your option) any later version.
  19
  20 ;; This program is distributed in the hope that it will be useful, but
  21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23 ;; General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with this program; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  28 ;; Boston, MA 02111-1307, USA.
  29
  30 ;;; Code:
  31
  32 (require 'poe)
  33 (require 'poem)
  34 (require 'pcustom)
  35 (require 'mail-utils)                   ; mail-strip-quoted-names
  36
  37 (eval-and-compile
  38   (autoload 'starttls-open-stream "starttls")
  39   (autoload 'starttls-negotiate "starttls")
  40   (autoload 'sasl-cram-md5 "sasl")
  41   (autoload 'sasl-plain "sasl"))
  42
  43 (eval-when-compile (require 'cl))       ; push
  44
  45 (defgroup smtp nil
  46   "SMTP protocol for sending mail."
  47   :group 'mail)
  48
  49 (defcustom smtp-default-server nil
  50   "*Specify default SMTP server."
  51   :type '(choice (const nil) string)
  52   :group 'smtp)
  53
  54 (defcustom smtp-server (or (getenv "SMTPSERVER") smtp-default-server)
  55   "*The name of the host running SMTP server.  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-use-8bitmime t
  68   "*If non-nil, use ESMTP 8BITMIME if available."
  69   :type 'boolean
  70   :group 'smtp)
  71
  72 (defcustom smtp-local-domain nil
  73   "*Local domain name without a host name.
  74 If the function (system-name) returns the full internet address,
  75 don't define this value."
  76   :type '(choice (const nil) string)
  77   :group 'smtp)
  78
  79 (defcustom smtp-debug-info nil
  80   "*smtp debug info printout. messages and process buffer."
  81   :type 'boolean
  82   :group 'smtp)
  83
  84 (defcustom smtp-notify-success nil
  85   "*If non-nil, notification for successful mail delivery is returned
  86  to user (RFC1891)."
  87   :type 'boolean
  88   :group 'smtp)
  89
  90 (defcustom smtp-authentication-type nil
  91   "*SMTP authentication mechanism (RFC2554)."
  92   :type 'symbol
  93   :group 'smtp)
  94
  95 (defvar smtp-authentication-user nil)
  96 (defvar smtp-authentication-passphrase nil)
  97
  98 (defvar smtp-authentication-method-alist
  99   '((cram-md5 smtp-auth-cram-md5)
 100     (plain smtp-auth-plain)
 101     (login smtp-auth-login)
 102     (anonymous smtp-auth-anonymous)
 103     (scram-md5 smtp-auth-scram-md5)
 104     ))
 105
 106 (defcustom smtp-connection-type nil
 107   "*SMTP connection type."
 108   :type '(choice (const nil) (const :tag "TLS" starttls))
 109   :group 'smtp)
 110
 111 (defvar smtp-read-point nil)
 112
 113 (defun smtp-make-fqdn ()
 114   "Return user's fully qualified domain name."
 115   (let ((system-name (system-name)))
 116     (cond
 117      (smtp-local-domain
 118       (concat system-name "." smtp-local-domain))
 119      ((string-match "[^.]\\.[^.]" system-name)
 120       system-name)
 121      (t
 122       (error "Cannot generate valid FQDN. Set `smtp-local-domain' correctly.")))))
 123
 124 (defun smtp-via-smtp (sender recipients smtp-text-buffer)
 125   (let ((server (if (functionp smtp-server)
 126                     (funcall smtp-server sender recipients)
 127                   smtp-server))
 128         process response extensions)
 129     (save-excursion
 130       (set-buffer
 131        (get-buffer-create
 132         (format "*trace of SMTP session to %s*" server)))
 133       (erase-buffer)
 134       (make-local-variable 'smtp-read-point)
 135       (setq smtp-read-point (point-min))
 136
 137       (unwind-protect
 138           (catch 'done
 139             (setq process
 140                   (if smtp-connection-type
 141                       (as-binary-process
 142                        (starttls-open-stream
 143                         "SMTP" (current-buffer) server smtp-service))
 144                     (open-network-stream-as-binary
 145                      "SMTP" (current-buffer) server smtp-service)))
 146
 147             (set-process-filter process 'smtp-process-filter)
 148
 149             (if (eq smtp-connection-type 'force)
 150                 (starttls-negotiate process))
 151
 152             ;; Greeting
 153             (setq response (smtp-read-response process))
 154             (if (or (null (car response))
 155                     (not (integerp (car response)))
 156                     (>= (car response) 400))
 157                 (throw 'done (car (cdr response))))
 158
 159             ;; EHLO
 160             (smtp-send-command process
 161                                (format "EHLO %s" (smtp-make-fqdn)))
 162             (setq response (smtp-read-response process))
 163             (if (or (null (car response))
 164                     (not (integerp (car response)))
 165                     (>= (car response) 400))
 166                 (progn
 167                   ;; HELO
 168                   (smtp-send-command process
 169                                      (format "HELO %s" (smtp-make-fqdn)))
 170                   (setq response (smtp-read-response process))
 171                   (if (or (null (car response))
 172                           (not (integerp (car response)))
 173                           (>= (car response) 400))
 174                       (throw 'done (car (cdr response)))))
 175               (let ((extension-lines (cdr (cdr response)))
 176                     extension)
 177                 (while extension-lines
 178                   (if (string-match
 179                        "^auth "
 180                        (setq extension
 181                              (downcase (substring (car extension-lines) 4))))
 182                       (while (string-match "\\([^ ]+\\)" extension (match-end 1))
 183                         (push (intern (match-string 1 extension)) extensions))
 184                     (push (intern extension) extensions))
 185                   (setq extension-lines (cdr extension-lines)))))
 186
 187             ;; STARTTLS --- begin a TLS negotiation (RFC 2595)
 188             (when (and smtp-connection-type
 189                        (null (eq smtp-connection-type 'force))
 190                        (memq 'starttls extensions))
 191               (smtp-send-command process "STARTTLS")
 192               (setq response (smtp-read-response process))
 193               (if (or (null (car response))
 194                       (not (integerp (car response)))
 195                       (>= (car response) 400))
 196                   (throw 'done (car (cdr response))))
 197               (starttls-negotiate process))
 198
 199             ;; AUTH --- SMTP Service Extension for Authentication (RFC2554)
 200             (when smtp-authentication-type
 201               (let ((auth (intern smtp-authentication-type)) method)
 202                 (if (and
 203                      (memq auth extensions)
 204                      (setq method (nth 1 (assq auth smtp-authentication-method-alist))))
 205                     (funcall method process)
 206                   (throw 'smtp-error
 207                          (format "AUTH mechanism %s not available" auth)))))
 208
 209             ;; ONEX --- One message transaction only (sendmail extension?)
 210 ;;;         (if (or (memq 'onex extensions)
 211 ;;;                 (memq 'xone extensions))
 212 ;;;             (progn
 213 ;;;               (smtp-send-command process "ONEX")
 214 ;;;               (setq response (smtp-read-response process))
 215 ;;;               (if (or (null (car response))
 216 ;;;                       (not (integerp (car response)))
 217 ;;;                       (>= (car response) 400))
 218 ;;;                   (throw 'done (car (cdr response))))))
 219
 220             ;; VERB --- Verbose (sendmail extension?)
 221 ;;;         (if (and smtp-debug-info
 222 ;;;                  (or (memq 'verb extensions)
 223 ;;;                      (memq 'xvrb extensions)))
 224 ;;;             (progn
 225 ;;;               (smtp-send-command process "VERB")
 226 ;;;               (setq response (smtp-read-response process))
 227 ;;;               (if (or (null (car response))
 228 ;;;                       (not (integerp (car response)))
 229 ;;;                       (>= (car response) 400))
 230 ;;;                   (throw 'done (car (cdr response))))))
 231
 232             ;; XUSR --- Initial (user) submission (sendmail extension?)
 233 ;;;         (if (memq 'xusr extensions)
 234 ;;;             (progn
 235 ;;;               (smtp-send-command process "XUSR")
 236 ;;;               (setq response (smtp-read-response process))
 237 ;;;               (if (or (null (car response))
 238 ;;;                       (not (integerp (car response)))
 239 ;;;                       (>= (car response) 400))
 240 ;;;                   (throw 'done (car (cdr response))))))
 241
 242             ;; MAIL FROM:<sender>
 243             (smtp-send-command
 244              process
 245              (format "MAIL FROM:<%s>%s%s"
 246                      sender
 247                      ;; SIZE --- Message Size Declaration (RFC1870)
 248                      (if (memq 'size extensions)
 249                          (format " SIZE=%d"
 250                                  (save-excursion
 251                                    (set-buffer smtp-text-buffer)
 252                                    (+ (- (point-max) (point-min))
 253                                       ;; Add one byte for each change-of-line
 254                                       ;; because or CR-LF representation:
 255                                       (count-lines (point-min) (point-max))
 256                                       ;; For some reason, an empty line is
 257                                       ;; added to the message.  Maybe this
 258                                       ;; is a bug, but it can't hurt to add
 259                                       ;; those two bytes anyway:
 260                                       2)))
 261                        "")
 262                      ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652)
 263                      (if (and (memq '8bitmime extensions)
 264                               smtp-use-8bitmime)
 265                          " BODY=8BITMIME"
 266                        "")))
 267             (setq response (smtp-read-response process))
 268             (if (or (null (car response))
 269                     (not (integerp (car response)))
 270                     (>= (car response) 400))
 271                 (throw 'done (car (cdr response))))
 272
 273             ;; RCPT TO:<recipient>
 274             (while recipients
 275               (smtp-send-command process
 276                                  (format
 277                                   (if smtp-notify-success
 278                                       "RCPT TO:<%s> NOTIFY=SUCCESS"
 279                                     "RCPT TO:<%s>")
 280                                   (car recipients)))
 281               (setq recipients (cdr recipients))
 282               (setq response (smtp-read-response process))
 283               (if (or (null (car response))
 284                       (not (integerp (car response)))
 285                       (>= (car response) 400))
 286                   (throw 'done (car (cdr response)))))
 287
 288             ;; DATA
 289             (smtp-send-command process "DATA")
 290             (setq response (smtp-read-response process))
 291             (if (or (null (car response))
 292                     (not (integerp (car response)))
 293                     (>= (car response) 400))
 294                 (throw 'done (car (cdr response))))
 295
 296             ;; Mail contents
 297             (smtp-send-data process smtp-text-buffer)
 298
 299             ;; DATA end "."
 300             (smtp-send-command process ".")
 301             (setq response (smtp-read-response process))
 302             (if (or (null (car response))
 303                     (not (integerp (car response)))
 304                     (>= (car response) 400))
 305                 (throw 'done (car (cdr response))))
 306
 307             t)
 308
 309         (if (and process
 310                  (eq (process-status process) 'open))
 311         (progn
 312           ;; QUIT
 313           (smtp-send-command process "QUIT")
 314           (smtp-read-response process)
 315           (delete-process process)))))))
 316
 317 (defun smtp-process-filter (process output)
 318   (save-excursion
 319     (set-buffer (process-buffer process))
 320     (goto-char (point-max))
 321     (insert output)))
 322
 323 (defun smtp-read-response (process)
 324   (let ((case-fold-search nil)
 325         (response-strings nil)
 326         (response-continue t)
 327         (return-value '(nil ()))
 328         match-end)
 329
 330     (while response-continue
 331       (goto-char smtp-read-point)
 332       (while (not (search-forward "\r\n" nil t))
 333         (accept-process-output process)
 334         (goto-char smtp-read-point))
 335
 336       (setq match-end (point))
 337       (setq response-strings
 338             (cons (buffer-substring smtp-read-point (- match-end 2))
 339                   response-strings))
 340
 341       (goto-char smtp-read-point)
 342       (if (looking-at "[0-9]+ ")
 343           (let ((begin (match-beginning 0))
 344                 (end (match-end 0)))
 345             (if smtp-debug-info
 346                 (message "%s" (car response-strings)))
 347
 348             (setq smtp-read-point match-end)
 349
 350             ;; ignore lines that start with "0"
 351             (if (looking-at "0[0-9]+ ")
 352                 nil
 353               (setq response-continue nil)
 354               (setq return-value
 355                     (cons (string-to-int
 356                            (buffer-substring begin end))
 357                           (nreverse response-strings)))))
 358
 359         (if (looking-at "[0-9]+-")
 360             (progn (if smtp-debug-info
 361                      (message "%s" (car response-strings)))
 362                    (setq smtp-read-point match-end)
 363                    (setq response-continue t))
 364           (progn
 365             (setq smtp-read-point match-end)
 366             (setq response-continue nil)
 367             (setq return-value
 368                   (cons nil (nreverse response-strings)))))))
 369     (setq smtp-read-point match-end)
 370     return-value))
 371
 372 (defun smtp-send-command (process command &optional secure)
 373   (goto-char (point-max))
 374   (if secure
 375       (insert "Here is insecure words.\r\n")
 376     (insert command "\r\n"))
 377   (setq smtp-read-point (point))
 378   (process-send-string process command)
 379   (process-send-string process "\r\n"))
 380
 381 (defun smtp-send-data-1 (process data)
 382   (goto-char (point-max))
 383   (if smtp-debug-info
 384       (insert data "\r\n"))
 385   (setq smtp-read-point (point))
 386   ;; Escape "." at start of a line.
 387   (if (eq (string-to-char data) ?.)
 388       (process-send-string process "."))
 389   (process-send-string process data)
 390   (process-send-string process "\r\n"))
 391
 392 (defun smtp-send-data (process buffer)
 393   (let ((data-continue t)
 394         (sending-data nil)
 395         this-line
 396         this-line-end)
 397
 398     (save-excursion
 399       (set-buffer buffer)
 400       (goto-char (point-min)))
 401
 402     (while data-continue
 403       (save-excursion
 404         (set-buffer buffer)
 405         (beginning-of-line)
 406         (setq this-line (point))
 407         (end-of-line)
 408         (setq this-line-end (point))
 409         (setq sending-data nil)
 410         (setq sending-data (buffer-substring this-line this-line-end))
 411         (if (or (/= (forward-line 1) 0) (eobp))
 412             (setq data-continue nil)))
 413
 414       (smtp-send-data-1 process sending-data))))
 415
 416 (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
 417   "Get address list suitable for smtp RCPT TO:<address>."
 418   (let ((case-fold-search t)
 419         (simple-address-list "")
 420         this-line
 421         this-line-end
 422         addr-regexp
 423         (smtp-address-buffer (generate-new-buffer " *smtp-mail*")))
 424     (unwind-protect
 425         (save-excursion
 426           ;;
 427           (set-buffer smtp-address-buffer)
 428           (erase-buffer)
 429           (insert (save-excursion
 430                     (set-buffer smtp-text-buffer)
 431                     (buffer-substring-no-properties header-start header-end)))
 432           (goto-char (point-min))
 433           ;; RESENT-* fields should stop processing of regular fields.
 434           (save-excursion
 435             (if (re-search-forward "^RESENT-TO:" header-end t)
 436                 (setq addr-regexp
 437                       "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)")
 438               (setq addr-regexp  "^\\(TO:\\|CC:\\|BCC:\\)")))
 439
 440           (while (re-search-forward addr-regexp header-end t)
 441             (replace-match "")
 442             (setq this-line (match-beginning 0))
 443             (forward-line 1)
 444             ;; get any continuation lines.
 445             (while (and (looking-at "^[ \t]+") (< (point) header-end))
 446               (forward-line 1))
 447             (setq this-line-end (point-marker))
 448             (setq simple-address-list
 449                   (concat simple-address-list " "
 450                           (mail-strip-quoted-names
 451                            (buffer-substring this-line this-line-end)))))
 452           (erase-buffer)
 453           (insert-string " ")
 454           (insert-string simple-address-list)
 455           (insert-string "\n")
 456           ;; newline --> blank
 457           (subst-char-in-region (point-min) (point-max) 10 ?  t)
 458           ;; comma   --> blank
 459           (subst-char-in-region (point-min) (point-max) ?, ?  t)
 460           ;; tab     --> blank
 461           (subst-char-in-region (point-min) (point-max)  9 ?  t)
 462
 463           (goto-char (point-min))
 464           ;; tidyness in case hook is not robust when it looks at this
 465           (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
 466
 467           (goto-char (point-min))
 468           (let (recipient-address-list)
 469             (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
 470               (backward-char 1)
 471               (setq recipient-address-list
 472                     (cons (buffer-substring (match-beginning 1) (match-end 1))
 473                           recipient-address-list)))
 474             recipient-address-list))
 475       (kill-buffer smtp-address-buffer))))
 476
 477 (defun smtp-auth-cram-md5 (process)
 478   (let ((secure-word (copy-sequence smtp-authentication-passphrase))
 479         response)
 480     (smtp-send-command process "AUTH CRAM-MD5")
 481     (setq response (smtp-read-response process))
 482     (if (or (null (car response))
 483             (not (integerp (car response)))
 484             (>= (car response) 400))
 485         (throw 'done (car (cdr response))))
 486     (smtp-send-command
 487      process
 488      (setq secure-word (unwind-protect
 489                            (sasl-cram-md5
 490                             smtp-authentication-user secure-word
 491                             (base64-decode-string
 492                              (substring (car (cdr response)) 4)))
 493                          (fillarray secure-word 0))
 494            secure-word (unwind-protect
 495                            (base64-encode-string secure-word)
 496                          (fillarray secure-word 0))) t)
 497     (fillarray secure-word 0)
 498     (setq response (smtp-read-response process))
 499     (if (or (null (car response))
 500             (not (integerp (car response)))
 501             (>= (car response) 400))
 502         (throw 'done (car (cdr response))))))
 503
 504 (defun smtp-auth-plain (process)
 505   (let ((secure-word (copy-sequence smtp-authentication-passphrase))
 506         response)
 507     (smtp-send-command
 508      process
 509      (setq secure-word (unwind-protect
 510                            (sasl-plain "" smtp-authentication-user secure-word)
 511                          (fillarray secure-word 0))
 512            secure-word (unwind-protect
 513                            (base64-encode-string secure-word)
 514                          (fillarray secure-word 0))
 515            secure-word (unwind-protect
 516                            (concat "AUTH PLAIN " secure-word)
 517                          (fillarray secure-word 0))) t)
 518     (fillarray secure-word 0)
 519     (setq response (smtp-read-response process))
 520     (if (or (null (car response))
 521             (not (integerp (car response)))
 522             (>= (car response) 400))
 523         (throw 'done (car (cdr response))))))
 524
 525 (defun smtp-auth-login (process)
 526   (let ((secure-word (copy-sequence smtp-authentication-passphrase))
 527         response)
 528     (smtp-send-command
 529      process
 530      (concat "AUTH LOGIN " smtp-authentication-user))
 531     (setq response (smtp-read-response process))
 532     (if (or (null (car response))
 533             (not (integerp (car response)))
 534             (>= (car response) 400))
 535         (throw 'done (car (cdr response))))
 536     (smtp-send-command
 537      process
 538      (setq secure-word (unwind-protect
 539                            (base64-encode-string secure-word)
 540                          (fillarray secure-word 0))) t)
 541     (fillarray secure-word 0)
 542     (setq response (smtp-read-response process))
 543     (if (or (null (car response))
 544             (not (integerp (car response)))
 545             (>= (car response) 400))
 546         (throw 'done (car (cdr response))))))
 547
 548 (defun smtp-auth-anonymous (process &optional token)
 549   (let (response)
 550     (smtp-send-command
 551      process "AUTH ANONYMOUS")
 552     (setq response (smtp-read-response process))
 553     (if (or (null (car response))
 554             (not (integerp (car response)))
 555             (>= (car response) 400))
 556         (throw 'done (car (cdr response))))
 557     (smtp-send-command process
 558                        (base64-encode-string
 559                         (or token
 560                             user-mail-address
 561                             "")))
 562     (setq response (smtp-read-response process))
 563     (if (or (null (car response))
 564             (not (integerp (car response)))
 565             (>= (car response) 400))
 566         (throw 'done (car (cdr response))))))
 567
 568 (defun smtp-auth-scram-md5 (process)
 569   ;; now tesing
 570   (let (server-msg-1 server-msg-2 client-msg-1 salted-pass
 571                      response secure-word)
 572     (smtp-send-command process "AUTH SCRAM-MD5")
 573     (setq response (smtp-read-response process))
 574     (if (or (null (car response))
 575             (not (integerp (car response)))
 576             (>= (car response) 400))
 577         (throw 'done (car (cdr response))))
 578     (unwind-protect
 579         (smtp-send-command
 580          process
 581          (setq secure-word
 582                (base64-encode-string
 583                 (setq client-msg-1
 584                       (sasl-scram-md5-client-msg-1
 585                        smtp-authentication-user)))) t)
 586       (fillarray secure-word 0))
 587     (setq response (smtp-read-response process))
 588     (if (or (null (car response))
 589             (not (integerp (car response)))
 590             (>= (car response) 400))
 591         (progn
 592           (fillarray client-msg-1 0)
 593           (throw 'done (car (cdr response)))))
 594     (setq secure-word
 595           (unwind-protect
 596               (substring (car (cdr response)) 4)
 597             (fillarray (car (cdr response)) 0)))
 598     (setq server-msg-1
 599           (unwind-protect
 600               (base64-decode-string secure-word)
 601             (fillarray secure-word 0)))
 602     (setq secure-word
 603           (sasl-scram-md5-client-msg-2
 604            server-msg-1 client-msg-1
 605            (setq salted-pass
 606                  (scram-md5-make-salted-pass
 607                   smtp-authentication-passphrase
 608                   (car
 609                    (scram-md5-parse-server-msg-1 server-msg-1))))))
 610     (setq secure-word
 611           (unwind-protect
 612               (base64-encode-string secure-word)
 613             (fillarray secure-word 0)))
 614     (unwind-protect
 615         (smtp-send-command process secure-word t)
 616       (fillarray secure-word 0))
 617     (setq response (smtp-read-response process))
 618     (if (or (null (car response))
 619             (not (integerp (car response)))
 620             (>= (car response) 400))
 621         (progn
 622           (fillarray salted-pass 0)
 623           (fillarray server-msg-1 0)
 624           (fillarray client-msg-1 0)
 625           (throw 'done (car (cdr response)))))
 626     (setq server-msg-2
 627           (unwind-protect
 628               (base64-decode-string
 629                (setq secure-word
 630                      (substring (car (cdr response)) 4)))
 631             (fillarray secure-word 0)))
 632     (if (null
 633          (unwind-protect
 634              (sasl-scram-md5-authenticate-server
 635               server-msg-1
 636               server-msg-2
 637               client-msg-1
 638               salted-pass)
 639            (fillarray salted-pass 0)
 640            (fillarray server-msg-1 0)
 641            (fillarray server-msg-2 0)
 642            (fillarray client-msg-1 0)))
 643         (throw 'done nil))
 644     (smtp-send-command process "")
 645     (setq response (smtp-read-response process))
 646     (if (or (null (car response))
 647             (not (integerp (car response)))
 648             (>= (car response) 400))
 649         (throw 'done (car (cdr response)))) ))
 650
 651 (provide 'smtp)
 652
 653 ;;; smtp.el ends here