sieve-manage: use auth-source.

4 files changed, 77 insertions, 162 deletions

diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi
index edf429aea77..b17c262b757 100644
--- a/doc/misc/sieve.texi
+++ b/doc/misc/sieve.texi
@@ -264,10 +264,6 @@ in the @code{sieve} group (@kbd{M-x customize-group RET sieve RET}):
 
 @table @code
 
-@item sieve-manage-default-user
-@vindex sieve-manage-default-user
-Sets the default username.
-
 @item sieve-manage-default-port
 @vindex sieve-manage-default-port
 Sets the default port to use, the suggested port number is @code{2000}.
@@ -296,10 +292,6 @@ Check if a server is open or not.
 @findex sieve-manage-close
 Close a server connection.
 
-@item sieve-manage-authenticate
-@findex sieve-manage-authenticate
-Authenticate to the server.
-
 @item sieve-manage-capability
 @findex sieve-manage-capability
 Return a list of capabilities the server supports.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 3ef57f26e86..5e6a1e488f8 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -77,6 +77,8 @@
 
 2010-10-05  Julien Danjou  <julien@danjou.info>
 
+        * sieve-manage.el (sieve-sasl-auth): Use auth-source to authenticate.
+
         * gnus-html.el (gnus-html-wash-images): Rescale image from cid too.
         (gnus-html-maximum-image-size): Add this function.
         (gnus-html-put-image): Use gnus-html-maximum-image-size.
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index 69f21b0112f..370a53d4ac9 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -43,7 +43,6 @@
 ;; `sieve-manage-close'
 ;; close a server connection.
 ;;
-;; `sieve-manage-authenticate'
 ;; `sieve-manage-listscripts'
 ;; `sieve-manage-deletescript'
 ;; `sieve-manage-getscript'
@@ -51,11 +50,6 @@
 ;;
 ;; and that's it.  Example of a managesieve session in *scratch*:
 ;;
-;; (setq my-buf (sieve-manage-open "my.server.com"))
-;; " *sieve* my.server.com:2000*"
-;;
-;; (sieve-manage-authenticate "myusername" "mypassword" my-buf)
-;; 'auth
 ;;
 ;; (sieve-manage-listscripts my-buf)
 ;; ("vacation" "testscript" ("splitmail") "badscript")
@@ -87,6 +81,7 @@
   (require 'starttls))
 (autoload 'sasl-find-mechanism "sasl")
 (autoload 'starttls-open-stream "starttls")
+(autoload 'auth-source-user-or-password "auth-source")
 
 ;; User customizable variables:
 
@@ -100,11 +95,6 @@
   :type 'string
   :group 'sieve-manage)
 
-(defcustom sieve-manage-default-user (user-login-name)
-  "Default username to use."
-  :type 'string
-  :group 'sieve-manage)
-
 (defcustom sieve-manage-server-eol "\r\n"
   "The EOL string sent from the server."
   :type 'string
@@ -174,8 +164,6 @@ Must be a name of a stream in `sieve-manage-stream-alist'."
                                          sieve-manage-port
                                          sieve-manage-auth
                                          sieve-manage-stream
-                                         sieve-manage-username
-                                         sieve-manage-password
                                          sieve-manage-process
                                          sieve-manage-client-eol
                                          sieve-manage-server-eol
@@ -186,8 +174,6 @@ Must be a name of a stream in `sieve-manage-stream-alist'."
 (defvar sieve-manage-auth nil)
 (defvar sieve-manage-server nil)
 (defvar sieve-manage-port nil)
-(defvar sieve-manage-username nil)
-(defvar sieve-manage-password nil)
 (defvar sieve-manage-state 'closed
   "Managesieve state.
 Valid states are `closed', `initial', `nonauth', and `auth'.")
@@ -201,61 +187,6 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
   (unless (featurep 'xemacs)
     '(set-buffer-multibyte nil)))
 
-(declare-function password-read         "password-cache" (prompt &optional key))
-(declare-function password-cache-add    "password-cache" (key password))
-(declare-function password-cache-remove "password-cache" (key))
-
-;; Uses the dynamically bound `reason' variable.
-(defvar reason)
-(defun sieve-manage-interactive-login (buffer loginfunc)
-  "Login to server in BUFFER.
-LOGINFUNC is passed a username and a password, it should return t if
-it was successful authenticating itself to the server, nil otherwise.
-Returns t if login was successful, nil otherwise."
-  (with-current-buffer buffer
-    (make-local-variable 'sieve-manage-username)
-    (make-local-variable 'sieve-manage-password)
-    (let (user passwd ret reason passwd-key)
-      (condition-case ()
-          (while (or (not user) (not passwd))
-            (setq user (or sieve-manage-username
-                           (read-from-minibuffer
-                            (concat "Managesieve username for "
-                                    sieve-manage-server ": ")
-                            (or user sieve-manage-default-user)))
-                  passwd-key (concat "managesieve:" user "@" sieve-manage-server
-                                     ":" sieve-manage-port)
-                  passwd (or sieve-manage-password
-                             (password-read (concat "Managesieve password for "
-                                                    user "@" sieve-manage-server
-                                                    ": ")
-                                            passwd-key)))
-            (when (y-or-n-p "Store password for this session? ")
-              (password-cache-add passwd-key (copy-sequence passwd)))
-            (when (and user passwd)
-              (if (funcall loginfunc user passwd)
-                  (setq ret t
-                        sieve-manage-username user)
-                (if reason
-                    (message "Login failed (reason given: %s)..." reason)
-                  (message "Login failed..."))
-                (password-cache-remove passwd-key)
-                (setq sieve-manage-password nil)
-                (setq passwd nil)
-                (setq reason nil)
-                (sit-for 1))))
-        (quit (with-current-buffer buffer
-                (password-cache-remove passwd-key)
-                (setq user nil
-                      passwd nil
-                      sieve-manage-password nil)))
-        (error (with-current-buffer buffer
-                 (password-cache-remove passwd-key)
-                 (setq user nil
-                       passwd nil
-                       sieve-manage-password nil))))
-      ret)))
-
 (defun sieve-manage-erase (&optional p buffer)
   (let ((buffer (or buffer (current-buffer))))
     (and sieve-manage-log
@@ -336,70 +267,72 @@ Returns t if login was successful, nil otherwise."
       process)))
 
 ;; Authenticators
-
 (defun sieve-sasl-auth (buffer mech)
   "Login to server using the SASL MECH method."
   (message "sieve: Authenticating using %s..." mech)
-  (if (sieve-manage-interactive-login
-       buffer
-       (lambda (user passwd)
-         (let (client step tag data rsp)
-           (setq client (sasl-make-client (sasl-find-mechanism (list mech))
-                                          user "sieve" sieve-manage-server))
-           (setq sasl-read-passphrase (function (lambda (prompt) passwd)))
-           (setq step (sasl-next-step client nil))
-           (setq tag
-                 (sieve-manage-send
-                  (concat
-                   "AUTHENTICATE \""
-                   mech
-                   "\""
-                   (and (sasl-step-data step)
-                        (concat
-                         " \""
-                         (base64-encode-string
-                          (sasl-step-data step)
-                          'no-line-break)
-                         "\"")))))
-           (catch 'done
-             (while t
-               (setq rsp nil)
-               (goto-char (point-min))
-               (while (null (or (progn
-                                  (setq rsp (sieve-manage-is-string))
-                                  (if (not (and rsp (looking-at
-                                                     sieve-manage-server-eol)))
-                                      (setq rsp nil)
-                                    (goto-char (match-end 0))
-                                    rsp))
-                                (setq rsp (sieve-manage-is-okno))))
-                 (accept-process-output sieve-manage-process 1)
-                 (goto-char (point-min)))
-               (sieve-manage-erase)
-               (when (sieve-manage-ok-p rsp)
-                 (when (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp))
-                   (sasl-step-set-data
-                    step (base64-decode-string (match-string 1 (cadr rsp)))))
-                 (if (and (setq step (sasl-next-step client step))
-                          (setq data (sasl-step-data step)))
-                     ;; We got data for server but it's finished
-                     (error "Server not ready for SASL data: %s" data)
-                   ;; The authentication process is finished.
-                   (throw 'done t)))
-               (unless (stringp rsp)
-                 (apply 'error "Server aborted SASL authentication: %s %s %s"
-                        rsp))
-               (sasl-step-set-data step (base64-decode-string rsp))
-               (setq step (sasl-next-step client step))
-               (sieve-manage-send
-                (if (sasl-step-data step)
-                    (concat "\""
-                            (base64-encode-string (sasl-step-data step)
-                                                  'no-line-break)
-                            "\"")
-                  "")))))))
-      (message "sieve: Authenticating using %s...done" mech)
-    (message "sieve: Authenticating using %s...failed" mech)))
+  (with-current-buffer buffer
+    (let* ((user-password (auth-source-user-or-password
+                           '("login" "password")
+                           sieve-manage-server
+                           "sieve" nil t))
+           (client (sasl-make-client (sasl-find-mechanism (list mech))
+                                     (car user-password) "sieve" sieve-manage-server))
+           (sasl-read-passphrase
+            ;; We *need* to copy the password, because sasl will modify it
+            ;; somehow.
+            `(lambda (prompt) ,(copy-sequence (cadr user-password))))
+           (step (sasl-next-step client nil))
+           (tag (sieve-manage-send
+                 (concat
+                  "AUTHENTICATE \""
+                  mech
+                  "\""
+                  (and (sasl-step-data step)
+                       (concat
+                        " \""
+                        (base64-encode-string
+                         (sasl-step-data step)
+                         'no-line-break)
+                        "\"")))))
+           data rsp)
+      (catch 'done
+        (while t
+          (setq rsp nil)
+          (goto-char (point-min))
+          (while (null (or (progn
+                             (setq rsp (sieve-manage-is-string))
+                             (if (not (and rsp (looking-at
+                                                sieve-manage-server-eol)))
+                                 (setq rsp nil)
+                               (goto-char (match-end 0))
+                               rsp))
+                           (setq rsp (sieve-manage-is-okno))))
+            (accept-process-output sieve-manage-process 1)
+            (goto-char (point-min)))
+          (sieve-manage-erase)
+          (when (sieve-manage-ok-p rsp)
+            (when (and (cadr rsp)
+                       (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp)))
+              (sasl-step-set-data
+               step (base64-decode-string (match-string 1 (cadr rsp)))))
+            (if (and (setq step (sasl-next-step client step))
+                     (setq data (sasl-step-data step)))
+                ;; We got data for server but it's finished
+                (error "Server not ready for SASL data: %s" data)
+              ;; The authentication process is finished.
+              (throw 'done t)))
+          (unless (stringp rsp)
+            (error "Server aborted SASL authentication: %s" (caddr rsp)))
+          (sasl-step-set-data step (base64-decode-string rsp))
+          (setq step (sasl-next-step client step))
+          (sieve-manage-send
+           (if (sasl-step-data step)
+               (concat "\""
+                       (base64-encode-string (sasl-step-data step)
+                                             'no-line-break)
+                       "\"")
+             ""))))
+      (message "sieve: Login using %s...done" mech))))
 
 (defun sieve-manage-cram-md5-p (buffer)
   (sieve-manage-capability "SASL" "CRAM-MD5" buffer))
@@ -534,24 +467,6 @@ If BUFFER is nil, the current buffer is used."
     (sieve-manage-erase)
     t))
 
-(defun sieve-manage-authenticate (&optional user passwd buffer)
-  "Authenticate to server in BUFFER, using current buffer if nil.
-It uses the authenticator specified when opening the server.  If the
-authenticator requires username/passwords, they are queried from the
-user and optionally stored in the buffer.  If USER and/or PASSWD is
-specified, the user will not be questioned and the username and/or
-password is remembered in the buffer."
-  (with-current-buffer (or buffer (current-buffer))
-    (if (not (eq sieve-manage-state 'nonauth))
-        (eq sieve-manage-state 'auth)
-      (make-local-variable 'sieve-manage-username)
-      (make-local-variable 'sieve-manage-password)
-      (if user (setq sieve-manage-username user))
-      (if passwd (setq sieve-manage-password passwd))
-      (if (funcall (nth 2 (assq sieve-manage-auth
-                                sieve-manage-authenticator-alist)) buffer)
-          (setq sieve-manage-state 'auth)))))
-
 (defun sieve-manage-capability (&optional name value buffer)
   "Check if capability NAME of server BUFFER match VALUE.
 If it does, return the server value of NAME. If not returns nil.
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el
index 7b014da2f83..e988cb759de 100644
--- a/lisp/gnus/sieve.el
+++ b/lisp/gnus/sieve.el
@@ -320,11 +320,17 @@ Server  : " server ":" (or port "2000") "
       (insert "\n"))))
 
 (defun sieve-open-server (server &optional port)
-  ;; open server
-  (set (make-local-variable 'sieve-manage-buffer)
-       (sieve-manage-open server))
-  ;; authenticate
-  (sieve-manage-authenticate nil nil sieve-manage-buffer))
+  (with-current-buffer
+      ;; open server
+      (set (make-local-variable 'sieve-manage-buffer)
+           (sieve-manage-open server))
+    ;; authenticate
+    (if (eq sieve-manage-state 'nonauth)
+      (if (funcall (nth 2 (assq sieve-manage-auth
+                                sieve-manage-authenticator-alist))
+                   (current-buffer))
+          (setq sieve-manage-state 'auth))
+      (eq sieve-manage-state 'auth))))
 
 (defun sieve-refresh-scriptlist ()
   (interactive)