From: ueno Date: Sat, 4 Nov 2000 14:16:43 +0000 (+0000) Subject: * sasl.el: Don't require 'poe' X-Git-Tag: deisui-1_14_0-1~10 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a335cf219787aff40e90e8116337f090f403c703;p=elisp%2Fflim.git * sasl.el: Don't require 'poe' - Rename `sasl-*instantiator*' to `sasl-*client*'. - Rename `sasl-*authenticator*' to `sasl-*mechanism*'. - Rename `sasl-*continuations*' to `sasl-*steps*'. (sasl-make-client): Accept 1st argument `mechanism'. (sasl-next-step): Rename from `sasl-evaluate-challenge'. --- diff --git a/ChangeLog b/ChangeLog index 2a59cec..a5a1dc1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,14 @@ 2000-11-04 Daiki Ueno + * sasl.el: Don't require 'poe' + - Rename `sasl-*instantiator*' to `sasl-*client*'. + - Rename `sasl-*authenticator*' to `sasl-*mechanism*'. + - Rename `sasl-*continuations*' to `sasl-*steps*'. + (sasl-make-client): Accept 1st argument `mechanism'. + (sasl-next-step): Rename from `sasl-evaluate-challenge'. + +2000-11-04 Daiki Ueno + * sasl.el (sasl-make-instantiator): Define as function. (sasl-instantiator-name): Ditto. (sasl-instantiator-service): Ditto. diff --git a/sasl-cram.el b/sasl-cram.el index 8d9a79e..d778849 100644 --- a/sasl-cram.el +++ b/sasl-cram.el @@ -28,25 +28,23 @@ (require 'sasl) (require 'hmac-md5) -(defvar sasl-cram-md5-authenticator nil) - -(defconst sasl-cram-md5-continuations +(defconst sasl-cram-md5-steps '(ignore ;no initial response sasl-cram-md5-response)) -(defun sasl-cram-md5-response (instantiator challenge) +(defun sasl-cram-md5-response (client continuation) (let ((passphrase (sasl-read-passphrase (format "CRAM-MD5 passphrase for %s: " - (sasl-instantiator-name instantiator))))) + (sasl-client-name client))))) (unwind-protect - (concat (sasl-instantiator-name instantiator) " " + (concat (sasl-client-name client) " " (encode-hex-string - (hmac-md5 (nth 1 challenge) passphrase))) + (hmac-md5 (nth 1 continuation) passphrase))) (fillarray passphrase 0)))) -(put 'sasl-cram 'sasl-authenticator - (sasl-make-authenticator "CRAM-MD5" sasl-cram-md5-continuations)) +(put 'sasl-cram 'sasl-mechanism + (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps)) (provide 'sasl-cram) diff --git a/sasl-digest.el b/sasl-digest.el index 2af708d..1ca0ed9 100644 --- a/sasl-digest.el +++ b/sasl-digest.el @@ -35,8 +35,6 @@ (require 'sasl) (require 'hmac-md5) -(defvar sasl-digest-md5-authenticator nil) - (defvar sasl-digest-md5-challenge nil) (defvar sasl-digest-md5-nonce-count 1) (defvar sasl-digest-md5-unique-id-function @@ -49,7 +47,7 @@ table) "A syntax table for parsing digest-challenge attributes.") -(defconst sasl-digest-md5-continuations +(defconst sasl-digest-md5-steps '(ignore ;no initial response sasl-digest-md5-response ignore)) ;"" @@ -147,28 +145,28 @@ charset algorithm cipher-opts auth-param)." '(charset qop maxbuf cipher authzid))) ","))) -(defun sasl-digest-md5-response (instantiator challenge) - (sasl-digest-md5-parse-digest-challenge (nth 1 challenge)) +(defun sasl-digest-md5-response (client continuation) + (sasl-digest-md5-parse-digest-challenge (nth 1 continuation)) (let ((passphrase (sasl-read-passphrase (format "DIGEST-MD5 passphrase for %s: " - (sasl-instantiator-name instantiator))))) + (sasl-client-name client))))) (unwind-protect (sasl-digest-md5-build-response-value - (sasl-instantiator-name instantiator) - (or (sasl-instantiator-property instantiator 'realm) + (sasl-client-name client) + (or (sasl-client-property client 'realm) (sasl-digest-md5-challenge 'realm)) ;need to check passphrase (sasl-digest-md5-challenge 'nonce) (sasl-digest-md5-cnonce) sasl-digest-md5-nonce-count (sasl-digest-md5-digest-uri - (sasl-instantiator-service instantiator) - (sasl-instantiator-server instantiator))) + (sasl-client-service client) + (sasl-client-server client))) (fillarray passphrase 0)))) -(put 'sasl-digest 'sasl-authenticator - (sasl-make-authenticator "DIGEST-MD5" sasl-digest-md5-continuations)) +(put 'sasl-digest 'sasl-mechanism + (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps)) (provide 'sasl-digest) diff --git a/sasl.el b/sasl.el index 97beeee..ae19306 100644 --- a/sasl.el +++ b/sasl.el @@ -36,8 +36,6 @@ ;;; Code: -(require 'poe) - (defvar sasl-mechanisms '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS")) @@ -56,69 +54,73 @@ (defun sasl-error (datum) (signal 'sasl-error (list datum))) -;;; @ SASL instantiator +;;; @ SASL client ;;; -(defun sasl-make-instantiator (name service server) - "Return a newly allocated SASL instantiator. +(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 name service server (make-symbol "sasl-instantiator-properties"))) + (vector mechanism name service server (make-symbol "sasl-client-properties"))) + +(defun sasl-client-mechanism (client) + "Return the authentication mechanism driver of CLIENT." + (aref client 0)) -(defun sasl-instantiator-name (instantiator) - "Return the authorization name of INSTANTIATOR, a string." - (aref instantiator 0)) +(defun sasl-client-name (client) + "Return the authorization name of CLIENT, a string." + (aref client 1)) -(defun sasl-instantiator-service (instantiator) - "Return the service name of INSTANTIATOR, a string." - (aref instantiator 1)) +(defun sasl-client-service (client) + "Return the service name of CLIENT, a string." + (aref client 2)) -(defun sasl-instantiator-server (instantiator) - "Return the server name of INSTANTIATOR, a string." - (aref instantiator 2)) +(defun sasl-client-server (client) + "Return the server name of CLIENT, a string." + (aref client 3)) -(defun sasl-instantiator-set-properties (instantiator plist) - "Destructively set the properties of INSTANTIATOR. +(defun sasl-client-set-properties (client plist) + "Destructively set the properties of CLIENT. The second argument PLIST is the new property list." - (setplist (aref instantiator 3) plist)) + (setplist (aref client 4) plist)) -(defun sasl-instantiator-set-property (instantiator property value) - "Add the given property/value to INSTANTIATOR." - (put (aref instantiator 3) property value)) +(defun sasl-client-set-property (client property value) + "Add the given property/value to CLIENT." + (put (aref client 4) property value)) -(defun sasl-instantiator-property (instantiator property) - "Return the value of the PROPERTY of INSTANTIATOR." - (get (aref instantiator 3) property)) +(defun sasl-client-property (client property) + "Return the value of the PROPERTY of CLIENT." + (get (aref client 4) property)) -(defun sasl-instantiator-properties (instantiator) - "Return the properties of INSTANTIATOR." - (symbol-plist (aref instantiator 3))) +(defun sasl-client-properties (client) + "Return the properties of CLIENT." + (symbol-plist (aref client 4))) -;;; @ SASL authenticator +;;; @ SASL mechanism ;;; -(defun sasl-make-authenticator (mechanism continuations) +(defun sasl-make-mechanism (name steps) "Make an authenticator. -MECHANISM is a IANA registered SASL mechanism name. -CONTINUATIONS is list of continuation function." - (vector mechanism +NAME is a IANA registered SASL mechanism name. +STEPS is list of continuation function." + (vector name (mapcar - (lambda (continuation) - (let ((symbol (make-symbol (symbol-name continuation)))) - (fset symbol (symbol-function continuation)) + (lambda (step) + (let ((symbol (make-symbol (symbol-name step)))) + (fset symbol (symbol-function step)) symbol)) - continuations))) + steps))) -(defun sasl-authenticator-mechanism (authenticator) - "Return name of the mechanism AUTHENTICATOR supports, a string." - (aref authenticator 0)) +(defun sasl-mechanism-name (mechanism) + "Return name of MECHANISM, a string." + (aref mechanism 0)) -(defun sasl-authenticator-continuations (authenticator) - "Return continuation steps of AUTHENTICATOR, a list of functions." - (aref authenticator 1)) +(defun sasl-mechanism-steps (mechanism) + "Return the authentication steps of MECHANISM, a list of functions." + (aref mechanism 1)) -(defun sasl-find-authenticator (mechanisms) - "Retrieve an apropriate authenticator object from MECHANISMS hints." +(defun sasl-find-mechanism (mechanisms) + "Retrieve an apropriate mechanism object from MECHANISMS hints." (let* ((sasl-mechanisms sasl-mechanisms) (mechanism (catch 'done @@ -127,26 +129,24 @@ CONTINUATIONS is list of continuation function." (throw 'done (nth 1 (assoc (car sasl-mechanisms) sasl-mechanism-alist)))) (setq sasl-mechanisms (cdr sasl-mechanisms)))))) - (when mechanism - (require mechanism) - (get mechanism 'sasl-authenticator)))) + (if mechanism + (require mechanism)) + (get mechanism 'sasl-mechanism))) -(defun sasl-evaluate-challenge (authenticator instantiator &optional challenge) +(defun sasl-next-step (client continuation) "Evaluate the challenge and prepare an appropriate next response. -The data type of the value and optional 3rd argument CHALLENGE is nil or -a cons cell of the form \(CONTINUATION STRING). -At the first time CONTINUATION should be set to nil. - -Argument AUTHENTICATOR is the current evaluator. -Argument INSTANTIATOR is the instantiator instantiator." - (let* ((continuations - (sasl-authenticator-continuations authenticator)) +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." + (let* ((steps + (sasl-mechanism-steps + (sasl-client-mechanism client))) (function - (if (car challenge) - (nth 1 (memq (car challenge) continuations)) - (car continuations)))) + (if (car continuation) + (nth 1 (memq (car continuation) steps)) + (car steps)))) (if function - (list function (funcall function instantiator challenge))))) + (list function (funcall function client continuation))))) (defvar sasl-read-passphrase nil) (defun sasl-read-passphrase (prompt) @@ -194,64 +194,62 @@ It contain at least 64 bits of entropy." (% num 36)))))) ;;; PLAIN (RFC2595 Section 6) -(defconst sasl-plain-continuations +(defconst sasl-plain-steps '(sasl-plain-response)) -(defun sasl-plain-response (instantiator challenge) +(defun sasl-plain-response (client continuation) (let ((passphrase (sasl-read-passphrase - (format "PLAIN passphrase for %s: " - (sasl-instantiator-name instantiator)))) - (authentication-name - (sasl-instantiator-property - instantiator 'authentication-name)) - (name (sasl-instantiator-name instantiator))) + (format "PLAIN passphrase for %s: " (sasl-client-name client)))) + (authenticator-name + (sasl-client-property + client 'authenticator-name)) + (name (sasl-client-name client))) (unwind-protect - (if (and authentication-name - (not (string= authentication-name name))) - (concat authentication-name "\0" name "\0" passphrase) + (if (and authenticator-name + (not (string= authenticator-name name))) + (concat authenticator-name "\0" name "\0" passphrase) (concat "\0" name "\0" passphrase)) (fillarray passphrase 0)))) -(put 'sasl-plain 'sasl-authenticator - (sasl-make-authenticator "PLAIN" sasl-plain-continuations)) +(put 'sasl-plain 'sasl-mechanism + (sasl-make-mechanism "PLAIN" sasl-plain-steps)) (provide 'sasl-plain) ;;; LOGIN (No specification exists) -(defconst sasl-login-continuations +(defconst sasl-login-steps '(ignore ;no initial response sasl-login-response-1 sasl-login-response-2)) -(defun sasl-login-response-1 (instantiator challenge) - (unless (string= (nth 1 challenge) "Username:") - (sasl-error (format "Unexpected response: %s" (nth 1 challenge)))) - (sasl-instantiator-name instantiator)) +(defun sasl-login-response-1 (client continuation) + (or (string= (nth 1 continuation) "Username:") + (sasl-error (format "Unexpected response: %s" (nth 1 continuation)))) + (sasl-client-name client)) -(defun sasl-login-response-2 (instantiator challenge) - (unless (string= (nth 1 challenge) "Password:") - (sasl-error (format "Unexpected response: %s" (nth 1 challenge)))) +(defun sasl-login-response-2 (client continuation) + (or (string= (nth 1 continuation) "Password:") + (sasl-error (format "Unexpected response: %s" (nth 1 continuation)))) (sasl-read-passphrase - (format "LOGIN passphrase for %s: " (sasl-instantiator-name instantiator)))) + (format "LOGIN passphrase for %s: " (sasl-client-name client)))) -(put 'sasl-login 'sasl-authenticator - (sasl-make-authenticator "LOGIN" sasl-login-continuations)) +(put 'sasl-login 'sasl-mechanism + (sasl-make-mechanism "LOGIN" sasl-login-steps)) (provide 'sasl-login) ;;; ANONYMOUS (RFC2245) -(defconst sasl-anonymous-continuations +(defconst sasl-anonymous-steps '(identity ;no initial response sasl-anonymous-response)) -(defun sasl-anonymous-response (instantiator challenge) - (or (sasl-instantiator-property - instantiator 'trace) - (sasl-instantiator-name instantiator))) +(defun sasl-anonymous-response (client continuation) + (or (sasl-client-property client 'trace) + (sasl-client-name client))) -(put 'sasl-anonymous 'sasl-authenticator - (sasl-make-authenticator "ANONYMOUS" sasl-anonymous-continuations)) +(put 'sasl-anonymous 'sasl-mechanism + (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps)) (provide 'sasl-anonymous) diff --git a/smtp.el b/smtp.el index 432add8..e79ae36 100644 --- a/smtp.el +++ b/smtp.el @@ -34,6 +34,7 @@ (require 'pces) (require 'pcustom) (require 'mail-utils) ; mail-strip-quoted-names +(require 'sasl) (defgroup smtp nil "SMTP protocol for sending mail." @@ -355,12 +356,6 @@ of the host to connect to. SERVICE is name of the service desired." (if (/= (car response) 250) (smtp-response-error response)))) -(eval-and-compile - (autoload 'sasl-make-instantiator "sasl") - (autoload 'sasl-find-authenticator "sasl") - (autoload 'sasl-authenticator-mechanism "sasl") - (autoload 'sasl-evaluate-challenge "sasl")) - (defun smtp-primitive-auth (package) (let* ((connection (smtp-find-connection (current-buffer))) @@ -370,47 +365,42 @@ of the host to connect to. SERVICE is name of the service desired." (cdr (assq 'auth (smtp-connection-extensions connection)))) (sasl-mechanisms (or smtp-sasl-mechanisms sasl-mechanisms)) - (authenticator - (sasl-find-authenticator mechanisms)) - instantiator - mechanism - sasl-response + (mechanism + (sasl-find-mechanism mechanisms)) + client + name + continuation response) - (unless authenticator + (unless mechanism (error "No authentication mechanism available")) - (setq instantiator - (sasl-make-instantiator - smtp-sasl-user-name "smtp" (smtp-connection-server connection))) + (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp" + (smtp-connection-server connection))) (if smtp-sasl-user-realm - (sasl-instantiator-set-property - instantiator 'realm smtp-sasl-user-realm)) - (setq mechanism (sasl-authenticator-mechanism authenticator) + (sasl-client-set-property client 'realm smtp-sasl-user-realm)) + (setq name (sasl-mechanism-name mechanism) ;; Retrieve the initial response - sasl-response (sasl-evaluate-challenge authenticator instantiator)) + continuation (sasl-next-step client nil)) (smtp-send-command process - (if (nth 1 sasl-response) - (format "AUTH %s %s" mechanism (base64-encode-string (nth 1 sasl-response) t)) - (format "AUTH %s" mechanism))) + (if (nth 1 continuation) + (format "AUTH %s %s" name (base64-encode-string (nth 1 continuation) 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 sasl-response - (sasl-evaluate-challenge authenticator instantiator sasl-response)) - (if (null sasl-response) + (setq continuation (sasl-next-step client continuation)) + (if (null continuation) (throw 'done nil)) (smtp-response-error response)) ;Bogus server? (if (/= (car response) 334) (smtp-response-error response)) - (setcar (cdr sasl-response) (base64-decode-string (nth 1 response))) - (setq sasl-response - (sasl-evaluate-challenge - authenticator instantiator sasl-response)) + (setcar (cdr continuation) (base64-decode-string (nth 1 response))) + (setq continuation (sasl-next-step client continuation)) (smtp-send-command - process (if (nth 1 sasl-response) - (base64-encode-string (nth 1 sasl-response) t) + process (if (nth 1 continuation) + (base64-encode-string (nth 1 continuation) t) "")))))) (defun smtp-primitive-starttls (package)