From 023c29b362296f40e6af5330e0bcdf4c2f10ffac Mon Sep 17 00:00:00 2001 From: ueno Date: Sun, 5 Nov 2000 04:37:41 +0000 Subject: [PATCH] * sasl.el (sasl-step-data): New function. (sasl-step-set-data): New function. --- ChangeLog | 5 +++++ sasl-cram.el | 4 ++-- sasl-digest.el | 4 ++-- sasl.el | 44 +++++++++++++++++++++++++++++--------------- smtp.el | 20 ++++++++++---------- 5 files changed, 48 insertions(+), 29 deletions(-) diff --git a/ChangeLog b/ChangeLog index a5a1dc1..80caf0e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2000-11-05 Daiki Ueno + + * sasl.el (sasl-step-data): New function. + (sasl-step-set-data): New function. + 2000-11-04 Daiki Ueno * 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) -- 1.7.10.4