+;;; Compiler directives.
+
+(defvar imap-sasl-client)
+(defvar imap-sasl-step)
+
+(defun imap-sasl-make-mechanisms (buffer)
+ (let ((mecs '()))
+ (mapc (lambda (sym)
+ (let ((name (symbol-name sym)))
+ (if (and (> (length name) 5)
+ (string-equal "AUTH=" (substring name 0 5 )))
+ (setq mecs (cons (substring name 5) mecs)))))
+ (imap-capability nil buffer))
+ mecs))
+
+(defun imap-sasl-auth-p (buffer)
+ (and (condition-case ()
+ (require 'sasl)
+ (error nil))
+ (sasl-find-mechanism (imap-sasl-make-mechanisms buffer))))
+
+(defun imap-sasl-auth (buffer)
+ "Login to server using the SASL method."
+ (message "imap: Authenticating using SASL...")
+ (with-current-buffer buffer
+ (make-local-variable 'imap-username)
+ (make-local-variable 'imap-sasl-client)
+ (make-local-variable 'imap-sasl-step)
+ (let ((mechanism (sasl-find-mechanism (imap-sasl-make-mechanisms buffer)))
+ logged user)
+ (while (not logged)
+ (setq user (or imap-username
+ (read-from-minibuffer
+ (concat "IMAP username for " imap-server " using SASL "
+ (sasl-mechanism-name mechanism) ": ")
+ (or user imap-default-user))))
+ (when user
+ (setq imap-sasl-client (sasl-make-client mechanism user "imap2" imap-server)
+ imap-sasl-step (sasl-next-step imap-sasl-client nil))
+ (let ((tag (imap-send-command
+ (if (sasl-step-data imap-sasl-step)
+ (format "AUTHENTICATE %s %s"
+ (sasl-mechanism-name mechanism)
+ (sasl-step-data imap-sasl-step))
+ (format "AUTHENTICATE %s" (sasl-mechanism-name mechanism)))
+ buffer)))
+ (while (eq (imap-wait-for-tag tag) 'INCOMPLETE)
+ (sasl-step-set-data imap-sasl-step (base64-decode-string imap-continuation))
+ (setq imap-continuation nil
+ imap-sasl-step (sasl-next-step imap-sasl-client imap-sasl-step))
+ (imap-send-command-1 (if (sasl-step-data imap-sasl-step)
+ (base64-encode-string (sasl-step-data imap-sasl-step) t)
+ "")))
+ (if (imap-ok-p (imap-wait-for-tag tag))
+ (setq imap-username user
+ logged t)
+ (message "Login failed...")
+ (sit-for 1)))))
+ logged)))
+