* 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'.

diff --git a/ChangeLog b/ChangeLog
index e7d1e8b..10f8295 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
 2000-11-02   Daiki Ueno  <ueno@unixuser.org>
 
+       * 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  <ueno@unixuser.org>
+
        * 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)