update.
[elisp/flim.git] / smtp.el
diff --git a/smtp.el b/smtp.el
index 0e9b28e..fe511e9 100644 (file)
--- a/smtp.el
+++ b/smtp.el
@@ -1,6 +1,7 @@
 ;;; smtp.el --- basic functions to send mail with SMTP server
 
-;; Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001 ,2002, 2004
+;; Free Software Foundation, Inc.
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;;     Simon Leinen <simon@switch.ch> (ESMTP support)
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 
 ;;; Commentary:
-;; 
+;;
 
 ;;; Code:
 
-(require 'pces)
-(require 'pcustom)
+(require 'custom)
 (require 'mail-utils)                  ; mail-strip-quoted-names
 (require 'sasl)
+(require 'luna)
+(require 'mel) ; binary-funcall
 
 (defgroup smtp nil
   "SMTP protocol for sending mail."
@@ -57,10 +59,16 @@ called from `smtp-via-smtp' with arguments SENDER and RECIPIENTS."
                 (function :tag "Function"))
   :group 'smtp)
 
+(defcustom smtp-send-by-myself nil
+  "If non-nil, smtp.el send a mail by myself without smtp-server.
+This option requires \"dig.el\"."
+  :type 'boolean
+  :group 'smtp)
+
 (defcustom smtp-service "smtp"
   "SMTP service port number.  \"smtp\" or 25."
   :type '(choice (integer :tag "25" 25)
-                 (string :tag "smtp" "smtp"))
+                (string :tag "smtp" "smtp"))
   :group 'smtp)
 
 (defcustom smtp-local-domain nil
@@ -90,6 +98,19 @@ don't define this value."
   :type 'boolean
   :group 'smtp-extensions)
 
+(defcustom smtp-use-starttls-ignore-error nil
+  "If non-nil, do not use STARTTLS if STARTTLS is not available."
+  :type 'boolean
+  :group 'smtp-extensions)
+
+(defcustom smtp-starttls-program "starttls"
+  "The program to run in a subprocess to open an TLSv1 connection."
+  :group 'smtp-extensions)
+
+(defcustom smtp-starttls-extra-args nil
+  "Extra arguments to `starttls-program'"
+  :group 'smtp-extensions)
+
 (defcustom smtp-use-sasl nil
   "If non-nil, use SMTP Authentication (RFC2554) if available."
   :type 'boolean
@@ -100,8 +121,8 @@ don't define this value."
   :type 'string
   :group 'smtp-extensions)
 
-(defcustom smtp-sasl-user-realm smtp-local-domain
-  "Realm name to be used for authorization."
+(defcustom smtp-sasl-properties nil
+  "Properties set to SASL client."
   :type 'string
   :group 'smtp-extensions)
 
@@ -110,9 +131,30 @@ don't define this value."
   :type '(repeat string)
   :group 'smtp-extensions)
 
+(defcustom smtp-debug nil
+  "*If non-nil, smtp debug info printout into messages."
+  :type 'boolean
+  :group 'smtp)
+
 (defvar sasl-mechanisms)
-  
-(defvar smtp-open-connection-function #'open-network-stream)
+
+;;;###autoload
+(defvar smtp-open-connection-function #'open-network-stream
+  "*Function used for connecting to a SMTP server.
+The function will be called with the same four arguments as
+`open-network-stream' and should return a process object.
+Here is an example:
+
+\(setq smtp-open-connection-function
+      #'(lambda (name buffer host service)
+         (let ((process-connection-type nil))
+           (start-process name buffer \"ssh\" \"-C\" host
+                          \"nc\" host service))))
+
+It connects to a SMTP server using \"ssh\" before actually connecting
+to the SMTP port.  Where the command \"nc\" is the netcat executable;
+see http://www.atstake.com/research/tools/index.html#network_utilities
+for details.")
 
 (defvar smtp-read-point nil)
 
@@ -120,37 +162,32 @@ don't define this value."
 
 (defvar smtp-submit-package-function #'smtp-submit-package)
 
-;;; @ SMTP package structure
+;;; @ SMTP package
 ;;; A package contains a mail message, an envelope sender address,
-;;; and one or more envelope recipient addresses.  In ESMTP model,
-;;; we should guarantee the user to access the current sending package
+;;; and one or more envelope recipient addresses.  In ESMTP model
+;;; the current sending package should be guaranteed to be accessible
 ;;; anywhere from the hook methods (or SMTP commands).
 
-(defmacro smtp-package-sender (package)
-  "Return the sender of PACKAGE, a string."
-  `(aref ,package 0))
-
-(defmacro smtp-package-recipients (package)
-  "Return the recipients of PACKAGE, a list of strings."
-  `(aref ,package 1))
+(eval-and-compile
+  (luna-define-class smtp-package ()
+                    (sender
+                     recipients
+                     buffer))
 
-(defmacro smtp-package-buffer (package)
-  "Return the data of PACKAGE, a buffer."
-  `(aref ,package 2))
+  (luna-define-internal-accessors 'smtp-package))
 
-(defmacro smtp-make-package (sender recipients buffer)
+(defun smtp-make-package (sender recipients buffer)
   "Create a new package structure.
-A package is a unit of SMTP message which contains a mail message,
-an envelope sender address, and one or more envelope recipient addresses.
+A package is a unit of SMTP message
 SENDER specifies the package sender, a string.
 RECIPIENTS is a list of recipients.
 BUFFER may be a buffer or a buffer name which contains mail message."
-  `(vector ,sender ,recipients ,buffer))
+  (luna-make-entity 'smtp-package :sender sender :recipients recipients :buffer buffer))
 
-(defun smtp-package-buffer-size (package)
+(defun smtp-package-buffer-internal-size (package)
   "Return the size of PACKAGE, an integer."
   (save-excursion
-    (set-buffer (smtp-package-buffer package))
+    (set-buffer (smtp-package-buffer-internal package))
     (let ((size
           (+ (buffer-size)
              ;; Add one byte for each change-of-line
@@ -166,48 +203,42 @@ BUFFER may be a buffer or a buffer name which contains mail message."
        (setq size (1+ size)))
       size)))
 
-;;; @ SMTP connection structure
-;;; We should take care of a emulation for another network stream.
-;;; They are likely to be implemented with a external program and the function
-;;; `process-contact' returns the process ID instead of `(HOST SERVICE)' pair.
-
-(defmacro smtp-connection-process (connection)
-  "Return the subprocess-object of CONNECTION."
-  `(aref ,connection 0))
+;;; @ SMTP connection
+;;; We should consider the function `open-network-stream' is a emulation
+;;; for another network stream.  They are likely to be implemented with an
+;;; external program and the function `process-contact' returns the
+;;; process id instead of `(HOST SERVICE)' pair.
 
-(defmacro smtp-connection-server (connection)
-  "Return the server of CONNECTION, a string."
-  `(aref ,connection 1))
-
-(defmacro smtp-connection-service (connection)
-  "Return the service of CONNECTION, a string or an integer."
-  `(aref ,connection 2))
-
-(defmacro smtp-connection-extensions (connection)
-  "Return the SMTP extensions of CONNECTION, a list of strings."
-  `(aref ,connection 3))
+(eval-and-compile
+  (luna-define-class smtp-connection ()
+                    (process
+                     server
+                     service
+                     extensions
+                     encoder
+                     decoder))
 
-(defmacro smtp-connection-set-extensions (connection extensions)
-  "Set the SMTP extensions of CONNECTION.
-EXTENSIONS is a list of cons cells of the form \(EXTENSION . PARAMETERS).
-Where EXTENSION is a symbol and PARAMETERS is a list of strings."
-  `(aset ,connection 3 ,extensions))
+  (luna-define-internal-accessors 'smtp-connection))
 
-(defmacro smtp-make-connection (process server service)
+(defun smtp-make-connection (process server service)
   "Create a new connection structure.
 PROCESS is an internal subprocess-object.  SERVER is name of the host
 to connect to.  SERVICE is name of the service desired."
-  `(vector ,process ,server ,service nil))
+  (luna-make-entity 'smtp-connection :process process :server server :service service))
+
+(luna-define-generic smtp-connection-opened (connection)
+  "Say whether the CONNECTION to server has been opened.")
+
+(luna-define-generic smtp-close-connection (connection)
+  "Close the CONNECTION to server.")
 
-(defun smtp-connection-opened (connection)
-  "Say whether the CONNECTION to server has been opened."
-  (let ((process (smtp-connection-process connection)))
+(luna-define-method smtp-connection-opened ((connection smtp-connection))
+  (let ((process (smtp-connection-process-internal connection)))
     (if (memq (process-status process) '(open run))
        t)))
 
-(defun smtp-close-connection (connection)
-  "Close the CONNECTION to server."
-  (let ((process (smtp-connection-process connection)))
+(luna-define-method smtp-close-connection ((connection smtp-connection))
+  (let ((process (smtp-connection-process-internal connection)))
     (delete-process process)))
 
 (defun smtp-make-fqdn ()
@@ -245,9 +276,8 @@ Return a newly allocated connection-object.
 BUFFER is the buffer to associate with the connection.  SERVER is name
 of the host to connect to.  SERVICE is name of the service desired."
   (let ((process
-        (as-binary-process
-         (funcall smtp-open-connection-function
-                  "SMTP" buffer  server service)))
+        (binary-funcall smtp-open-connection-function
+                        "SMTP" buffer server service))
        connection)
     (when process
       (setq connection (smtp-make-connection process server service))
@@ -257,8 +287,54 @@ of the host to connect to.  SERVICE is name of the service desired."
                  smtp-connection-alist))
       connection)))
 
+(eval-and-compile
+  (autoload 'dig-invoke "dig")
+  (autoload 'dig-extract-rr "dig"))
+
+(defun smtp-find-mx (domain &optional doerror)
+  (let (server)
+    ;; dig.el resolves only primally MX.
+    (cond ((setq server (smtp-dig domain "MX"))
+          (progn (string-match " \\([^ ]*\\)$" server)
+                 (match-string 1 server)))
+         ((smtp-dig domain "A")
+           domain)
+         (t
+          (if doerror
+               (error (format "SMTP cannot resolve %s" domain)))))))
+
+(defun smtp-dig (domain type)
+  (let (dig-buf)
+    (set-buffer
+     (setq dig-buf (dig-invoke domain type)))
+    (prog1
+       (dig-extract-rr domain type)
+      (kill-buffer dig-buf))))
+
+(defun smtp-find-server (recipients)
+  (save-excursion
+    (let ((rec
+          (mapcar (lambda (recipient)
+                    (let (server)
+                      (if (and (string-match "@\\([^\t\n ]*\\)" recipient)
+                               (setq server
+                                     (smtp-find-mx
+                                      (match-string 1 recipient))))
+                          (cons server (list recipient))
+                        (error (format "cannot find server for %s." recipient)))))
+                  recipients))
+         ret rets rlist)
+      (while (setq rets (pop rec))
+       (if (setq ret (assoc (car rets) rec))
+           (setcdr ret
+                   (append (cdr ret) (cdr rets)))
+         (setq rlist
+               (append rlist (list rets)))))
+      rlist)))
+
 ;;;###autoload
 (defun smtp-via-smtp (sender recipients buffer)
+  "Like `smtp-send-buffer', but sucks in any errors."
   (condition-case nil
       (progn
        (smtp-send-buffer sender recipients buffer)
@@ -269,27 +345,36 @@ of the host to connect to.  SERVICE is name of the service desired."
 
 ;;;###autoload
 (defun smtp-send-buffer (sender recipients buffer)
-  (let ((server
-        (if (functionp smtp-server)
-            (funcall smtp-server sender recipients)
-          smtp-server))
-       (package
-        (smtp-make-package sender recipients buffer))
-       (smtp-open-connection-function
-        (if smtp-use-starttls
-            #'starttls-open-stream
-          smtp-open-connection-function)))
-    (save-excursion
-      (set-buffer
-       (get-buffer-create
-       (format "*trace of SMTP session to %s*" server)))
-      (erase-buffer)
-      (buffer-disable-undo)
-      (unless (smtp-find-connection (current-buffer))
-       (smtp-open-connection (current-buffer) server smtp-service))
-      (make-local-variable 'smtp-read-point)
-      (setq smtp-read-point (point-min))
-      (funcall smtp-submit-package-function package))))
+  "Send a message.
+SENDER is an envelope sender address.
+RECIPIENTS is a list of envelope recipient addresses.
+BUFFER may be a buffer or a buffer name which contains mail message."
+  (if smtp-send-by-myself
+      (smtp-send-buffer-by-myself sender recipients buffer)
+    (let* ((server
+           (if (functionp smtp-server)
+               (funcall smtp-server sender recipients)
+             (or smtp-server
+                 (error "`smtp-server' not defined"))))
+          (package
+           (smtp-make-package sender recipients buffer))
+          (starttls-program smtp-starttls-program)
+          (starttls-extra-args smtp-starttls-extra-args)
+          (smtp-open-connection-function
+           (if smtp-use-starttls
+               #'starttls-open-stream
+             smtp-open-connection-function)))
+      (save-excursion
+       (set-buffer
+        (get-buffer-create
+         (format "*trace of SMTP session to %s*" server)))
+       (erase-buffer)
+       (buffer-disable-undo)
+       (unless (smtp-find-connection (current-buffer))
+         (smtp-open-connection (current-buffer) server smtp-service))
+       (make-local-variable 'smtp-read-point)
+       (setq smtp-read-point (point-min))
+       (funcall smtp-submit-package-function package)))))
 
 (defun smtp-submit-package (package)
   (unwind-protect
@@ -300,18 +385,62 @@ of the host to connect to.  SERVICE is name of the service desired."
          (smtp-response-error
           (smtp-primitive-helo package)))
        (if smtp-use-starttls
-           (smtp-primitive-starttls package))
+           (if (assq 'starttls
+                     (smtp-connection-extensions-internal
+                      (smtp-find-connection (current-buffer))))
+               (progn
+                 (smtp-primitive-starttls package)
+                 (smtp-primitive-ehlo package))
+             (unless smtp-use-starttls-ignore-error
+               (error "STARTTLS is not supported on this server"))))
        (if smtp-use-sasl
            (smtp-primitive-auth package))
        (smtp-primitive-mailfrom package)
        (smtp-primitive-rcptto package)
        (smtp-primitive-data package))
     (let ((connection (smtp-find-connection (current-buffer))))
-      (when (smtp-connection-opened connection)
-       ;; QUIT
-       (smtp-primitive-quit package)
+      (when (and connection (smtp-connection-opened connection))
+       (condition-case nil
+           (smtp-primitive-quit package)
+         (smtp-error))
        (smtp-close-connection connection)))))
 
+(defun smtp-send-buffer-by-myself (sender recipients buffer)
+  "Send a message by myself.
+SENDER is an envelope sender address.
+RECIPIENTS is a list of envelope recipient addresses.
+BUFFER may be a buffer or a buffer name which contains mail message."
+  (let ((servers
+        (smtp-find-server recipients))
+       (smtp-open-connection-function
+        (if smtp-use-starttls
+            #'starttls-open-stream
+          smtp-open-connection-function))
+       server package)
+      (while (car servers)
+       (setq server (caar servers))
+       (setq recipients (cdar servers))
+       (if (not (and server recipients))
+           ;; MAILER-DAEMON is required. :)
+           (error (format "Cannot send <%s>"
+                          (mapconcat 'concat recipients ">,<"))))
+       (setq package
+             (smtp-make-package sender recipients buffer))
+       (save-excursion
+         (set-buffer
+          (get-buffer-create
+           (format "*trace of SMTP session to %s*" server)))
+         (erase-buffer)
+         (buffer-disable-undo)
+         (unless (smtp-find-connection (current-buffer))
+           (smtp-open-connection (current-buffer) server smtp-service))
+         (make-local-variable 'smtp-read-point)
+         (setq smtp-read-point (point-min))
+         (let ((smtp-use-sasl nil)
+               (smtp-use-starttls-ignore-error t))
+           (funcall smtp-submit-package-function package)))
+       (setq servers (cdr servers)))))
+
 ;;; @ hook methods for `smtp-submit-package'
 ;;;
 
@@ -319,22 +448,19 @@ of the host to connect to.  SERVICE is name of the service desired."
   (let* ((connection
          (smtp-find-connection (current-buffer)))
         (response
-         (smtp-read-response
-          (smtp-connection-process connection))))
+         (smtp-read-response connection)))
     (if (/= (car response) 220)
        (smtp-response-error response))))
 
 (defun smtp-primitive-ehlo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
-    (smtp-send-command process (format "EHLO %s" (smtp-make-fqdn)))
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection (format "EHLO %s" (smtp-make-fqdn)))
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
        (smtp-response-error response))
-    (smtp-connection-set-extensions
+    (smtp-connection-set-extensions-internal
      connection (mapcar
                 (lambda (extension)
                   (let ((extensions
@@ -348,21 +474,17 @@ of the host to connect to.  SERVICE is name of the service desired."
 (defun smtp-primitive-helo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
-    (smtp-send-command process (format "HELO %s" (smtp-make-fqdn)))
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection (format "HELO %s" (smtp-make-fqdn)))
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-auth (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         (mechanisms
-         (cdr (assq 'auth (smtp-connection-extensions connection))))
+         (cdr (assq 'auth (smtp-connection-extensions-internal connection))))
         (sasl-mechanisms
          (or smtp-sasl-mechanisms sasl-mechanisms))
         (mechanism
@@ -374,20 +496,20 @@ of the host to connect to.  SERVICE is name of the service desired."
     (unless mechanism
       (error "No authentication mechanism available"))
     (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp"
-                                  (smtp-connection-server connection)))
-    (if smtp-sasl-user-realm
-       (sasl-client-set-property client 'realm smtp-sasl-user-realm))
+                                  (smtp-connection-server-internal connection)))
+    (if smtp-sasl-properties
+       (sasl-client-set-properties client smtp-sasl-properties))
     (setq name (sasl-mechanism-name mechanism)
          ;; Retrieve the initial response
          step (sasl-next-step client nil))
     (smtp-send-command
-     process
+     connection
      (if (sasl-step-data step)
         (format "AUTH %s %s" name (base64-encode-string (sasl-step-data step) t))
        (format "AUTH %s" name)))
     (catch 'done
       (while t
-       (setq response (smtp-read-response process))
+       (setq response (smtp-read-response connection))
        (when (= (car response) 235)
          ;; The authentication process is finished.
          (setq step (sasl-next-step client step))
@@ -399,97 +521,93 @@ of the host to connect to.  SERVICE is name of the service desired."
        (sasl-step-set-data step (base64-decode-string (nth 1 response)))
        (setq step (sasl-next-step client step))
        (smtp-send-command
-        process (if (sasl-step-data step)
-                    (base64-encode-string (sasl-step-data step) t)
-                  ""))))))
+        connection
+        (if (sasl-step-data step)
+            (base64-encode-string (sasl-step-data step) t)
+          ""))))
+;;;    (smtp-connection-set-encoder-internal
+;;;     connection (sasl-client-encoder client))
+;;;    (smtp-connection-set-decoder-internal
+;;;     connection (sasl-client-decoder client))
+    ))
 
 (defun smtp-primitive-starttls (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
     ;; STARTTLS --- begin a TLS negotiation (RFC 2595)
-    (smtp-send-command process "STARTTLS")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "STARTTLS")
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 220)
        (smtp-response-error response))
-    (starttls-negotiate process)))
+    (starttls-negotiate (smtp-connection-process-internal connection))))
 
 (defun smtp-primitive-mailfrom (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         (extensions
-         (smtp-connection-extensions
+         (smtp-connection-extensions-internal
           connection))
         (sender
-         (smtp-package-sender package))
+         (smtp-package-sender-internal package))
         extension
         response)
     ;; SIZE --- Message Size Declaration (RFC1870)
     (if (and smtp-use-size
             (assq 'size extensions))
-       (setq extension (format "SIZE=%d" (smtp-package-buffer-size package))))
+       (setq extension (format " SIZE=%d" (smtp-package-buffer-internal-size package))))
     ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652)
     (if (and smtp-use-8bitmime
             (assq '8bitmime extensions))
        (setq extension (concat extension " BODY=8BITMIME")))
     (smtp-send-command
-     process
+     connection
      (if extension
-        (format "MAIL FROM:<%s> %s" sender extension)
+        (format "MAIL FROM:<%s>%s" sender extension)
        (format "MAIL FROM:<%s>" sender)))
-    (setq response (smtp-read-response process))
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-rcptto (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         (recipients
-         (smtp-package-recipients package))
+         (smtp-package-recipients-internal package))
         response)
     (while recipients
       (smtp-send-command
-       process (format "RCPT TO:<%s>" (pop recipients)))
-      (setq response (smtp-read-response process))
+       connection (format "RCPT TO:<%s>" (pop recipients)))
+      (setq response (smtp-read-response connection))
       (unless (memq (car response) '(250 251))
        (smtp-response-error response)))))
 
 (defun smtp-primitive-data (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
-    (smtp-send-command process "DATA")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "DATA")
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 354)
        (smtp-response-error response))
     (save-excursion
-      (set-buffer (smtp-package-buffer package))
+      (set-buffer (smtp-package-buffer-internal package))
       (goto-char (point-min))
       (while (not (eobp))
        (smtp-send-data
-        process (buffer-substring (point) (progn (end-of-line)(point))))
-       (forward-char)))
-    (smtp-send-command process ".")
-    (setq response (smtp-read-response process))
+        connection (buffer-substring (point) (progn (end-of-line)(point))))
+       (beginning-of-line 2)))
+    (smtp-send-command connection ".")
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-quit (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
-    (smtp-send-command process "QUIT")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "QUIT")
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 221)
        (smtp-response-error response))))
 
@@ -510,47 +628,67 @@ of the host to connect to.  SERVICE is name of the service desired."
 (defun smtp-response-error (response)
   (signal 'smtp-response-error response))
 
-(defun smtp-read-response (process)
-  (let (case-fold-search
+(defun smtp-read-response (connection)
+  (let ((decoder
+        (smtp-connection-decoder-internal connection))
        (response-continue t)
        response)
     (while response-continue
       (goto-char smtp-read-point)
-      (while (not (search-forward "\r\n" nil t))
-       (accept-process-output process)
+      (while (not (re-search-forward "\r?\n" nil t))
+       (unless (smtp-connection-opened connection)
+         (signal 'smtp-error "Connection closed"))
+       (accept-process-output (smtp-connection-process-internal connection))
        (goto-char smtp-read-point))
-      (setq response
-           (nconc response
-                  (list (buffer-substring
-                         (+ 4 smtp-read-point)
-                         (- (point) 2)))))
-      (goto-char
-       (prog1 smtp-read-point
-        (setq smtp-read-point (point))))
-      (if (looking-at "[1-5][0-9][0-9] ")
-         (setq response (cons (read (point-marker)) response)
-               response-continue nil)))
+      (let ((bol smtp-read-point)
+           (eol (match-beginning 0)))
+       (when decoder
+         (let ((string (buffer-substring bol eol)))
+           (delete-region bol (point))
+           (insert (funcall decoder string))
+           (setq eol (point))
+           (insert "\r\n")))
+       (setq smtp-read-point (point))
+       (goto-char bol)
+       (cond
+        ((looking-at "[1-5][0-9][0-9]\\([ -]\\)")
+         (setq response
+               (nconc response
+                      (list (buffer-substring (match-end 0) eol))))
+         (when (string= (match-string 1) " ")
+           (setq response (cons (read (point-marker)) response)
+                 response-continue nil)))
+        (smtp-debug
+         (message "Invalid response: %s" (buffer-substring bol eol))))))
     response))
 
-(defun smtp-send-command (process command)
+(defun smtp-send-command (connection command)
   (save-excursion
-    (set-buffer (process-buffer process))
-    (goto-char (point-max))
-    (insert command "\r\n")
-    (setq smtp-read-point (point))
-    (process-send-string process command)
-    (process-send-string process "\r\n")))
-
-(defun smtp-send-data (process data)
-  (save-excursion
-    (set-buffer (process-buffer process))
-    (goto-char (point-max))
-    (setq smtp-read-point (point))
+    (let ((process
+          (smtp-connection-process-internal connection))
+         (encoder
+          (smtp-connection-encoder-internal connection)))
+      (set-buffer (process-buffer process))
+      (goto-char (point-max))
+      (setq command (concat command "\r\n"))
+      (insert command)
+      (setq smtp-read-point (point))
+      (if encoder
+         (setq command (funcall encoder command)))
+      (process-send-string process command))))
+
+(defun smtp-send-data (connection data)
+  (let ((process
+        (smtp-connection-process-internal connection))
+       (encoder
+        (smtp-connection-encoder-internal connection)))
     ;; Escape "." at start of a line.
     (if (eq (string-to-char data) ?.)
-       (process-send-string process "."))
-    (process-send-string process data)
-    (process-send-string process "\r\n")))
+       (setq data (concat "." data "\r\n"))
+      (setq data (concat data "\r\n")))
+    (if encoder
+       (setq data (funcall encoder data)))
+    (process-send-string process data)))
 
 (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
   "Get address list suitable for smtp RCPT TO:<address>."
@@ -589,9 +727,7 @@ of the host to connect to.  SERVICE is name of the service desired."
                          (mail-strip-quoted-names
                           (buffer-substring this-line this-line-end)))))
          (erase-buffer)
-         (insert-string " ")
-         (insert-string simple-address-list)
-         (insert-string "\n")
+         (insert " " simple-address-list "\n")
          ;; newline --> blank
          (subst-char-in-region (point-min) (point-max) 10 ?  t)
          ;; comma   --> blank