X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=smtp.el;h=ff13f5a1cb635152d5e268e7a386d0bf52642f5a;hb=46091983cca70001a00cc61f44ead1c7d348c521;hp=2a979d41c330cae83b18de4fcf09785a7014b086;hpb=93fbe8430342dc3ab7f3926057d5c0234add7df9;p=elisp%2Fflim.git

diff --git a/smtp.el b/smtp.el
index 2a979d4..ff13f5a 100644
--- a/smtp.el
+++ b/smtp.el
@@ -1,6 +1,6 @@
 ;;; 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 Free Software Foundation, Inc.
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;;	Simon Leinen <simon@switch.ch> (ESMTP support)
@@ -27,14 +27,15 @@
 
 
 ;;; 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 +58,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 +97,11 @@ 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-use-sasl nil
   "If non-nil, use SMTP Authentication (RFC2554) if available."
   :type 'boolean
@@ -111,8 +123,25 @@ don't define this value."
   :group 'smtp-extensions)
 
 (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.  In addition, you will have to modify the value for
+`smtp-end-of-line' to \"\\n\" if you use \"telnet\" instead of \"nc\".")
 
 (defvar smtp-read-point nil)
 
@@ -120,36 +149,37 @@ don't define this value."
 
 (defvar smtp-submit-package-function #'smtp-submit-package)
 
-;;; @ SMTP package structure
+(defvar smtp-end-of-line "\r\n"
+  "*String to use as end-of-line marker when talking to a SMTP server.
+This is \"\\r\\n\" by default, but it may have to be \"\\n\" when using a non
+native connection function.  See also `smtp-open-connection-function'.")
+
+;;; @ SMTP package
 ;;; A package contains a mail message, an envelope sender address,
 ;;; 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
 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
@@ -165,49 +195,42 @@ BUFFER may be a buffer or a buffer name which contains mail message."
 	(setq size (1+ size)))
       size)))
 
-;;; @ SMTP connection structure
+;;; @ 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-process (connection)
-  "Return the subprocess-object of CONNECTION."
-  `(aref ,connection 0))
-
-(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.")
 
-(defun smtp-connection-opened (connection)
-  "Say whether the CONNECTION to server has been opened."
-  (let ((process (smtp-connection-process connection)))
+(luna-define-generic smtp-close-connection (connection)
+  "Close the CONNECTION to server.")
+
+(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 +268,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 +279,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 +337,34 @@ 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))
+	  (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,7 +375,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-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)
@@ -311,6 +393,42 @@ of the host to connect to.  SERVICE is name of the service desired."
 	(smtp-primitive-quit package)
 	(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'
 ;;;
 
@@ -318,22 +436,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
@@ -347,21 +462,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
@@ -373,20 +484,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)))
+				   (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))
@@ -398,97 +509,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>" 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))))
+	 connection (buffer-substring (point) (progn (end-of-line)(point))))
 	(beginning-of-line 2)))
-    (smtp-send-command process ".")
-    (setq response (smtp-read-response process))
+    (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))))
 
@@ -509,14 +616,20 @@ 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 ((response-continue t)
+(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 (search-forward smtp-end-of-line nil t))
+	(accept-process-output (smtp-connection-process-internal connection))
 	(goto-char smtp-read-point))
+      (if decoder
+	  (let ((string (buffer-substring smtp-read-point (- (point) 2))))
+	    (delete-region smtp-read-point (point))
+	    (insert (funcall decoder string) smtp-end-of-line)))
       (setq response
 	    (nconc response
 		   (list (buffer-substring
@@ -530,21 +643,33 @@ of the host to connect to.  SERVICE is name of the service desired."
 		response-continue nil)))
     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)
-  ;; 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"))
+    (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 smtp-end-of-line))
+      (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) ?.)
+	(setq data (concat "." data smtp-end-of-line))
+      (setq data (concat data smtp-end-of-line)))
+    (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>."