From: ueno <ueno>
Date: Tue, 21 Nov 2000 20:15:29 +0000 (+0000)
Subject: Added experimental support for integrity encoder & decoder.
X-Git-Tag: deisui-1_14_0-2000-12-14~11
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b1f60e8f8ef16ac9d9420abb89158a65e1622f24;p=elisp%2Fflim.git

Added experimental support for integrity encoder & decoder.
I'm going to rewrite things again.

* sasl.el (sasl-client-set-encoder): New function.
(sasl-client-set-decoder): New function.
(sasl-client-encoder): New function.
(sasl-client-decoder): New function.

* sasl-digest.el: Require 'cl' when compiling.
(sasl-digest-md5-signing-encode-magic): New constant.
(sasl-digest-md5-signing-decode-magic): New constant.
(sasl-digest-md5-htonl-string): New function.
(sasl-digest-md5-make-integrity-encoder): New function.
(sasl-digest-md5-make-integrity-decoder): New function.
(sasl-digest-md5-ha1): New function.
(sasl-digest-md5-response-value): Accept the 1st argument `ha1'.
(sasl-digest-md5-response): Use `sasl-digest-md5-ha1'.
- Set integrity encoder and decoder of the client.

* smtp.el: Require `luna'.
(smtp-read-response): Accept `smtp-connection' object rather than
process-object.
(smtp-send-command): Likewise.
(smtp-send-data): Likewise.
---

diff --git a/ChangeLog b/ChangeLog
index 0456174..8b64201 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2000-11-21   Daiki Ueno  <ueno@unixuser.org>
+
+	* sasl.el (sasl-client-set-encoder): New function.
+	(sasl-client-set-decoder): New function.
+	(sasl-client-encoder): New function.
+	(sasl-client-decoder): New function.
+
+	* sasl-digest.el: Require 'cl' when compiling.
+	(sasl-digest-md5-signing-encode-magic): New constant.
+	(sasl-digest-md5-signing-decode-magic): New constant.
+	(sasl-digest-md5-htonl-string): New function.
+	(sasl-digest-md5-make-integrity-encoder): New function.
+	(sasl-digest-md5-make-integrity-decoder): New function.
+	(sasl-digest-md5-ha1): New function.
+	(sasl-digest-md5-response-value): Accept the 1st argument `ha1'.
+	(sasl-digest-md5-response): Use `sasl-digest-md5-ha1'.
+	- Set integrity encoder and decoder of the client.
+
+	* smtp.el: Require `luna'.
+	(smtp-read-response): Accept `smtp-connection' object rather than
+	process-object.
+	(smtp-send-command): Likewise.
+	(smtp-send-data): Likewise.
+
 2000-11-12   Daiki Ueno  <ueno@unixuser.org>
 
 	* luna.el (luna-define-method): Clear method cache.
diff --git a/sasl-digest.el b/sasl-digest.el
index 7454a74..9d10dd1 100644
--- a/sasl-digest.el
+++ b/sasl-digest.el
@@ -35,6 +35,8 @@
 (require 'sasl)
 (require 'hmac-md5)
 
+(eval-when-compile (require 'cl))
+
 (defvar sasl-digest-md5-nonce-count 1)
 (defvar sasl-digest-md5-unique-id-function
   sasl-unique-id-function)
@@ -77,58 +79,100 @@ charset algorithm cipher-opts auth-param)."
   (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function))
     (sasl-unique-id)))
 
-(defun sasl-digest-md5-response-value (username
-				       realm
-				       nonce
-				       cnonce
-				       nonce-count
-				       qop
-				       digest-uri
-				       authzid)
+(defconst sasl-digest-md5-signing-encode-magic
+  "Digest session key to client-to-server signing key magic constant")
+
+(defconst sasl-digest-md5-signing-decode-magic
+  "Digest session key to server-to-client signing key magic constant")
+
+(defun sasl-digest-md5-htonl-string (n)
+  (car
+   (read-from-string
+    (format "\"\\x%02x\\x%02x\\x%02x\\x%02x\""
+	    (logand n 255)
+	    (logand (lsh n -8) 255)
+	    (logand (lsh n -16) 255)
+	    (logand (lsh n -24) 255)))))
+
+(defun sasl-digest-md5-make-integrity-encoder (ha1)
+  (lexical-let ((key (md5-binary (concat ha1 sasl-digest-md5-signing-encode-magic)))
+		(seqnum 0))
+    (lambda (string)
+      (let ((seqnum-string (sasl-digest-md5-htonl-string seqnum)))
+	(prog1 (concat (sasl-digest-md5-htonl-string (+ (length string) 16))
+		       string (hmac-md5 key (concat seqnum-string string))
+		       "\x0\x1\x0\x0" seqnum-string)
+	  (setq seqnum (1+ seqnum)))))))
+
+(defun sasl-digest-md5-make-integrity-decoder (ha1)
+  (lexical-let ((key (md5-binary (concat ha1 sasl-digest-md5-signing-decode-magic)))
+		(seqnum 0))
+    (lambda (string)
+      (let ((seqnum-string (sasl-digest-md5-htonl-string seqnum))
+	    (mac (substring string (- (length string) 16))))
+	(setq string (substring string 4 (- (length string) 20)))
+	(or (string= (concat (hmac-md5 key (concat seqnum-string string))
+			     "\x0\x1\x0\x0" seqnum-string)
+		     mac)
+	    (sasl-error "MAC doesn't match"))
+	(setq seqnum (1+ seqnum))
+	string))))
+
+(defun sasl-digest-md5-ha1 (username realm nonce cnonce authzid)
   (let ((passphrase
 	 (sasl-read-passphrase
 	  (format "DIGEST-MD5 passphrase for %s: "
 		  username))))
     (unwind-protect
-	(encode-hex-string
-	 (md5-binary
-	  (concat
-	   (encode-hex-string
-	    (md5-binary (concat (md5-binary 
-				 (concat username ":" realm ":" passphrase))
-				":" nonce ":" cnonce
-				(if authzid 
-				    (concat ":" authzid)))))
-	   ":" nonce
-	   ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":"
-	   (encode-hex-string
-	    (md5-binary
-	     (concat "AUTHENTICATE:" digest-uri
-		     (if (member qop '("auth-int" "auth-conf"))
-			 ":00000000000000000000000000000000")))))))
+	(md5-binary
+	 (concat (md5-binary 
+		  (concat username ":" realm ":" passphrase))
+		 ":" nonce ":" cnonce
+		 (if authzid 
+		     (concat ":" authzid))))
       (fillarray passphrase 0))))
 
+(defun sasl-digest-md5-response-value (ha1 nonce cnonce nonce-count qop digest-uri)
+  (encode-hex-string
+   (md5-binary
+    (concat
+     (encode-hex-string ha1)
+     ":" nonce
+     ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":"
+     (encode-hex-string
+      (md5-binary
+       (concat "AUTHENTICATE:" digest-uri
+	       (if (member qop '("auth-int" "auth-conf"))
+		   ":00000000000000000000000000000000"))))))))
+
 (defun sasl-digest-md5-response (client step)
   (let* ((plist
 	  (sasl-digest-md5-parse-string (sasl-step-data step)))
 	 (realm
 	  (or (sasl-client-property client 'realm)
 	      (plist-get plist 'realm))) ;need to check
+	 (nonce (plist-get plist 'nonce))
+	 (cnonce
+	  (or (sasl-client-property client 'cnonce)
+	      (sasl-digest-md5-cnonce)))
 	 (nonce-count
 	  (or (sasl-client-property client 'nonce-count)
 	       sasl-digest-md5-nonce-count))
 	 (qop
 	  (or (sasl-client-property client 'qop)
-	      (setq qop "auth")))
+	      "auth"))
 	 (digest-uri
 	  (sasl-digest-md5-digest-uri
 	   (sasl-client-service client)(sasl-client-server client)))
-	 (cnonce
-	  (or (sasl-client-property client 'cnonce)
-	      (sasl-digest-md5-cnonce))))
+	 (ha1
+	  (sasl-digest-md5-ha1
+	   (sasl-client-name client) realm nonce cnonce (plist-get plist 'authzid))))
     (sasl-client-set-property client 'nonce-count (1+ nonce-count))
-    (unless (string= qop "auth")
-      (sasl-error (format "Unsupported \"qop-value\": %s" qop)))
+    (when (member qop '("auth-int" "auth-conf"))
+      (sasl-client-set-encoder
+       client (sasl-digest-md5-make-integrity-encoder ha1))
+      (sasl-client-set-decoder
+       client (sasl-digest-md5-make-integrity-decoder ha1)))
     (concat
      "username=\"" (sasl-client-name client) "\","
      "realm=\"" realm "\","
@@ -139,14 +183,7 @@ charset algorithm cipher-opts auth-param)."
      "qop=" qop ","
      "response="
      (sasl-digest-md5-response-value
-      (sasl-client-name client)
-      realm
-      (plist-get plist 'nonce)
-      cnonce
-      nonce-count
-      qop
-      digest-uri
-      (plist-get plist 'authzid)))))
+      ha1 nonce cnonce nonce-count qop digest-uri))))
 
 (put 'sasl-digest 'sasl-mechanism
      (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps))
diff --git a/sasl.el b/sasl.el
index 8528898..64158ed 100644
--- a/sasl.el
+++ b/sasl.el
@@ -61,7 +61,8 @@
   "Return a newly allocated SASL client.
 NAME is name of the authorization.  SERVICE is name of the service desired.
 SERVER is the fully qualified host name of the server to authenticate to."
-  (vector mechanism name service server (make-symbol "sasl-client-properties")))
+  (vector mechanism name service server (make-symbol "sasl-client-properties")
+	  nil nil))
 
 (defun sasl-client-mechanism (client)
   "Return the authentication mechanism driver of CLIENT."
@@ -96,6 +97,22 @@ The second argument PLIST is the new property list."
   "Return the properties of CLIENT."
   (symbol-plist (aref client 4)))
 
+(defun sasl-client-set-encoder (client encoder)
+  "Set integrity encoder of CLIENT."
+  (aset client 5 encoder))
+
+(defun sasl-client-set-decoder (client decoder)
+  "Set integrity decoder of CLIENT."
+  (aset client 6 decoder))
+
+(defun sasl-client-encoder (client)
+  "Return the integrity encoder of CLIENT."
+  (aref client 5))
+
+(defun sasl-client-decoder (client)
+  "Retrun the integrity decoder of CLIENT."
+  (aref client 6))
+
 ;;; @ SASL mechanism
 ;;;
 
diff --git a/smtp.el b/smtp.el
index 2a979d4..c781252 100644
--- a/smtp.el
+++ b/smtp.el
@@ -35,6 +35,7 @@
 (require 'pcustom)
 (require 'mail-utils)			; mail-strip-quoted-names
 (require 'sasl)
+(require 'luna)
 
 (defgroup smtp nil
   "SMTP protocol for sending mail."
@@ -120,36 +121,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
 ;;; 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 +162,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))
 
-(defun smtp-connection-opened (connection)
-  "Say whether the CONNECTION to server has been opened."
-  (let ((process (smtp-connection-process connection)))
+(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.")
+
+(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 ()
@@ -318,22 +308,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 +334,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 +356,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 +381,92 @@ 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 +487,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)
+	(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) "\r\n")))
       (setq response
 	    (nconc response
 		   (list (buffer-substring
@@ -530,21 +514,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 "\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) ?.)
+	(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>."