* utils/sasl: Sync up with flim-1_14.
authorteranisi <teranisi>
Fri, 22 Dec 2000 06:15:57 +0000 (06:15 +0000)
committerteranisi <teranisi>
Fri, 22 Dec 2000 06:15:57 +0000 (06:15 +0000)
* utils/sasl/sasl-cram.el: New file.
* utils/sasl/sasl-digest.el: New file.
* utils/sasl/digest-md5.el: Delete.
* utils/sasl/scram-md5.el: Delete.
* utils/sasl/unique-id.el: Delete.

utils/sasl/lisp/digest-md5.el [deleted file]
utils/sasl/lisp/sasl-cram.el [new file with mode: 0644]
utils/sasl/lisp/sasl-digest.el [new file with mode: 0644]
utils/sasl/lisp/sasl.el
utils/sasl/lisp/scram-md5.el [deleted file]
utils/sasl/lisp/unique-id.el [deleted file]

diff --git a/utils/sasl/lisp/digest-md5.el b/utils/sasl/lisp/digest-md5.el
deleted file mode 100644 (file)
index e72c535..0000000
+++ /dev/null
@@ -1,144 +0,0 @@
-;;; digest-md5.el --- Compute DIGEST-MD5.
-
-;; Copyright (C) 1999 Kenichi OKADA
-
-;; Author: Kenichi OKADA <okada@opaopa.org>
-;;     Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-;; Keywords: DIGEST-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This program is implemented from draft-leach-digest-sasl-05.txt.
-;;
-;; It is caller's responsibility to base64-decode challenges and
-;; base64-encode responses in IMAP4 AUTHENTICATE command.
-;;
-;; Passphrase should be longer than 16 bytes. (See RFC 2195)
-
-;; Examples.
-;;
-;; (digest-md5-parse-digest-challenge 
-;;   "realm=\"elwood.innosoft.com\",nonce=\"OA6MG9tEQGm2hh\",qop=\"auth\",algorithm=md5-sess,charset=utf-8")
-;; => (realm "elwood.innosoft.com" nonce "OA6MG9tEQGm2hh" qop "auth" algorithm md5-sess charset utf-8)
-
-;; (digest-md5-build-response-value
-;;   "chris" "elwood.innosoft.com" "secret" "OA6MG9tEQGm2hh"
-;;   "OA6MHXh6VqTrRk" 1 "imap/elwood.innosoft.com" "auth")
-;; => "d388dad90d4bbd760a152321f2143af7"
-
-;;; Code:
-
-(require 'hmac-md5)
-(require 'unique-id)
-
-(defvar digest-md5-challenge nil)
-
-(defvar digest-md5-parse-digest-challenge-syntax-table
-  (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?= "." table)
-    (modify-syntax-entry ?, "." table)
-    table)
-  "A syntax table for parsing digest-challenge attributes.")
-
-;;;###autoload
-(defun digest-md5-parse-digest-challenge (digest-challenge)
-  ;; return a property list of 
-  ;; (realm nonce qop-options stale maxbuf charset 
-  ;; algorithm cipher-opts auth-param).
-  (with-temp-buffer
-    (set-syntax-table digest-md5-parse-digest-challenge-syntax-table)
-    (insert digest-challenge)
-    (goto-char (point-min))
-    (insert "(")
-    (while (progn (forward-sexp) (not (eobp)))
-      (delete-char 1)
-      (insert " "))
-    (insert ")")
-    (condition-case nil
-       (setplist 'digest-md5-challenge (read (point-min-marker)))
-      (end-of-file
-       (error "Parse error in digest-challenge.")))))
-
-(defun digest-md5-digest-uri (serv-type host &optional serv-name)
-  (concat serv-type "/" host
-         (if (and serv-name
-                  (null (string= host serv-name)))
-             (concat "/" serv-name))))
-
-(defmacro digest-md5-cnonce ()
-  ;; It is RECOMMENDED that it 
-  ;; contain at least 64 bits of entropy.
-  '(concat (unique-id-m "") (unique-id-m "")))
-
-(defmacro digest-md5-challenge (prop)
-  (list 'get ''digest-md5-challenge prop))
-
-(defmacro digest-md5-build-response-value
-  (username realm passwd nonce cnonce nonce-count digest-uri qop)
-  `(encode-hex-string
-    (md5-binary
-     (concat
-      (encode-hex-string
-       (md5-binary (concat (md5-binary 
-                           (concat ,username 
-                                   ":" ,realm
-                                   ":" ,passwd))
-                          ":" ,nonce
-                          ":" ,cnonce
-                          (let ((authzid (digest-md5-challenge 'authzid)))
-                            (if authzid (concat ":" authzid) nil)))))
-      ":" ,nonce
-      ":" (format "%08x" ,nonce-count) ":" ,cnonce ":" ,qop ":"
-      (encode-hex-string
-       (md5-binary
-       (concat "AUTHENTICATE:" ,digest-uri
-               (if (string-equal "auth-int" ,qop)
-                   ":00000000000000000000000000000000"
-                 nil))))))))
-
-;;;###autoload
-(defun digest-md5-digest-response
-  (username realm passwd nonce cnonce nonce-count digest-uri
-           &optional charset qop maxbuf cipher authzid)
-  (concat
-   "username=\"" username "\","
-   "realm=\"" realm "\","
-   "nonce=\"" nonce "\","
-   (format "nc=%08x," nonce-count)
-   "cnonce=\"" cnonce "\","
-   "digest-uri=\"" digest-uri "\","
-   "response=" 
-   (digest-md5-build-response-value
-    username realm passwd nonce cnonce nonce-count digest-uri
-    (or qop "auth"))
-   ","
-   (mapconcat 
-    #'identity
-    (delq nil 
-         (mapcar (lambda (prop)
-                   (if (digest-md5-challenge prop)
-                       (format "%s=%s"
-                               prop (digest-md5-challenge prop))))
-                 '(charset qop maxbuf cipher authzid)))
-    ",")))
-  
-(provide 'digest-md5)
-
-;;; digest-md5.el ends here
diff --git a/utils/sasl/lisp/sasl-cram.el b/utils/sasl/lisp/sasl-cram.el
new file mode 100644 (file)
index 0000000..25d1082
--- /dev/null
@@ -0,0 +1,51 @@
+;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
+
+;; Copyright (C) 2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;;     Kenichi OKADA <okada@opaopa.org>
+;; Keywords: SASL, CRAM-MD5
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+(require 'sasl)
+(require 'hmac-md5)
+
+(defconst sasl-cram-md5-steps
+  '(ignore                             ;no initial response
+    sasl-cram-md5-response))
+
+(defun sasl-cram-md5-response (client step)
+  (let ((passphrase
+        (sasl-read-passphrase
+         (format "CRAM-MD5 passphrase for %s: "
+                 (sasl-client-name client)))))
+    (unwind-protect
+       (concat (sasl-client-name client) " "
+               (encode-hex-string
+                (hmac-md5 (sasl-step-data step) passphrase)))
+      (fillarray passphrase 0))))
+
+(put 'sasl-cram 'sasl-mechanism
+     (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps))
+
+(provide 'sasl-cram)
+
+;;; sasl-cram.el ends here
diff --git a/utils/sasl/lisp/sasl-digest.el b/utils/sasl/lisp/sasl-digest.el
new file mode 100644 (file)
index 0000000..9e061b7
--- /dev/null
@@ -0,0 +1,156 @@
+;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
+
+;; Copyright (C) 2000 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;;     Kenichi OKADA <okada@opaopa.org>
+;; Keywords: SASL, DIGEST-MD5
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; This program is implemented from draft-leach-digest-sasl-05.txt.
+;;
+;; It is caller's responsibility to base64-decode challenges and
+;; base64-encode responses in IMAP4 AUTHENTICATE command.
+;;
+;; Passphrase should be longer than 16 bytes. (See RFC 2195)
+
+;;; Commentary:
+
+(require 'sasl)
+(require 'hmac-md5)
+
+(defvar sasl-digest-md5-nonce-count 1)
+(defvar sasl-digest-md5-unique-id-function
+  sasl-unique-id-function)
+
+(defvar sasl-digest-md5-syntax-table
+  (let ((table (make-syntax-table)))
+    (modify-syntax-entry ?= "." table)
+    (modify-syntax-entry ?, "." table)
+    table)
+  "A syntax table for parsing digest-challenge attributes.")
+
+(defconst sasl-digest-md5-steps
+  '(ignore                             ;no initial response
+    sasl-digest-md5-response
+    ignore))                           ;""
+
+(defun sasl-digest-md5-parse-string (string)
+  "Parse STRING and return a property list.
+The value is a cons cell of the form \(realm nonce qop-options stale maxbuf
+charset algorithm cipher-opts auth-param)."
+  (with-temp-buffer
+    (set-syntax-table sasl-digest-md5-syntax-table)
+    (save-excursion
+      (insert string)
+      (goto-char (point-min))
+      (insert "(")
+      (while (progn (forward-sexp) (not (eobp)))
+       (delete-char 1)
+       (insert " "))
+      (insert ")")
+      (read (point-min-marker)))))
+
+(defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name)
+  (concat serv-type "/" host
+         (if (and serv-name
+                  (not (string= host serv-name)))
+             (concat "/" serv-name))))
+
+(defun sasl-digest-md5-cnonce ()
+  (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function))
+    (sasl-unique-id)))
+
+(defun sasl-digest-md5-response-value (username
+                                      realm
+                                      nonce
+                                      cnonce
+                                      nonce-count
+                                      qop
+                                      digest-uri
+                                      authzid)
+  (let ((passphrase
+        (sasl-read-passphrase
+         (format "DIGEST-MD5 passphrase for %s: "
+                 username))))
+    (unwind-protect
+       (encode-hex-string
+        (md5-binary
+         (concat
+          (encode-hex-string
+           (md5-binary (concat (md5-binary 
+                                (concat username ":" realm ":" passphrase))
+                               ":" nonce ":" cnonce
+                               (if authzid 
+                                   (concat ":" authzid)))))
+          ":" nonce
+          ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":"
+          (encode-hex-string
+           (md5-binary
+            (concat "AUTHENTICATE:" digest-uri
+                    (if (member qop '("auth-int" "auth-conf"))
+                        ":00000000000000000000000000000000")))))))
+      (fillarray passphrase 0))))
+
+(defun sasl-digest-md5-response (client step)
+  (let* ((plist
+         (sasl-digest-md5-parse-string (sasl-step-data step)))
+        (realm
+         (or (sasl-client-property client 'realm)
+             (plist-get plist 'realm))) ;need to check
+        (nonce-count
+         (or (sasl-client-property client 'nonce-count)
+              sasl-digest-md5-nonce-count))
+        (qop
+         (or (sasl-client-property client 'qop)
+             "auth"))
+        (digest-uri
+         (sasl-digest-md5-digest-uri
+          (sasl-client-service client)(sasl-client-server client)))
+        (cnonce
+         (or (sasl-client-property client 'cnonce)
+             (sasl-digest-md5-cnonce))))
+    (sasl-client-set-property client 'nonce-count (1+ nonce-count))
+    (unless (string= qop "auth")
+      (sasl-error (format "Unsupported \"qop-value\": %s" qop)))
+    (concat
+     "username=\"" (sasl-client-name client) "\","
+     "realm=\"" realm "\","
+     "nonce=\"" (plist-get plist 'nonce) "\","
+     "cnonce=\"" cnonce "\","
+     (format "nc=%08x," nonce-count)
+     "digest-uri=\"" digest-uri "\","
+     "qop=" qop ","
+     "response="
+     (sasl-digest-md5-response-value
+      (sasl-client-name client)
+      realm
+      (plist-get plist 'nonce)
+      cnonce
+      nonce-count
+      qop
+      digest-uri
+      (plist-get plist 'authzid)))))
+
+(put 'sasl-digest 'sasl-mechanism
+     (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps))
+
+(provide 'sasl-digest)
+
+;;; sasl-digest.el ends here
index dd07f13..cc782b9 100644 (file)
@@ -1,9 +1,9 @@
-;;; sasl.el --- basic functions for SASL
+;;; sasl.el --- SASL client framework
 
-;; Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 2000 Free Software Foundation, Inc.
 
-;; Author: Kenichi OKADA <okada@opaopa.org>
-;; Keywords: SMTP, SASL, RFC2222
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Keywords: SASL
 
 ;; This file is part of FLIM (Faithful Library about Internet Message).
 
 
 ;;; Commentary:
 
-;; Example.
+;; This module provides common interface functions to share several
+;; SASL mechanism drivers.  The toplevel is designed to be mostly
+;; compatible with [Java-SASL].
 ;;
-;; (base64-encode-string
-;;  (sasl-scram-md5-client-msg-2
-;;   (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
-;;   (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
-;;   (scram-md5-make-salted-pass
-;;    "secret stuff" "testsalt")))
-;; => "AQAAAMg9jU8CeB4KOfk7sUhSQPs="
+;; [SASL] J. Myers, "Simple Authentication and Security Layer (SASL)",
+;;     RFC 2222, October 1997.
 ;;
-;; (base64-encode-string
-;;  (scram-md5-make-server-msg-2
-;;   (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
-;;   (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
-;;   (scram-make-security-info nil t 0)
-;;   "testsalt"
-;;   (scram-md5-make-salted-pass
-;;    "secret stuff" "testsalt")))
-;; => "U0odqYw3B7XIIW0oSz65OQ=="
+;; [Java-SASL] R. Weltman & R. Lee, "The Java SASL Application Program
+;;     Interface", draft-weltman-java-sasl-03.txt, March 2000.
 
 ;;; Code:
 
-(require 'hmac-md5)
-
-(eval-when-compile
-  (require 'scram-md5)
-  (require 'digest-md5))
-
-(eval-and-compile
-  (autoload 'open-ssl-stream "ssl")
-  (autoload 'base64-decode-string "base64")
-  (autoload 'base64-encode-string "base64")
-  (autoload 'starttls-open-stream "starttls")
-  (autoload 'starttls-negotiate "starttls")
-  (autoload 'digest-md5-parse-digest-challenge "digest-md5")
-  (autoload 'digest-md5-digest-response "digest-md5")
-  (autoload 'scram-md5-make-salted-pass "scram-md5")
-  (autoload 'scram-md5-parse-server-msg-1 "scram-md5")
-  (autoload 'scram-md5-make-client-msg-1 "scram-md5"))
-
-;;; CRAM-MD5
-(defun sasl-cram-md5 (username passphrase challenge)
-  (let ((secure-word (copy-sequence passphrase)))
-    (setq secure-word (unwind-protect
-                         (hmac-md5 challenge secure-word)
-                       (fillarray secure-word 0))
-         secure-word (unwind-protect
-                         (encode-hex-string secure-word)
-                       (fillarray secure-word 0))
-         secure-word (unwind-protect
-                         (concat username " " secure-word)
-                       (fillarray secure-word 0)))))
-
-;;; PLAIN
-(defun sasl-plain (authorid authenid passphrase)
-  (concat authorid "\0" authenid "\0" passphrase))
-
-;;; SCRAM-MD5
-(defvar sasl-scram-md5-client-security-info
-  (eval-when-compile
-    (scram-make-security-info nil t 0)))
-
-(defun sasl-scram-md5-make-salted-pass (server-msg-1 passphrase)
-  (scram-md5-make-salted-pass
-   passphrase
-   (car
-    (scram-md5-parse-server-msg-1 server-msg-1))))
-
-(defun sasl-scram-md5-client-msg-1 (authenticate-id &optional authorize-id)
-  (scram-md5-make-client-msg-1 authenticate-id authorize-id))
-
-(defun sasl-scram-md5-client-msg-2 (server-msg-1 client-msg-1 salted-pass)
-  (let (client-proof client-key shared-key client-verifier)
-    (setq client-key
-         (scram-md5-make-client-key salted-pass))
-    (setq client-verifier
-         (scram-md5-make-client-verifier client-key))
-    (setq shared-key
-         (unwind-protect
-             (scram-md5-make-shared-key
-              server-msg-1
-              client-msg-1
-              sasl-scram-md5-client-security-info
-              client-verifier)
-           (fillarray client-verifier 0)))
-    (setq client-proof
-         (unwind-protect
-             (scram-md5-make-client-proof
-              client-key shared-key)
-           (fillarray client-key 0)
-           (fillarray shared-key 0)))
+(defvar sasl-mechanisms
+  '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"))
+
+(defvar sasl-mechanism-alist
+  '(("CRAM-MD5" sasl-cram)
+    ("DIGEST-MD5" sasl-digest)
+    ("PLAIN" sasl-plain)
+    ("LOGIN" sasl-login)
+    ("ANONYMOUS" sasl-anonymous)))
+
+(defvar sasl-unique-id-function (function sasl-unique-id-function))
+
+(put 'sasl-error 'error-message "SASL error")
+(put 'sasl-error 'error-conditions '(sasl-error error))
+
+(defun sasl-error (datum)
+  (signal 'sasl-error (list datum)))
+
+;;; @ SASL client
+;;;
+
+(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 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-client-name (client)
+  "Return the authorization name of CLIENT, a string."
+  (aref client 1))
+
+(defun sasl-client-service (client)
+  "Return the service name of CLIENT, a string."
+  (aref client 2))
+
+(defun sasl-client-server (client)
+  "Return the server name of CLIENT, a string."
+  (aref client 3))
+
+(defun sasl-client-set-properties (client plist)
+  "Destructively set the properties of CLIENT.
+The second argument PLIST is the new property list."
+  (setplist (aref client 4) plist))
+
+(defun sasl-client-set-property (client property value)
+  "Add the given property/value to CLIENT."
+  (put (aref client 4) property value))
+
+(defun sasl-client-property (client property)
+  "Return the value of the PROPERTY of CLIENT."
+  (get (aref client 4) property))
+
+(defun sasl-client-properties (client)
+  "Return the properties of CLIENT."
+  (symbol-plist (aref client 4)))
+
+;;; @ SASL mechanism
+;;;
+
+(defun sasl-make-mechanism (name steps)
+  "Make an authentication mechanism.
+NAME is a IANA registered SASL mechanism name.
+STEPS is list of continuation function."
+  (vector name
+         (mapcar
+          (lambda (step)
+            (let ((symbol (make-symbol (symbol-name step))))
+              (fset symbol (symbol-function step))
+              symbol))
+          steps)))
+
+(defun sasl-mechanism-name (mechanism)
+  "Return name of MECHANISM, a string."
+  (aref mechanism 0))
+
+(defun sasl-mechanism-steps (mechanism)
+  "Return the authentication steps of MECHANISM, a list of functions."
+  (aref mechanism 1))
+
+(defun sasl-find-mechanism (mechanisms)
+  "Retrieve an apropriate mechanism object from MECHANISMS hints."
+  (let* ((sasl-mechanisms sasl-mechanisms)
+        (mechanism
+         (catch 'done
+           (while sasl-mechanisms
+             (if (member (car sasl-mechanisms) mechanisms)
+                 (throw 'done (nth 1 (assoc (car sasl-mechanisms)
+                                            sasl-mechanism-alist))))
+             (setq sasl-mechanisms (cdr sasl-mechanisms))))))
+    (if mechanism
+       (require mechanism))
+    (get mechanism 'sasl-mechanism)))
+
+;;; @ SASL authentication step
+;;;
+
+(defun sasl-step-data (step)
+  "Return the data which STEP holds, a string."
+  (aref step 1))
+
+(defun sasl-step-set-data (step data)
+  "Store DATA string to STEP."
+  (aset step 1 data))
+
+(defun sasl-next-step (client step)
+  "Evaluate the challenge and prepare an appropriate next response.
+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 (vectorp step)
+             (nth 1 (memq (aref step 0) steps))
+           (car steps))))
+    (if function
+       (vector function (funcall function client step)))))
+
+(defvar sasl-read-passphrase nil)
+(defun sasl-read-passphrase (prompt)
+  (if (not sasl-read-passphrase)
+      (if (functionp 'read-passwd)
+         (setq sasl-read-passphrase 'read-passwd)
+       (if (load "passwd" t)
+           (setq sasl-read-passphrase 'read-passwd)
+         (autoload 'ange-ftp-read-passwd "ange-ftp")
+         (setq sasl-read-passphrase 'ange-ftp-read-passwd))))
+  (funcall sasl-read-passphrase prompt))
+
+(defun sasl-unique-id ()
+  "Compute a data string which must be different each time.
+It contain at least 64 bits of entropy."
+  (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function)))
+
+(defvar sasl-unique-id-char nil)
+
+;; stolen (and renamed) from message.el
+(defun sasl-unique-id-function ()
+  ;; Don't use microseconds from (current-time), they may be unsupported.
+  ;; Instead we use this randomly inited counter.
+  (setq sasl-unique-id-char
+       (% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+          ;; (current-time) returns 16-bit ints,
+          ;; and 2^16*25 just fits into 4 digits i base 36.
+          (* 25 25)))
+  (let ((tm (current-time)))
+    (concat
+     (sasl-unique-id-number-base36
+      (+ (car   tm)
+        (lsh (% sasl-unique-id-char 25) 16)) 4)
+     (sasl-unique-id-number-base36
+      (+ (nth 1 tm)
+        (lsh (/ sasl-unique-id-char 25) 16)) 4))))
+
+(defun sasl-unique-id-number-base36 (num len)
+  (if (if (< len 0)
+         (<= num 0)
+       (= len 0))
+      ""
+    (concat (sasl-unique-id-number-base36 (/ num 36) (1- len))
+           (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
+                                 (% num 36))))))
+
+;;; PLAIN (RFC2595 Section 6)
+(defconst sasl-plain-steps
+  '(sasl-plain-response))
+
+(defun sasl-plain-response (client step)
+  (let ((passphrase
+        (sasl-read-passphrase
+         (format "PLAIN passphrase for %s: " (sasl-client-name client))))
+       (authenticator-name
+        (sasl-client-property
+         client 'authenticator-name))
+       (name (sasl-client-name client)))
     (unwind-protect
-       (scram-md5-make-client-msg-2
-        sasl-scram-md5-client-security-info
-        client-proof)
-      (fillarray client-proof 0))))
-            
-(defun sasl-scram-md5-authenticate-server (server-msg-1
-                                          server-msg-2
-                                          client-msg-1
-                                          salted-pass)
-  (string= server-msg-2
-          (scram-md5-make-server-msg-2
-           server-msg-1
-           client-msg-1
-           sasl-scram-md5-client-security-info
-           (car
-            (scram-md5-parse-server-msg-1 server-msg-1))
-           salted-pass)))
-
-;;; DIGEST-MD5
-
-(defvar sasl-digest-md5-nonce-count 1)
-
-(defun sasl-digest-md5-digest-response (digest-challenge username passwd
-                                                        serv-type host &optional realm)
-  (digest-md5-parse-digest-challenge digest-challenge)
-  (digest-md5-digest-response
-   username
-   (or realm (digest-md5-challenge 'realm)) ;; need to check.
-   passwd
-   (digest-md5-challenge 'nonce)
-   (digest-md5-cnonce)
-   sasl-digest-md5-nonce-count
-   (digest-md5-digest-uri serv-type host) ;; MX host
-   ))
+       (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-mechanism
+     (sasl-make-mechanism "PLAIN" sasl-plain-steps))
+
+(provide 'sasl-plain)
+
+;;; LOGIN (No specification exists)
+(defconst sasl-login-steps
+  '(ignore                             ;no initial response
+    sasl-login-response-1
+    sasl-login-response-2))
+
+(defun sasl-login-response-1 (client step)
+;;;  (unless (string-match "^Username:" (sasl-step-data step))
+;;;    (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
+  (sasl-client-name client))
+
+(defun sasl-login-response-2 (client step)
+;;;  (unless (string-match "^Password:" (sasl-step-data step))
+;;;    (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
+  (sasl-read-passphrase
+   (format "LOGIN passphrase for %s: " (sasl-client-name client))))
+
+(put 'sasl-login 'sasl-mechanism
+     (sasl-make-mechanism "LOGIN" sasl-login-steps))
+
+(provide 'sasl-login)
+
+;;; ANONYMOUS (RFC2245)
+(defconst sasl-anonymous-steps
+  '(ignore                             ;no initial response
+    sasl-anonymous-response))
+
+(defun sasl-anonymous-response (client step)
+  (or (sasl-client-property client 'trace)
+      (sasl-client-name client)))
+
+(put 'sasl-anonymous 'sasl-mechanism
+     (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps))
+
+(provide 'sasl-anonymous)
 
 (provide 'sasl)
 
-;;; sasl.el ends here
\ No newline at end of file
+;;; sasl.el ends here
diff --git a/utils/sasl/lisp/scram-md5.el b/utils/sasl/lisp/scram-md5.el
deleted file mode 100644 (file)
index 6891600..0000000
+++ /dev/null
@@ -1,154 +0,0 @@
-;;; scram-md5.el --- Compute SCRAM-MD5.
-
-;; Copyright (C) 1999 Shuhei KOBAYASHI
-
-;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-;;     Kenichi OKADA <okada@opaopa.org>
-;; Keywords: SCRAM-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This program is implemented from draft-newman-auth-scram-03.txt.
-;;
-;; It is caller's responsibility to base64-decode challenges and
-;; base64-encode responses in IMAP4 AUTHENTICATE command.
-;;
-;; Passphrase should be longer than 16 bytes. (See RFC 2195)
-
-;; Examples.
-;;
-;; (scram-make-security-info nil t 0)
-;; => "^A^@^@^@"
-
-;;; Code:
-
-(require 'hmac-md5)
-(require 'unique-id)
-
-(defmacro scram-security-info-no-security-layer (security-info)
-  `(eq (logand (aref ,security-info 0) 1) 1))
-(defmacro scram-security-info-integrity-protection-layer (security-info)
-  `(eq (logand (aref ,security-info 0) 2) 2))
-(defmacro scram-security-info-buffer-size (security-info)
-  `(let ((ssecinfo ,security-info))
-     (+ (lsh (aref ssecinfo 1) 16)
-       (lsh (aref ssecinfo 2) 8)
-       (aref ssecinfo 3))))
-
-(defun scram-make-security-info (integrity-protection-layer
-                                no-security-layer buffer-size)
-  (let ((csecinfo (make-string 4 0)))
-    (when integrity-protection-layer
-      (aset csecinfo 0 2))
-    (if no-security-layer
-       (aset csecinfo 0 (logior (aref csecinfo 0) 1))
-      (aset csecinfo 1
-           (lsh (logand buffer-size (lsh 255 16)) -16))
-      (aset csecinfo 2
-           (lsh (logand buffer-size (lsh 255 8)) -8))
-      (aset csecinfo 3 (logand buffer-size 255)))
-    csecinfo))
-
-(defun scram-make-unique-nonce ()      ; 8*OCTET, globally unique.
-  ;; For example, concatenated string of process-identifier, system-clock,
-  ;; sequence-number, random-number, and domain-name.
-  (let (id)
-    (unwind-protect
-       (concat "<" 
-               (setq id (unique-id-m ".sasl"))
-               "@" (system-name) ">")
-      (fillarray id 0))))
-
-(defun scram-xor-string (str1 str2)
-  ;; (length str1) == (length str2) == (length dst) == 16 (in SCRAM-MD5)
-  (let* ((len (length str1))
-         (dst (make-string len 0))
-         (pos 0))
-    (while (< pos len)
-      (aset dst pos (logxor (aref str1 pos) (aref str2 pos)))
-      (setq pos (1+ pos)))
-    dst))
-
-(defun scram-md5-make-client-msg-1 (authenticate-id &optional authorize-id)
-  "Make an initial client message from AUTHENTICATE-ID and AUTHORIZE-ID.
-If AUTHORIZE-ID is the same as AUTHENTICATE-ID, it may be omitted."
-  (let (nonce)
-    (unwind-protect
-       (concat authorize-id "\0" authenticate-id "\0" 
-               (setq nonce (scram-make-unique-nonce)))
-      (fillarray nonce 0))))
-
-(defun scram-md5-parse-server-msg-1 (server-msg-1)
-  "Parse SERVER-MSG-1 and return a list of (SALT SECURITY-INFO SERVICE-ID)."
-  (when (and (> (length server-msg-1) 16)
-            (eq (string-match "[^@]+@[^\0]+\0" server-msg-1 12) 12))
-    (list (substring server-msg-1 0 8) ; salt
-         (substring server-msg-1 8 12) ; server-security-info
-         (substring server-msg-1       ; service-id
-                    12 (1- (match-end 0))))))
-
-(defun scram-md5-make-salted-pass (passphrase salt)
-  (hmac-md5 salt passphrase))
-
-(defun scram-md5-make-client-key (salted-pass)
-  (md5-binary salted-pass))
-
-(defun scram-md5-make-client-verifier (client-key)
-  (md5-binary client-key))
-
-(defun scram-md5-make-shared-key (server-msg-1
-                                 client-msg-1
-                                 client-security-info
-                                 client-verifier)
-  (let (buff)
-    (unwind-protect
-       (hmac-md5
-        (setq buff
-              (concat server-msg-1 client-msg-1 client-security-info))
-        client-verifier)
-      (fillarray buff 0))))
-
-(defun scram-md5-make-client-proof (client-key shared-key)
-  (scram-xor-string client-key shared-key))
-
-(defun scram-md5-make-client-msg-2 (client-security-info client-proof)
-  (concat client-security-info client-proof))
-
-(defun scram-md5-make-server-msg-2 (server-msg-1
-                                   client-msg-1
-                                   client-security-info
-                                   salt salted-pass)
-  (let (buff server-salt)
-    (setq server-salt
-         (hmac-md5 salt salted-pass))
-    (unwind-protect
-       (hmac-md5
-        (setq buff
-              (concat
-               client-msg-1
-               server-msg-1
-               client-security-info))
-        server-salt)
-      (fillarray server-salt 0)
-      (fillarray buff 0))))
-
-(provide 'scram-md5)
-
-;;; scram-md5.el ends here
diff --git a/utils/sasl/lisp/unique-id.el b/utils/sasl/lisp/unique-id.el
deleted file mode 100644 (file)
index f80b2d4..0000000
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; unique-id.el --- Compute DIGEST-MD5.
-
-;; Copyright (C) 1999 Kenichi OKADA
-
-;; Author: Katsumi Yamaoka  <yamaoka@jpl.org>
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;;; Code:
-
-;;; Gnus 5.8.3: message.el
-
-(defvar unique-id-m-char nil)
-
-;; If you ever change this function, make sure the new version
-;; cannot generate IDs that the old version could.
-;; You might for example insert a "." somewhere (not next to another dot
-;; or string boundary), or modify the suffix string (default to "fsf").
-(defun unique-id-m (&optional suffix)
-  ;; Don't use microseconds from (current-time), they may be unsupported.
-  ;; Instead we use this randomly inited counter.
-  (setq unique-id-m-char
-       (% (1+ (or unique-id-m-char (logand (random t) (1- (lsh 1 20)))))
-          ;; (current-time) returns 16-bit ints,
-          ;; and 2^16*25 just fits into 4 digits i base 36.
-          (* 25 25)))
-  (let ((tm (current-time)))
-    (concat
-     (if (memq system-type '(ms-dos emx vax-vms))
-        (let ((user (downcase (user-login-name))))
-          (while (string-match "[^a-z0-9_]" user)
-            (aset user (match-beginning 0) ?_))
-          user)
-       (unique-id-m-number-base36 (user-uid) -1))
-     (unique-id-m-number-base36 (+ (car   tm)
-                                  (lsh (% unique-id-m-char 25) 16)) 4)
-     (unique-id-m-number-base36 (+ (nth 1 tm)
-                                  (lsh (/ unique-id-m-char 25) 16)) 4)
-     ;; Append the suffix, because while the generated ID is unique to
-     ;; the application, other applications might otherwise generate
-     ;; the same ID via another algorithm.
-     (or suffix ".fsf"))))
-
-(defun unique-id-m-number-base36 (num len)
-  (if (if (< len 0)
-         (<= num 0)
-       (= len 0))
-      ""
-    (concat (unique-id-m-number-base36 (/ num 36) (1- len))
-           (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
-                                 (% num 36))))))
-
-\f
-;;; Wanderlust 1.0.3: wl-draft.el, wl-mule.el
-
-(defun unique-id-w-random-alphabet ()
-  (let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
-                      ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z)))
-    (nth (abs (% (random) 26)) alphabet)))
-
-(defun unique-id-w ()
-  (let ((time (current-time)))
-    (format "%d.%d.%d.%d%c"
-           (car time) (nth 1 time) (nth 2 time)
-           (random 100000)
-           (unique-id-w-random-alphabet))))
-
-\f
-;;; VM 6.75: vm-misc.el
-
-(defun unique-id-v ()
-  (let ((time (current-time)))
-    (format "%d.%d.%d.%d"
-           (car time) (nth 1 time) (nth 2 time)
-           (random 1000000))))
-
-\f
-;;; X-PGP-Sig 1.3.5.1
-
-(defun unique-id-x (&optional length)
-  (let ((i (or length 16))
-       s)
-    (while (> i 0)
-      (setq i (1- i)
-           s (concat s (char-to-string (+ (/ (* 94 (% (abs (random)) 100))
-                                             100) 33)))))
-    s))
-
-(provide 'unique-id)
-
-;;; unique-id.el ends here
-