From: ueno <ueno>
Date: Sun, 5 Nov 2000 04:37:41 +0000 (+0000)
Subject: * sasl.el (sasl-step-data): New function.
X-Git-Tag: deisui-1_14_0-1~9
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=023c29b362296f40e6af5330e0bcdf4c2f10ffac;p=elisp%2Fflim.git

* sasl.el (sasl-step-data): New function.
(sasl-step-set-data): New function.
---

diff --git a/ChangeLog b/ChangeLog
index a5a1dc1..80caf0e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2000-11-05   Daiki Ueno  <ueno@unixuser.org>
+
+	* sasl.el (sasl-step-data): New function.
+	(sasl-step-set-data): New function.
+
 2000-11-04   Daiki Ueno  <ueno@unixuser.org>
 
 	* sasl.el: Don't require 'poe'
diff --git a/sasl-cram.el b/sasl-cram.el
index d778849..a9db4a6 100644
--- a/sasl-cram.el
+++ b/sasl-cram.el
@@ -32,7 +32,7 @@
   '(ignore				;no initial response
     sasl-cram-md5-response))
 
-(defun sasl-cram-md5-response (client continuation)
+(defun sasl-cram-md5-response (client step)
   (let ((passphrase
 	 (sasl-read-passphrase
 	  (format "CRAM-MD5 passphrase for %s: "
@@ -40,7 +40,7 @@
     (unwind-protect
 	(concat (sasl-client-name client) " "
 		(encode-hex-string
-		 (hmac-md5 (nth 1 continuation) passphrase)))
+		 (hmac-md5 (sasl-step-data step) passphrase)))
       (fillarray passphrase 0))))
 
 (put 'sasl-cram 'sasl-mechanism
diff --git a/sasl-digest.el b/sasl-digest.el
index 1ca0ed9..a3804a0 100644
--- a/sasl-digest.el
+++ b/sasl-digest.el
@@ -145,8 +145,8 @@ charset algorithm cipher-opts auth-param)."
 		  '(charset qop maxbuf cipher authzid)))
     ",")))
 
-(defun sasl-digest-md5-response (client continuation)
-  (sasl-digest-md5-parse-digest-challenge (nth 1 continuation))
+(defun sasl-digest-md5-response (client step)
+  (sasl-digest-md5-parse-digest-challenge (sasl-step-data step))
   (let ((passphrase
 	 (sasl-read-passphrase
 	  (format "DIGEST-MD5 passphrase for %s: "
diff --git a/sasl.el b/sasl.el
index ae19306..3d884e5 100644
--- a/sasl.el
+++ b/sasl.el
@@ -133,20 +133,34 @@ STEPS is list of continuation function."
 	(require mechanism))
     (get mechanism 'sasl-mechanism)))
 
-(defun sasl-next-step (client continuation)
+;;; @ SASL authentication step
+;;;
+
+(defun sasl-step-data (step)
+  "Return the data which STEP holds, a string."
+  (if (vectorp step)
+      (aref step 1)))
+
+(defun sasl-step-set-data (step data)
+  "Store DATA string to STEP."
+  (if (vectorp step)
+      (aset step 1 data)
+    (vector nil data)))
+
+(defun sasl-next-step (client step)
   "Evaluate the challenge and prepare an appropriate next response.
-The data type of the value and optional 3rd argument CONTINUATION is nil or
-a cons cell of the form \(STEP RESPONSE-OR-CHALLENGE).
-At the first time STEP should be set to nil."
+The data type of the value and optional 2nd argument STEP is nil or
+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)))
 	 (function
-	  (if (car continuation)
-	      (nth 1 (memq (car continuation) steps))
+	  (if (vectorp step)
+	      (nth 1 (memq (aref step 0) steps))
 	    (car steps))))
     (if function
-	(list function (funcall function client continuation)))))
+	(vector function (funcall function client step)))))
 
 (defvar sasl-read-passphrase nil)
 (defun sasl-read-passphrase (prompt)
@@ -197,7 +211,7 @@ It contain at least 64 bits of entropy."
 (defconst sasl-plain-steps
   '(sasl-plain-response))
 
-(defun sasl-plain-response (client continuation)
+(defun sasl-plain-response (client step)
   (let ((passphrase
 	 (sasl-read-passphrase
 	  (format "PLAIN passphrase for %s: " (sasl-client-name client))))
@@ -223,14 +237,14 @@ It contain at least 64 bits of entropy."
     sasl-login-response-1
     sasl-login-response-2))
 
-(defun sasl-login-response-1 (client continuation)
-  (or (string= (nth 1 continuation) "Username:")
-      (sasl-error (format "Unexpected response: %s" (nth 1 continuation))))
+(defun sasl-login-response-1 (client step)
+  (unless (string= (sasl-step-data step) "Username:")
+    (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
   (sasl-client-name client))
 
-(defun sasl-login-response-2 (client continuation)
-  (or (string= (nth 1 continuation) "Password:")
-      (sasl-error (format "Unexpected response: %s" (nth 1 continuation))))
+(defun sasl-login-response-2 (client step)
+  (unless (string= (sasl-step-data step) "Password:")
+    (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
   (sasl-read-passphrase
    (format "LOGIN passphrase for %s: " (sasl-client-name client))))
 
@@ -244,7 +258,7 @@ It contain at least 64 bits of entropy."
   '(identity				;no initial response
     sasl-anonymous-response))
 
-(defun sasl-anonymous-response (client continuation)
+(defun sasl-anonymous-response (client step)
   (or (sasl-client-property client 'trace)
       (sasl-client-name client)))
 
diff --git a/smtp.el b/smtp.el
index e79ae36..0e9b28e 100644
--- a/smtp.el
+++ b/smtp.el
@@ -369,7 +369,7 @@ of the host to connect to.  SERVICE is name of the service desired."
 	  (sasl-find-mechanism mechanisms))
 	 client
 	 name
-	 continuation
+	 step
 	 response)
     (unless mechanism
       (error "No authentication mechanism available"))
@@ -379,28 +379,28 @@ of the host to connect to.  SERVICE is name of the service desired."
 	(sasl-client-set-property client 'realm smtp-sasl-user-realm))
     (setq name (sasl-mechanism-name mechanism)
 	  ;; Retrieve the initial response
-	  continuation (sasl-next-step client nil))
+	  step (sasl-next-step client nil))
     (smtp-send-command
      process
-     (if (nth 1 continuation)
-	 (format "AUTH %s %s" name (base64-encode-string (nth 1 continuation) 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))
 	(when (= (car response) 235)
 	  ;; The authentication process is finished.
-	  (setq continuation (sasl-next-step client continuation))
-	  (if (null continuation)
+	  (setq step (sasl-next-step client step))
+	  (if (null step)
 	      (throw 'done nil))
 	  (smtp-response-error response)) ;Bogus server?
 	(if (/= (car response) 334)
 	    (smtp-response-error response))
-	(setcar (cdr continuation) (base64-decode-string (nth 1 response)))
-	(setq continuation (sasl-next-step client continuation))
+	(sasl-step-set-data step (base64-decode-string (nth 1 response)))
+	(setq step (sasl-next-step client step))
 	(smtp-send-command
-	 process (if (nth 1 continuation)
-		     (base64-encode-string (nth 1 continuation) t)
+	 process (if (sasl-step-data step)
+		     (base64-encode-string (sasl-step-data step) t)
 		   ""))))))
 
 (defun smtp-primitive-starttls (package)