* lisp/imap.el: Require `digest-md5' when compiling; add autoload
authorueno <ueno>
Tue, 14 Dec 1999 09:20:55 +0000 (09:20 +0000)
committerueno <ueno>
Tue, 14 Dec 1999 09:20:55 +0000 (09:20 +0000)
settings for `digest-md5-parse-digest-challenge' and
`digest-md5-digest-response'.
(imap-authenticators): Add `digest-md5'.
(imap-authenticator-alist): Setup for `digest-md5'.
(imap-digest-md5-p): New function.
(imap-digest-md5-auth): New function.

lisp/imap.el

index d91e160..3544238 100644 (file)
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'static))
+(eval-when-compile 
+  (ignore-errors (require 'digest-md5)))
 
 (eval-and-compile
   (autoload 'open-ssl-stream "ssl")
   (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 'rfc2104-hash "rfc2104")
   (autoload 'utf7-encode "utf7")
   (autoload 'utf7-decode "utf7")
@@ -223,15 +227,16 @@ NAME names the stream, CHECK is a function returning non-nil if the
 server support the stream and OPEN is a function for opening the
 stream.")
 
-(defvar imap-authenticators '(kerberos4 cram-md5 login anonymous)
+(defvar imap-authenticators '(kerberos4 cram-md5 digest-md5 login anonymous)
   "Priority of authenticators to consider when authenticating to
 server.")
 
 (defvar imap-authenticator-alist 
-  '((kerberos4 imap-kerberos4a-p imap-kerberos4-auth)
-    (cram-md5  imap-cram-md5-p   imap-cram-md5-auth)
-    (login     imap-login-p      imap-login-auth)
-    (anonymous imap-anonymous-p  imap-anonymous-auth))
+  '((kerberos4   imap-kerberos4a-p imap-kerberos4-auth)
+    (cram-md5    imap-cram-md5-p   imap-cram-md5-auth)
+    (digest-md5  imap-digest-md5-p imap-digest-md5-auth)
+    (login       imap-login-p      imap-login-auth)
+    (anonymous   imap-anonymous-p  imap-anonymous-auth))
   "Definition of authenticators.
 
 (NAME CHECK AUTHENTICATE)
@@ -605,6 +610,35 @@ successful, nil otherwise."
                 (encoded (imap-base64-encode-string response)))
            encoded))))))))
 
+(defun imap-digest-md5-p (buffer)
+  (imap-capability 'AUTH=DIGEST-MD5 buffer))
+
+(defun imap-digest-md5-auth (buffer)
+  "Login to server using the AUTH DIGEST-MD5 method."
+  (imap-interactive-login
+   buffer
+   (lambda (user passwd)
+     (let ((tag 
+           (imap-send-command
+            (list
+             "AUTHENTICATE DIGEST-MD5"
+             (lambda (challenge)
+               (digest-md5-parse-digest-challenge
+                (imap-base64-decode-string challenge))
+               (let* ((digest-uri
+                       (digest-md5-digest-uri 
+                        "imap" (digest-md5-challenge 'realm)))
+                      (response
+                       (digest-md5-digest-response 
+                        user passwd digest-uri)))
+                 (imap-base64-encode-string response 'no-line-break))))
+            )))
+       (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
+          nil
+        (setq imap-continuation nil)
+        (imap-send-command-1 "")
+        (imap-ok-p (imap-wait-for-tag tag)))))))
+
 (defun imap-login-p (buffer)
   (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))