From: Magnus H. <leg...@us...> - 2008-02-20 01:22:25
|
Update of /cvsroot/emacs-jabber/emacs-jabber In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv32316 Modified Files: jabber-core.el jabber-sasl.el jabber-util.el jabber-logon.el Log Message: Revision: ma...@fr...--2005/emacs-jabber--cvs-head--0--patch-450 Creator: Magnus Henoch <ma...@fr...> Only cache password on successful authentication Index: jabber-sasl.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-sasl.el,v retrieving revision 2.15 retrieving revision 2.16 diff -u -d -r2.15 -r2.16 --- jabber-sasl.el 18 Nov 2007 21:04:50 -0000 2.15 +++ jabber-sasl.el 20 Feb 2008 01:22:18 -0000 2.16 @@ -1,6 +1,6 @@ ;; jabber-sasl.el - SASL authentication -;; Copyright (C) 2004, 2007 - Magnus Henoch - ma...@fr... +;; Copyright (C) 2004, 2007, 2008 - Magnus Henoch - ma...@fr... ;; This file is a part of jabber.el. @@ -67,11 +67,14 @@ (fsm-send jc :authentication-failure) ;; Start authentication. - (let* ((client (sasl-make-client mechanism + (let* (passphrase + (client (sasl-make-client mechanism (plist-get (fsm-get-state-data jc) :username) "xmpp" (plist-get (fsm-get-state-data jc) :server))) - (sasl-read-passphrase (jabber-sasl-read-passphrase-closure jc)) + (sasl-read-passphrase (jabber-sasl-read-passphrase-closure + jc + (lambda (p) (setq passphrase (copy-sequence p)) p))) (step (sasl-next-step client nil))) (jabber-send-sexp jc @@ -79,20 +82,25 @@ (mechanism . ,(sasl-mechanism-name mechanism))) ,(when (sasl-step-data step) (base64-encode-string (sasl-step-data step) t)))) - (cons client step)))))) + (list client step passphrase)))))) -(defun jabber-sasl-read-passphrase-closure (jc) - "Return a lambda function suitable for `sasl-read-passphrase' for JC." +(defun jabber-sasl-read-passphrase-closure (jc remember) + "Return a lambda function suitable for `sasl-read-passphrase' for JC. +Call REMEMBER with the password. REMEMBER is expected to return it as well." (lexical-let ((password (plist-get (fsm-get-state-data jc) :password)) - (bare-jid (jabber-connection-bare-jid jc))) + (bare-jid (jabber-connection-bare-jid jc)) + (remember remember)) (if password - (lambda (prompt) (copy-sequence password)) - (lambda (prompt) (jabber-read-password bare-jid))))) + (lambda (prompt) (funcall remember (copy-sequence password))) + (lambda (prompt) (funcall remember (jabber-read-password bare-jid)))))) (defun jabber-sasl-process-input (jc xml-data sasl-data) - (let ((sasl-read-passphrase (jabber-sasl-read-passphrase-closure jc)) - (client (car sasl-data)) - (step (cdr sasl-data))) + (let* ((client (first sasl-data)) + (step (second sasl-data)) + (passphrase (third sasl-data)) + (sasl-read-passphrase (jabber-sasl-read-passphrase-closure + jc + (lambda (p) (setq passphrase (copy-sequence p)) p)))) (cond ((eq (car xml-data) 'challenge) (sasl-step-set-data step (base64-decode-string (car (jabber-xml-node-children xml-data)))) @@ -106,13 +114,12 @@ ((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) (message "Authentication succeeded") - (fsm-send jc :authentication-success))) - (cons client step))) + (fsm-send jc (cons :authentication-success passphrase)))) + (list client step passphrase))) (provide 'jabber-sasl) ;;; arch-tag: 2a4a234d-34d3-49dd-950d-518c899c0fd0 Index: jabber-util.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-util.el,v retrieving revision 2.53 retrieving revision 2.54 diff -u -d -r2.53 -r2.54 --- jabber-util.el 16 Jan 2008 15:22:49 -0000 2.53 +++ jabber-util.el 20 Feb 2008 01:22:18 -0000 2.54 @@ -263,12 +263,17 @@ (defun jabber-read-password (bare-jid) "Read Jabber password from minibuffer." (let ((prompt (format "Jabber password for %s: " bare-jid))) - (if (fboundp 'password-read-and-add) + (if (fboundp 'password-read) ;; Need to copy the password, as sasl.el wants to erase it. (copy-sequence - (password-read-and-add prompt (jabber-password-key bare-jid))) + (password-read prompt (jabber-password-key bare-jid))) (read-passwd prompt)))) +(defun jabber-cache-password (bare-jid password) + "Cache PASSWORD for BARE-JID." + (when (fboundp 'password-cache-add) + (password-cache-add (jabber-password-key bare-jid) password))) + (defun jabber-uncache-password (bare-jid) "Uncache cached password for BARE-JID. Useful if the password proved to be wrong." Index: jabber-logon.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-logon.el,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- jabber-logon.el 21 Jan 2008 21:06:58 -0000 1.19 +++ jabber-logon.el 20 Feb 2008 01:22:18 -0000 1.20 @@ -37,49 +37,43 @@ (defun jabber-do-logon (jc xml-data session-id) "send username and password in logon attempt" - (let (auth) - (if (jabber-xml-get-children (jabber-iq-query xml-data) 'digest) - ;; SHA1 digest passwords allowed - (let ((passwd (or (plist-get (fsm-get-state-data jc) :password) - (jabber-read-password (jabber-connection-bare-jid jc))))) - (if passwd - (setq auth `(digest () ,(sha1 (concat session-id passwd)))))) - ;; Plaintext passwords - allow on encrypted connections - (if (or (plist-get (fsm-get-state-data jc) :encrypted) - (yes-or-no-p "Jabber server only allows cleartext password transmission! Continue? ")) - (let ((passwd (or (plist-get (fsm-get-state-data jc) :password) - (jabber-read-password (jabber-connection-bare-jid jc))))) - (when passwd - (setq auth `(password () ,passwd)))))) - - ;; If auth is still nil, user cancelled process somewhere - (if auth - (progn - ;; For legacy authentication we must specify a resource. - (unless (plist-get (fsm-get-state-data jc) :resource) - ;; Yes, this is ugly. Where is my encapsulation? - (plist-put (fsm-get-state-data jc) :resource "emacs-jabber")) + (let* ((digest-allowed (jabber-xml-get-children (jabber-iq-query xml-data) 'digest)) + (passwd (when + (or digest-allowed + (plist-get (fsm-get-state-data jc) :encrypted) + (yes-or-no-p "Jabber server only allows cleartext password transmission! Continue? ")) + (or (plist-get (fsm-get-state-data jc) :password) + (jabber-read-password (jabber-connection-bare-jid jc))))) + auth) + (if (null passwd) + (fsm-send jc :authentication-failure) + (if digest-allowed + (setq auth `(digest () ,(sha1 (concat session-id passwd)))) + (setq auth `(password () ,passwd))) - (jabber-send-iq jc (plist-get (fsm-get-state-data jc) :server) - "set" - `(query ((xmlns . "jabber:iq:auth")) - (username () ,(plist-get (fsm-get-state-data jc) :username)) - ,auth - (resource () ,(plist-get (fsm-get-state-data jc) :resource))) - #'jabber-process-logon t - #'jabber-process-logon nil)) - (fsm-send jc :authentication-failure)))) + ;; For legacy authentication we must specify a resource. + (unless (plist-get (fsm-get-state-data jc) :resource) + ;; Yes, this is ugly. Where is my encapsulation? + (plist-put (fsm-get-state-data jc) :resource "emacs-jabber")) + + (jabber-send-iq jc (plist-get (fsm-get-state-data jc) :server) + "set" + `(query ((xmlns . "jabber:iq:auth")) + (username () ,(plist-get (fsm-get-state-data jc) :username)) + ,auth + (resource () ,(plist-get (fsm-get-state-data jc) :resource))) + #'jabber-process-logon passwd + #'jabber-process-logon nil)))) (defun jabber-process-logon (jc xml-data closure-data) "receive login success or failure, and request roster. -CLOSURE-DATA should be t on success and nil on failure." +CLOSURE-DATA should be the password on success and nil on failure." (if closure-data ;; Logon success - (fsm-send jc :authentication-success) + (fsm-send jc (cons :authentication-success closure-data)) ;; 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-core.el =================================================================== RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-core.el,v retrieving revision 1.79 retrieving revision 1.80 diff -u -d -r1.79 -r1.80 --- jabber-core.el 19 Feb 2008 16:15:53 -0000 1.79 +++ jabber-core.el 20 Feb 2008 01:22:18 -0000 1.80 @@ -497,9 +497,11 @@ (list :legacy-auth state-data)))) (:authentication-success + (jabber-cache-password (jabber-connection-bare-jid fsm) (cdr event)) (list :session-established state-data)) (:authentication-failure + (jabber-uncache-password (jabber-connection-bare-jid fsm)) ;; jabber-logon has already displayed a message (list nil (plist-put state-data :disconnection-expected t))) @@ -543,9 +545,11 @@ (list :legacy-auth (plist-put state-data :sasl-data nil))) (:authentication-success + (jabber-cache-password (jabber-connection-bare-jid fsm) (cdr event)) (list :bind (plist-put state-data :sasl-data nil))) (:authentication-failure + (jabber-uncache-password (jabber-connection-bare-jid fsm)) ;; jabber-sasl has already displayed a message (list nil (plist-put state-data :disconnection-expected t))) |