(smtp-primitive-mailfrom): Fixed two spaces may be used as a separator

[elisp/flim.git] / smtp.el

diff --git a/smtp.el b/smtp.el
index 0e9b28e..ba95db6 100644 (file)
--- a/smtp.el
+++ b/smtp.el
@@ -1,6 +1,7 @@
 ;;; smtp.el --- basic functions to send mail with SMTP server
 
 ;;; 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)
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;;     Simon Leinen <simon@switch.ch> (ESMTP support)

@@ -22,19 +23,20 @@
 
 ;; 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
 
 ;; 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:
 
 
 ;;; Commentary:

-;; 
+;;

 
 ;;; Code:
 
 
 ;;; Code:
 

-(require 'pces)
-(require 'pcustom)
+(require 'custom)

 (require 'mail-utils)                  ; mail-strip-quoted-names
 (require 'sasl)
 (require 'mail-utils)                  ; mail-strip-quoted-names
 (require 'sasl)

+(require 'luna)
+(require 'mel) ; binary-funcall

 
 (defgroup smtp nil
   "SMTP protocol for sending mail."
 
 (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)
 
                 (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)
 (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
   :group 'smtp)
 
 (defcustom smtp-local-domain nil

@@ -90,6 +98,19 @@ don't define this value."
   :type 'boolean
   :group 'smtp-extensions)
 
   :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
 (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)
 
   :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)
 
   :type 'string
   :group 'smtp-extensions)
 

@@ -110,9 +131,30 @@ don't define this value."
   :type '(repeat string)
   :group 'smtp-extensions)
 
   :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 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)
 
 
 (defvar smtp-read-point nil)
 

@@ -120,37 +162,32 @@ don't define this value."
 
 (defvar smtp-submit-package-function #'smtp-submit-package)
 
 
 (defvar smtp-submit-package-function #'smtp-submit-package)
 

-;;; @ SMTP package structure
+;;; @ SMTP package

 ;;; A package contains a mail message, an envelope sender address,
 ;;; 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).
 
 ;;; 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.
   "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."
 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
   "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
     (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)))
 
        (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."
   "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)))
 
     (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 ()
     (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
 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))
        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)))
 
                  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)
 ;;;###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)
   (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)
 
 ;;;###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
 
 (defun smtp-submit-package (package)
   (unwind-protect

@@ -300,7 +385,14 @@ 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-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)
        (if smtp-use-sasl
            (smtp-primitive-auth package))
        (smtp-primitive-mailfrom package)

@@ -308,10 +400,47 @@ of the host to connect to.  SERVICE is name of the service desired."
        (smtp-primitive-data package))
     (let ((connection (smtp-find-connection (current-buffer))))
       (when (smtp-connection-opened connection)
        (smtp-primitive-data package))
     (let ((connection (smtp-find-connection (current-buffer))))
       (when (smtp-connection-opened connection)

-       ;; QUIT
-       (smtp-primitive-quit package)
+       (condition-case nil
+           (smtp-primitive-quit package)
+         (smtp-error))

        (smtp-close-connection connection)))))
 
        (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'
 ;;;
 
 ;;; @ 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
   (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)))
     (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)
         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))
     (if (/= (car response) 250)
        (smtp-response-error response))

-    (smtp-connection-set-extensions
+    (smtp-connection-set-extensions-internal

      connection (mapcar
                 (lambda (extension)
                   (let ((extensions
      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)))
 (defun smtp-primitive-helo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         response)
         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)))
     (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
         (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
         (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"
     (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
     (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
      (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))
        (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
        (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)))
 
 (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)
         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))
     (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)))
 
 (defun smtp-primitive-mailfrom (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))

-        (process
-         (smtp-connection-process connection))

         (extensions
         (extensions

-         (smtp-connection-extensions
+         (smtp-connection-extensions-internal

           connection))
         (sender
           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))
         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
     ;; 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
      (if extension

-        (format "MAIL FROM:<%s> %s" sender extension)
+        (format "MAIL FROM:<%s>%s" sender extension)

        (format "MAIL FROM:<%s>" sender)))
        (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)))
     (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
         (recipients

-         (smtp-package-recipients package))
+         (smtp-package-recipients-internal package))

         response)
     (while recipients
       (smtp-send-command
         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)))
       (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)
         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
     (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
       (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)))
     (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)
         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))))
 
     (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-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)
        (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))
        (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))
 
     response))
 

-(defun smtp-send-command (process command)
+(defun smtp-send-command (connection command)

   (save-excursion
   (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) ?.)
     ;; 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>."
 
 (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)
                          (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
          ;; newline --> blank
          (subst-char-in-region (point-min) (point-max) 10 ?  t)
          ;; comma   --> blank