From: ueno <ueno>
Date: Tue, 12 Dec 2000 07:11:51 +0000 (+0000)
Subject: * sasl.el: Rewrite with luna.
X-Git-Tag: deisui-1_14_0-2000-12-14~1
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=7ca927e953b826cf74a13ea44a65fe05c0744739;p=elisp%2Fflim.git

* sasl.el: Rewrite with luna.

This version of the SASL implementation is transitional.
Please do not use with Wanderlust.
---

diff --git a/sasl-digest.el b/sasl-digest.el
index 9d10dd1..abf76d3 100644
--- a/sasl-digest.el
+++ b/sasl-digest.el
@@ -168,11 +168,11 @@ charset algorithm cipher-opts auth-param)."
 	  (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))
-    (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)))
+;;;    (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 "\","
diff --git a/sasl.el b/sasl.el
index 64158ed..8fd894b 100644
--- a/sasl.el
+++ b/sasl.el
@@ -36,6 +36,8 @@
 
 ;;; Code:
 
+(require 'luna)
+
 (defvar sasl-mechanisms
   '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"))
 
@@ -57,84 +59,95 @@
 ;;; @ SASL client
 ;;;
 
+(eval-and-compile
+  (luna-define-class sasl-client ()
+		     (mechanism
+		      name
+		      service
+		      server
+		      properties))
+
+  (luna-define-internal-accessors 'sasl-client))
+
 (defun sasl-make-client (mechanism name service server)
   "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")
-	  nil nil))
+  (luna-make-entity 'sasl-client
+		    :mechanism mechanism
+		    :name name
+		    :service service
+		    :server server))
 
 (defun sasl-client-mechanism (client)
   "Return the authentication mechanism driver of CLIENT."
-  (aref client 0))
+  (sasl-client-mechanism-internal client))
 
 (defun sasl-client-name (client)
   "Return the authorization name of CLIENT, a string."
-  (aref client 1))
+  (sasl-client-name-internal client))
 
 (defun sasl-client-service (client)
   "Return the service name of CLIENT, a string."
-  (aref client 2))
+  (sasl-client-service-internal client))
 
 (defun sasl-client-server (client)
   "Return the server name of CLIENT, a string."
-  (aref client 3))
+  (sasl-client-server-internal client))
 
 (defun sasl-client-set-properties (client plist)
   "Destructively set the properties of CLIENT.
 The second argument PLIST is the new property list."
-  (setplist (aref client 4) plist))
+  (sasl-client-set-properties-internal client plist))
 
 (defun sasl-client-set-property (client property value)
   "Add the given property/value to CLIENT."
-  (put (aref client 4) property value))
+  (sasl-client-set-properties-internal
+   client (plist-put (sasl-client-properties-internal client) property value)))
 
 (defun sasl-client-property (client property)
   "Return the value of the PROPERTY of CLIENT."
-  (get (aref client 4) property))
+  (plist-get (sasl-client-properties-internal client) property))
 
 (defun sasl-client-properties (client)
   "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-client-properties-internal client))
 
 ;;; @ SASL mechanism
 ;;;
 
+(eval-and-compile
+  (luna-define-class sasl-mechanism ()
+		     (name
+		      steps))
+
+  (luna-define-internal-accessors 'sasl-mechanism))
+
+(luna-define-method initialize-instance :after ((mechanism sasl-mechanism)
+						&rest init-args)
+  (sasl-mechanism-set-steps-internal
+   mechanism
+   (mapcar
+    (lambda (step)
+      (let ((symbol (make-symbol (symbol-name step))))
+	(fset symbol (symbol-function step))
+	symbol))
+    (sasl-mechanism-steps-internal mechanism)))
+  mechanism)
+
 (defun sasl-make-mechanism (name steps)
   "Make an authentication mechanism.
 NAME is a IANA registered SASL mechanism name.
 STEPS is list of continuation function."
-  (vector name
-	  (mapcar
-	   (lambda (step)
-	     (let ((symbol (make-symbol (symbol-name step))))
-	       (fset symbol (symbol-function step))
-	       symbol))
-	   steps)))
+  (luna-make-entity 'sasl-mechanism :name name :steps steps))
 
 (defun sasl-mechanism-name (mechanism)
   "Return name of MECHANISM, a string."
-  (aref mechanism 0))
+  (sasl-mechanism-name-internal mechanism))
 
 (defun sasl-mechanism-steps (mechanism)
   "Return the authentication steps of MECHANISM, a list of functions."
-  (aref mechanism 1))
+  (sasl-mechanism-steps-internal mechanism))
 
 (defun sasl-find-mechanism (mechanisms)
   "Retrieve an apropriate mechanism object from MECHANISMS hints."
@@ -153,13 +166,21 @@ STEPS is list of continuation function."
 ;;; @ SASL authentication step
 ;;;
 
+(eval-and-compile
+  (luna-define-class sasl-step ()
+		     (continuation
+		      data))
+		      
+
+  (luna-define-internal-accessors 'sasl-step))
+
 (defun sasl-step-data (step)
   "Return the data which STEP holds, a string."
-  (aref step 1))
+  (sasl-step-data-internal step))
 
 (defun sasl-step-set-data (step data)
   "Store DATA string to STEP."
-  (aset step 1 data))
+  (sasl-step-set-data-internal step data))
 
 (defun sasl-next-step (client step)
   "Evaluate the challenge and prepare an appropriate next response.
@@ -168,13 +189,15 @@ opaque authentication step which holds the reference to the next action
 and the current challenge.  At the first time STEP should be set to nil."
   (let* ((steps
 	  (sasl-mechanism-steps
-	   (sasl-client-mechanism client)))
+	   (sasl-client-mechanism-internal client)))
 	 (function
-	  (if (vectorp step)
-	      (nth 1 (memq (aref step 0) steps))
-	    (car steps))))
+	  (if (null step)
+	      (car steps)
+	    (nth 1 (memq (sasl-step-continuation-internal step) steps)))))
     (if function
-	(vector function (funcall function client step)))))
+	(luna-make-entity 'sasl-step
+			  :continuation function
+			  :data (funcall function client step)))))
 
 (defvar sasl-read-passphrase nil)
 (defun sasl-read-passphrase (prompt)
diff --git a/smtp.el b/smtp.el
index c781252..7e22426 100644
--- a/smtp.el
+++ b/smtp.el
@@ -385,10 +385,11 @@ of the host to connect to.  SERVICE is name of the service desired."
 	 (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))))
+;;;    (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