From e9955ce18f31fbd05abe45da288a2f95197ccb41 Mon Sep 17 00:00:00 2001 From: ueno Date: Thu, 2 Nov 2000 17:36:39 +0000 Subject: [PATCH] * sasl.el: Rename `sasl-*principal*' to `sasl-*instantiator*'. (sasl-make-instantiator): Abolish optional 4th argument. (sasl-instantiator-set-properties): New function. (sasl-instantiator-put-property): New function. (sasl-instantiator-property): New function. (sasl-instantiator-properties): New function. * smtp.el (smtp-sasl-user-name): Rename from `smtp-sasl-principal-user'. (smtp-sasl-user-realm): Rename from `smtp-sasl-principal-realm'. --- ChangeLog | 13 ++++++++ sasl-cram.el | 7 ++-- sasl-digest.el | 12 ++++--- sasl.el | 99 +++++++++++++++++++++++++++++++++++++++----------------- smtp.el | 31 ++++++++++-------- 5 files changed, 111 insertions(+), 51 deletions(-) diff --git a/ChangeLog b/ChangeLog index e7d1e8b..10f8295 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,18 @@ 2000-11-02 Daiki Ueno + * sasl.el: Rename `sasl-*principal*' to `sasl-*instantiator*'. + (sasl-make-instantiator): Abolish optional 4th argument. + (sasl-instantiator-set-properties): New function. + (sasl-instantiator-put-property): New function. + (sasl-instantiator-property): New function. + (sasl-instantiator-properties): New function. + + * smtp.el (smtp-sasl-user-name): Rename from + `smtp-sasl-principal-user'. + (smtp-sasl-user-realm): Rename from `smtp-sasl-principal-realm'. + +2000-11-02 Daiki Ueno + * sasl.el (sasl-mechanisms): Add `LOGIN' and `ANONYMOUS'. (sasl-mechanism-alist): Likewise. (sasl-error): Define. diff --git a/sasl-cram.el b/sasl-cram.el index b1bfa8a..8d9a79e 100644 --- a/sasl-cram.el +++ b/sasl-cram.el @@ -34,12 +34,13 @@ '(ignore ;no initial response sasl-cram-md5-response)) -(defun sasl-cram-md5-response (principal challenge) +(defun sasl-cram-md5-response (instantiator challenge) (let ((passphrase (sasl-read-passphrase - (format "CRAM-MD5 passphrase for %s: " (sasl-principal-name principal))))) + (format "CRAM-MD5 passphrase for %s: " + (sasl-instantiator-name instantiator))))) (unwind-protect - (concat (sasl-principal-name principal) " " + (concat (sasl-instantiator-name instantiator) " " (encode-hex-string (hmac-md5 (nth 1 challenge) passphrase))) (fillarray passphrase 0)))) diff --git a/sasl-digest.el b/sasl-digest.el index c25d665..2af708d 100644 --- a/sasl-digest.el +++ b/sasl-digest.el @@ -147,22 +147,24 @@ charset algorithm cipher-opts auth-param)." '(charset qop maxbuf cipher authzid))) ","))) -(defun sasl-digest-md5-response (principal challenge) +(defun sasl-digest-md5-response (instantiator challenge) (sasl-digest-md5-parse-digest-challenge (nth 1 challenge)) (let ((passphrase (sasl-read-passphrase - (format "DIGEST-MD5 passphrase for %s: " (sasl-principal-name principal))))) + (format "DIGEST-MD5 passphrase for %s: " + (sasl-instantiator-name instantiator))))) (unwind-protect (sasl-digest-md5-build-response-value - (sasl-principal-name principal) - (or (sasl-principal-realm principal) + (sasl-instantiator-name instantiator) + (or (sasl-instantiator-property instantiator '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-principal-service principal) (sasl-principal-server principal))) + (sasl-instantiator-service instantiator) + (sasl-instantiator-server instantiator))) (fillarray passphrase 0)))) (put 'sasl-digest 'sasl-authenticator diff --git a/sasl.el b/sasl.el index 370ff7a..4cc628b 100644 --- a/sasl.el +++ b/sasl.el @@ -41,32 +41,53 @@ (defvar sasl-unique-id-function #'sasl-unique-id-function) -(defmacro sasl-authenticator-mechanism (authenticator) - `(aref ,authenticator 0)) +(put 'sasl-error 'error-message "SASL error") +(put 'sasl-error 'error-conditions '(sasl-error error)) -(defmacro sasl-authenticator-continuations (authenticator) - `(aref ,authenticator 1)) +(defun sasl-error (datum) + (signal 'sasl-error (list datum))) -(defmacro sasl-make-principal (name service server &optional realm) - `(vector ,name ,realm ,service ,server)) +;;; @ SASL instantiator +;;; -(defmacro sasl-principal-name (principal) - `(aref ,principal 0)) +(defmacro sasl-make-instantiator (name service server) + "Return a newly allocated SASL instantiator. +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." + (let ((props (make-symbol "sasl-instantiator-properties"))) + `(vector ,name ,service ,server ',props))) -(defmacro sasl-principal-realm (principal) - `(aref ,principal 1)) +(defmacro sasl-instantiator-name (instantiator) + "Return the authorization name of INSTANTIATOR, a string." + `(aref ,instantiator 0)) -(defmacro sasl-principal-service (principal) - `(aref ,principal 2)) +(defmacro sasl-instantiator-service (instantiator) + "Return the service name of INSTANTIATOR, a string." + `(aref ,instantiator 1)) -(defmacro sasl-principal-server (principal) - `(aref ,principal 3)) +(defmacro sasl-instantiator-server (instantiator) + "Return the server name of INSTANTIATOR, a string." + `(aref ,instantiator 2)) -(put 'sasl-error 'error-message "SASL error") -(put 'sasl-error 'error-conditions '(sasl-error error)) +(defmacro sasl-instantiator-set-properties (instantiator plist) + "Destructively set the properties of INSTANTIATOR. +The second argument PLIST is the new property list." + `(setplist (aref ,instantiator 3) ,plist)) -(defun sasl-error (datum) - (signal 'sasl-error (list datum))) +(defmacro sasl-instantiator-put-property (instantiator property value) + "Add the given property/value to INSTANTIATOR." + `(put (aref ,instantiator 3) ,property ,value)) + +(defmacro sasl-instantiator-property (instantiator property) + "Return the value of the PROPERTY of INSTANTIATOR." + `(get (aref ,instantiator 3) ,property)) + +(defmacro sasl-instantiator-properties (instantiator) + "Return the properties of INSTANTIATOR." + `(symbol-plist (aref ,instantiator 3))) + +;;; @ SASL authenticator +;;; (defun sasl-make-authenticator (mechanism continuations) "Make an authenticator. @@ -80,6 +101,14 @@ CONTINUATIONS is list of continuation function." symbol)) continuations))) +(defmacro sasl-authenticator-mechanism (authenticator) + "Return name of the mechanism AUTHENTICATOR supports, a string." + `(aref ,authenticator 0)) + +(defmacro sasl-authenticator-continuations (authenticator) + "Return continuation steps of AUTHENTICATOR, a list of functions." + `(aref ,authenticator 1)) + (defun sasl-find-authenticator (mechanisms) "Retrieve an apropriate authenticator object from MECHANISMS hints." (let* ((sasl-mechanisms sasl-mechanisms) @@ -94,14 +123,14 @@ CONTINUATIONS is list of continuation function." (require mechanism) (get mechanism 'sasl-authenticator)))) -(defun sasl-evaluate-challenge (authenticator principal &optional challenge) +(defun sasl-evaluate-challenge (authenticator instantiator &optional challenge) "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 PRINCIPAL is the client principal." +Argument INSTANTIATOR is the instantiator instantiator." (let* ((continuations (sasl-authenticator-continuations authenticator)) (function @@ -109,7 +138,7 @@ Argument PRINCIPAL is the client principal." (nth 1 (memq (car challenge) continuations)) (car continuations)))) (if function - (list function (funcall function principal challenge))))) + (list function (funcall function instantiator challenge))))) (defvar sasl-read-passphrase nil) (defun sasl-read-passphrase (prompt &optional key) @@ -160,12 +189,20 @@ It contain at least 64 bits of entropy." (defconst sasl-plain-continuations '(sasl-plain-response)) -(defun sasl-plain-response (principal challenge) +(defun sasl-plain-response (instantiator challenge) (let ((passphrase (sasl-read-passphrase - (format "PLAIN passphrase for %s: " (sasl-principal-name principal))))) + (format "PLAIN passphrase for %s: " + (sasl-instantiator-name instantiator)))) + (authentication-name + (sasl-instantiator-property + instantiator 'authentication-name)) + (name (sasl-instantiator-name instantiator))) (unwind-protect - (concat "\0" (sasl-principal-name principal) "\0" passphrase) + (if (and authentication-name + (not (string= authentication-name name))) + (concat authentication-name "\0" name "\0" passphrase) + (concat "\0" name "\0" passphrase)) (fillarray passphrase 0)))) (put 'sasl-plain 'sasl-authenticator @@ -179,16 +216,16 @@ It contain at least 64 bits of entropy." sasl-login-response-1 sasl-login-response-2)) -(defun sasl-login-response-1 (principal challenge) +(defun sasl-login-response-1 (instantiator challenge) (unless (string= (nth 1 challenge) "Username:") (sasl-error (format "Unexpected response: %s" (nth 1 challenge)))) - (sasl-principal-name principal)) + (sasl-instantiator-name instantiator)) -(defun sasl-login-response-2 (principal challenge) +(defun sasl-login-response-2 (instantiator challenge) (unless (string= (nth 1 challenge) "Password:") (sasl-error (format "Unexpected response: %s" (nth 1 challenge)))) (sasl-read-passphrase - (format "LOGIN passphrase for %s: " (sasl-principal-name principal)))) + (format "LOGIN passphrase for %s: " (sasl-instantiator-name instantiator)))) (put 'sasl-login 'sasl-authenticator (sasl-make-authenticator "LOGIN" sasl-login-continuations)) @@ -200,8 +237,10 @@ It contain at least 64 bits of entropy." '(identity ;no initial response sasl-anonymous-response)) -(defun sasl-anonymous-response (principal challenge) - (concat (sasl-principal-name principal))) +(defun sasl-anonymous-response (instantiator challenge) + (or (sasl-instantiator-property + instantiator 'trace) + (sasl-instantiator-name instantiator))) (put 'sasl-anonymous 'sasl-authenticator (sasl-make-authenticator "ANONYMOUS" sasl-anonymous-continuations)) diff --git a/smtp.el b/smtp.el index 929a222..ba29444 100644 --- a/smtp.el +++ b/smtp.el @@ -94,12 +94,12 @@ don't define this value." :type 'boolean :group 'smtp-extensions) -(defcustom smtp-sasl-principal-name (user-login-name) +(defcustom smtp-sasl-user-name (user-login-name) "Identification to be used for authorization." :type 'string :group 'smtp-extensions) -(defcustom smtp-sasl-principal-realm smtp-local-domain +(defcustom smtp-sasl-user-realm smtp-local-domain "Realm name to be used for authorization." :type 'string :group 'smtp-extensions) @@ -312,7 +312,8 @@ of the host to connect to. SERVICE is name of the service desired." (smtp-close-connection connection))))) ;;; @ hook methods for `smtp-submit-package' -;; +;;; + (defun smtp-primitive-greeting (package) (let* ((connection (smtp-find-connection (current-buffer))) @@ -355,7 +356,7 @@ of the host to connect to. SERVICE is name of the service desired." (smtp-response-error response)))) (eval-and-compile - (autoload 'sasl-make-principal "sasl") + (autoload 'sasl-make-instantiator "sasl") (autoload 'sasl-find-authenticator "sasl") (autoload 'sasl-authenticator-mechanism "sasl") (autoload 'sasl-evaluate-challenge "sasl")) @@ -367,20 +368,24 @@ of the host to connect to. SERVICE is name of the service desired." (smtp-connection-process connection)) (mechanisms (cdr (assq 'auth (smtp-connection-extensions connection)))) - (principal - (sasl-make-principal - smtp-sasl-principal-name - "smtp" (smtp-connection-server connection) - smtp-sasl-principal-realm)) (authenticator (let ((sasl-mechanisms smtp-sasl-mechanisms)) (sasl-find-authenticator mechanisms))) - mechanism sasl-response response) + instantiator + mechanism + sasl-response + response) (unless authenticator (error "No authentication mechanism available")) + (setq instantiator + (sasl-make-instantiator + smtp-sasl-user-name "smtp" (smtp-connection-server connection))) + (if smtp-sasl-user-realm + (sasl-instantiator-set-properties + instantiator (list 'realm smtp-sasl-user-realm))) (setq mechanism (sasl-authenticator-mechanism authenticator) ;; Retrieve the initial response - sasl-response (sasl-evaluate-challenge authenticator principal)) + sasl-response (sasl-evaluate-challenge authenticator instantiator)) (smtp-send-command process (if (nth 1 sasl-response) @@ -392,7 +397,7 @@ of the host to connect to. SERVICE is name of the service desired." (when (= (car response) 235) ;; The authentication process is finished. (setq sasl-response - (sasl-evaluate-challenge authenticator principal sasl-response)) + (sasl-evaluate-challenge authenticator instantiator sasl-response)) (if (null sasl-response) (throw 'done nil)) (smtp-response-error response)) ;Bogus server? @@ -401,7 +406,7 @@ of the host to connect to. SERVICE is name of the service desired." (setcar (cdr sasl-response) (base64-decode-string (nth 1 response))) (setq sasl-response (sasl-evaluate-challenge - authenticator principal sasl-response)) + authenticator instantiator sasl-response)) (smtp-send-command process (if (nth 1 sasl-response) (base64-encode-string (nth 1 sasl-response) t) -- 1.7.10.4