From: Magnus H. <leg...@us...> - 2007-08-24 02:43:54
|
Update of /cvsroot/emacs-jabber/emacs-jabber In directory sc8-pr-cvs17:/tmp/cvs-serv27257 Modified Files: jabber-core.el jabber-sasl.el NEWS jabber-util.el jabber-logon.el Log Message: Revision: ma...@fr...--2005/emacs-jabber--cvs-head--0--patch-393 Creator: Magnus Henoch <ma...@fr...> Implement password caching Index: NEWS =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/NEWS,v retrieving revision 1.60 retrieving revision 1.61 diff -u -d -r1.60 -r1.61 --- NEWS 24 Aug 2007 01:36:06 -0000 1.60 +++ NEWS 24 Aug 2007 02:43:50 -0000 1.61 @@ -2,14 +2,18 @@ * New features in jabber.el 0.8 +** Support for multiple accounts +(not documented yet) + +** Automatic reconnection +Not enabled by default; see jabber-auto-reconnect. +(not documented yet) + ** Support for XEP-0085 This means "contact is typing" notifications when chatting with Gajim or Google Talk users, among others. (not documented yet) -** Support for multiple accounts -(not documented yet) - ** Option: hide offline contacts in roster See jabber-show-offline-contacts. (not documented yet) Index: jabber-core.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-core.el,v retrieving revision 1.60 retrieving revision 1.61 diff -u -d -r1.60 -r1.61 --- jabber-core.el 23 Aug 2007 20:44:10 -0000 1.60 +++ jabber-core.el 24 Aug 2007 02:43:50 -0000 1.61 @@ -93,7 +93,10 @@ :group 'jabber-core) (defcustom jabber-auto-reconnect nil - "Reconnect automatically after losing connection?" + "Reconnect automatically after losing connection? +This will be of limited use unless you have the password library +installed, and have configured it to cache your password +indefinitely. See `password-cache' and `password-cache-expiry'." :type 'boolean :group 'jabber-core) @@ -415,7 +418,8 @@ (:authentication-failure ;; jabber-logon has already displayed a message - (list nil state-data)))) + (list nil (plist-put state-data + :disconnection-expected t))))) (define-enter-state jabber-connection :sasl-auth (fsm state-data) @@ -455,7 +459,8 @@ (:authentication-failure ;; jabber-sasl has already displayed a message - (list nil state-data)))) + (list nil (plist-put state-data + :disconnection-expected t))))) (define-enter-state jabber-connection :bind (fsm state-data) Index: jabber-util.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-util.el,v retrieving revision 2.48 retrieving revision 2.49 diff -u -d -r2.48 -r2.49 --- jabber-util.el 15 Aug 2007 20:47:40 -0000 2.48 +++ jabber-util.el 24 Aug 2007 02:43:50 -0000 2.49 @@ -20,6 +20,9 @@ ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (eval-when-compile (require 'cl)) +(condition-case nil + (require 'password) + (error nil)) (defvar jabber-jid-history nil "History of entered JIDs") @@ -253,7 +256,11 @@ (format "(default %s) " node-at-point))) node-at-point))) -(defun jabber-read-passwd (&optional prompt) +(defun jabber-password-key (bare-jid) + "Construct key for `password' library from BARE-JID." + (concat "xmpp:" bare-jid)) + +(defun jabber-read-password (bare-jid &optional prompt) "Read Jabber password, either from customized variable or from minibuffer. See `jabber-password'." (if jabber-password @@ -261,7 +268,16 @@ ;; variable jabber-password is a high-convenience low-security ;; alternative anyway. (copy-sequence jabber-password) - (read-passwd (or prompt "Jabber password: ")))) + (let ((prompt (or prompt (format "Jabber password for %s: " bare-jid)))) + (if (fboundp 'password-read-and-add) + (password-read-and-add prompt (jabber-password-key bare-jid)) + (read-passwd prompt))))) + +(defun jabber-uncache-password (bare-jid) + "Uncache cached password for BARE-JID. +Useful if the password proved to be wrong." + (when (fboundp 'password-cache-remove) + (password-cache-remove (jabber-password-key bare-jid)))) (defun jabber-read-account (&optional always-ask) "Ask for which connected account to use. Index: jabber-logon.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-logon.el,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- jabber-logon.el 12 Feb 2007 20:51:53 -0000 1.12 +++ jabber-logon.el 24 Aug 2007 02:43:50 -0000 1.13 @@ -1,7 +1,7 @@ ;; jabber-logon.el - logon functions +;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - ma...@fr... ;; Copyright (C) 2002, 2003, 2004 - tom berger - ob...@in... -;; Copyright (C) 2003, 2004 - Magnus Henoch - ma...@fr... ;; This file is a part of jabber.el. @@ -60,7 +60,7 @@ (resource () ,(plist-get (fsm-get-state-data jc) :resource))) #'jabber-process-logon t #'jabber-process-logon nil) - (jabber-disconnect-one jc)))) + (fsm-send jc :authentication-failure)))) (defun jabber-process-logon (jc xml-data closure-data) "receive login success or failure, and request roster. @@ -71,6 +71,7 @@ ;; Logon failure (jabber-report-success jc xml-data "Logon") + (jabber-uncache-password (jabber-connection-bare-jid jc)) (fsm-send jc :authentication-failure))) (provide 'jabber-logon) Index: jabber-sasl.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-sasl.el,v retrieving revision 2.9 retrieving revision 2.10 diff -u -d -r2.9 -r2.10 --- jabber-sasl.el 22 Apr 2007 10:26:42 -0000 2.9 +++ jabber-sasl.el 24 Aug 2007 02:43:50 -0000 2.10 @@ -57,31 +57,31 @@ (if node (fsm-send jc :use-legacy-auth-instead) (message "No suitable SASL mechanism found") - (fsm-send jc :authentication-failed))) + (fsm-send jc :authentication-failure))) ;; Watch for plaintext logins over unencrypted connections - (when (and (not *jabber-encrypted*) - (member (sasl-mechanism-name mechanism) - '("PLAIN" "LOGIN")) - (not (yes-or-no-p "Jabber server only allows cleartext password transmission! Continue? "))) - (error "Login cancelled")) + (if (and (not *jabber-encrypted*) + (member (sasl-mechanism-name mechanism) + '("PLAIN" "LOGIN")) + (not (yes-or-no-p "Jabber server only allows cleartext password transmission! Continue? "))) + (fsm-send jc :authentication-failure) - ;; Start authentication. - (let* ((client (sasl-make-client mechanism - (plist-get (fsm-get-state-data jc) :username) - "xmpp" - (plist-get (fsm-get-state-data jc) :server))) - (step (sasl-next-step client nil))) - (jabber-send-sexp - jc - `(auth ((xmlns . "urn:ietf:params:xml:ns:xmpp-sasl") - (mechanism . ,(sasl-mechanism-name mechanism))) - ,(when (sasl-step-data step) - (base64-encode-string (sasl-step-data step) t)))) - (cons client step))))) + ;; Start authentication. + (let* ((client (sasl-make-client mechanism + (plist-get (fsm-get-state-data jc) :username) + "xmpp" + (plist-get (fsm-get-state-data jc) :server))) + (step (sasl-next-step client nil))) + (jabber-send-sexp + jc + `(auth ((xmlns . "urn:ietf:params:xml:ns:xmpp-sasl") + (mechanism . ,(sasl-mechanism-name mechanism))) + ,(when (sasl-step-data step) + (base64-encode-string (sasl-step-data step) t)))) + (cons client step)))))) (defun jabber-sasl-process-input (jc xml-data sasl-data) - (let ((sasl-read-passphrase #'jabber-read-passwd) + (let ((sasl-read-passphrase #'jabber-read-password) (client (car sasl-data)) (step (cdr sasl-data))) (cond @@ -97,6 +97,7 @@ ((eq (car xml-data) 'failure) (message "SASL authentication failure: %s" (jabber-xml-node-name (car (jabber-xml-node-children xml-data)))) + (jabber-uncache-password (jabber-connection-bare-jid jc)) (fsm-send jc :authentication-failure)) ((eq (car xml-data) 'success) |