* sasl.el: Don't require 'poe'
authorueno <ueno>
Sat, 4 Nov 2000 14:16:43 +0000 (14:16 +0000)
committerueno <ueno>
Sat, 4 Nov 2000 14:16:43 +0000 (14:16 +0000)
- 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'.

ChangeLog
sasl-cram.el
sasl-digest.el
sasl.el
smtp.el

index 2a59cec..a5a1dc1 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
 2000-11-04   Daiki Ueno  <ueno@unixuser.org>
 
+       * 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  <ueno@unixuser.org>
+
        * sasl.el (sasl-make-instantiator): Define as function.
        (sasl-instantiator-name): Ditto.
        (sasl-instantiator-service): Ditto.
index 8d9a79e..d778849 100644 (file)
 (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)
 
index 2af708d..1ca0ed9 100644 (file)
@@ -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 (file)
--- a/sasl.el
+++ b/sasl.el
@@ -36,8 +36,6 @@
 
 ;;; Code:
 
-(require 'poe)
-
 (defvar sasl-mechanisms
   '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"))
 
 (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 (file)
--- 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)