From a892ee0875d6b293471b71f8f1c492b647883e76 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Wed, 29 Aug 2007 01:45:36 +0000 Subject: [PATCH] Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-396 Creator: Magnus Henoch Add customization option for multiple accounts Based on a patch by Xavier Maillard. --- jabber-conn.el | 47 ++++++++++---------- jabber-core.el | 112 ++++++++++++++++++++++++++++++++++------------- jabber-keymap.el | 2 +- jabber-logon.el | 3 +- jabber-sasl.el | 8 ++-- jabber-util.el | 4 +- jabber.el | 38 ++++++++++++++++ 7 files changed, 153 insertions(+), 61 deletions(-) diff --git a/jabber-conn.el b/jabber-conn.el index c08256e..959d22a 100644 --- a/jabber-conn.el +++ b/jabber-conn.el @@ -61,23 +61,24 @@ and 5223 for SSL connections." (integer :tag "Port number")) :group 'jabber-conn) -(defcustom jabber-connection-type +(defun jabber-have-starttls () + "Return true if we can use STARTTLS." + (and (featurep 'starttls) + (or (and (bound-and-true-p starttls-gnutls-program) + (executable-find starttls-gnutls-program)) + (and (bound-and-true-p starttls-program) + (executable-find starttls-program))))) + +(defconst jabber-default-connection-type (cond ;; Use STARTTLS if we can... - ((and (featurep 'starttls) - (or (and (bound-and-true-p starttls-gnutls-program) - (executable-find starttls-gnutls-program)) - (and (bound-and-true-p starttls-program) - (executable-find starttls-program)))) + ((jabber-have-starttls) 'starttls) ;; ...else default to unencrypted connection. (t 'network)) - "Type of connection to the jabber server, ssl or network most likely." - :type '(radio (const :tag "Encrypted connection, SSL" ssl) - (const :tag "Negotiate encrypted connection when available (STARTTLS)" starttls) - (const :tag "Standard TCP/IP connection" network)) - :group 'jabber-conn) + "Default connection type. +See `jabber-connect-methods'.") (defcustom jabber-connection-ssl-program nil "Program used for SSL/TLS connections. @@ -110,21 +111,21 @@ TYPE is a symbol; see `jabber-connection-type'." (let ((entry (assq jabber-connection-type jabber-connect-methods))) (nth 2 entry))) -(defun jabber-srv-targets (server) +(defun jabber-srv-targets (server network-server port) "Find host and port to connect to. +If NETWORK-SERVER and/or PORT are specified, use them. If we can't find SRV records, use standard defaults." - ;; XXX: per account ;; If the user has specified a host or a port, obey that. - (if (or jabber-network-server jabber-port) - (list (cons (or jabber-network-server server) - (or jabber-port 5222))) + (if (or network-server port) + (list (cons (or network-server server) + (or port 5222))) (or (condition-case nil (srv-lookup (concat "_xmpp-client._tcp." server)) (error nil)) (list (cons server 5222))))) ;; Plain TCP/IP connection -(defun jabber-network-connect (fsm server) +(defun jabber-network-connect (fsm server network-server port) "Connect to a Jabber server with a plain network connection. Send a message of the form (:connected CONNECTION) to FSM if connection succeeds. Send a message :connection-failed if @@ -132,7 +133,7 @@ connection fails." ;; XXX: asynchronous connection (let ((coding-system-for-read 'utf-8) (coding-system-for-write 'utf-8) - (targets (jabber-srv-targets server))) + (targets (jabber-srv-targets server network-server port))) (catch 'connected (dolist (target targets) (condition-case e @@ -157,7 +158,7 @@ connection fails." ;; SSL connection, we use openssl's s_client function for encryption ;; of the link ;; TODO: make this configurable -(defun jabber-ssl-connect (fsm server) +(defun jabber-ssl-connect (fsm server network-server port) "connect via OpenSSL or GnuTLS to a Jabber Server Send a message of the form (:connected CONNECTION) to FSM if connection succeeds. Send a message :connection-failed if @@ -179,8 +180,8 @@ connection fails." (funcall connect-function "jabber" (generate-new-buffer jabber-process-buffer) - (or jabber-network-server server) - (or jabber-port 5223)))) + (or network-server server) + (or port 5223)))) (if connection (fsm-send fsm (list :connected connection)) (fsm-send fsm :connection-failed))))) @@ -191,14 +192,14 @@ connection fails." (process-send-string connection string) (process-send-string connection "\n")) -(defun jabber-starttls-connect (fsm server) +(defun jabber-starttls-connect (fsm server network-server port) "Connect via GnuTLS to a Jabber Server. Send a message of the form (:connected CONNECTION) to FSM if connection succeeds. Send a message :connection-failed if connection fails." (let ((coding-system-for-read 'utf-8) (coding-system-for-write 'utf-8) - (targets (jabber-srv-targets server))) + (targets (jabber-srv-targets server network-server port))) (unless (fboundp 'starttls-open-stream) (error "starttls.el not available")) (catch 'connected diff --git a/jabber-core.el b/jabber-core.el index 4eb51a8..6c01437 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -127,29 +127,77 @@ problems." "Return non-nil if SASL functions are available." (featurep 'sasl)) -(defun jabber-connect (username server resource &optional registerp) - "connect to the jabber server and start a jabber xml stream -With prefix argument, register a new account." +(defun jabber-connect-all () + "Connect to all configured Jabber accounts. +See `jabber-account-list'. +If no accounts are configured, call `jabber-connect' interactively." + (interactive) + (if (null jabber-account-list) + (call-interactively 'jabber-connect) + ;; Only connect those accounts that are not yet connected. + (let ((already-connected (mapcar #'jabber-connection-bare-jid jabber-connections)) + (connected-one nil)) + (flet ((nonempty + (s) + (unless (zerop (length s)) s))) + (dolist (account jabber-account-list) + (unless (member (jabber-jid-user (car account)) already-connected) + (destructuring-bind (jid password network-server port connection-type) + account + (jabber-connect + (jabber-jid-username jid) + (jabber-jid-server jid) + (jabber-jid-resource jid) + nil (nonempty password) (nonempty network-server) + port connection-type)))))))) + +(defun jabber-connect (username server resource &optional + registerp password network-server + port connection-type) + "Connect to the Jabber server and start a Jabber XML stream. +With prefix argument, register a new account. +With double prefix argument, specify more connection details." (interactive - (let* ((default (when (and jabber-username jabber-server) - (if jabber-resource - (format "%s@%s/%s" - jabber-username - jabber-server - jabber-resource) - (format "%s@%s" - jabber-username - jabber-server)))) - (jid (read-string - (if default - (format "Enter your JID: (default %s) " default) - "Enter your JID: ") - nil nil default))) - (list (jabber-jid-username jid) - (jabber-jid-server jid) - (or (jabber-jid-resource jid) jabber-resource) - current-prefix-arg))) - ;; XXX: better way of specifying which account(s) to connect to. + (let* ((jid (completing-read "Enter your JID: " jabber-account-list)) + (entry (assoc jid jabber-account-list)) + password network-server port connection-type registerp) + (flet ((nonempty + (s) + (unless (zerop (length s)) s))) + (when entry + ;; If the user entered the JID of one of the preconfigured + ;; accounts, use that data. + (setq password (nonempty (nth 1 entry))) + (setq network-server (nonempty (nth 2 entry))) + (setq port (nth 3 entry)) + (setq connection-type (nth 4 entry))) + (when (equal current-prefix-arg '(16)) + ;; Double prefix arg: ask about everything. + ;; (except password, which is asked about later anyway) + (setq password nil) + (setq network-server + (read-string (format "Network server: (default `%s') " network-server) + nil nil network-server)) + (setq port + (car + (read-from-string + (read-string (format "Port: (default `%s') " port) + nil nil (if port (number-to-string port) "nil"))))) + (setq connection-type + (car + (read-from-string + (or (nonempty (completing-read + (format "Connection type: (default `%s') " connection-type) + '(("starttls" "network" "ssl")) t)) + (symbol-name connection-type))))) + (setq registerp (yes-or-no-p "Register new account? "))) + (when (equal current-prefix-arg '(4)) + (setq registerp t)) + + (list (jabber-jid-username jid) + (jabber-jid-server jid) + (jabber-jid-resource jid) + registerp password network-server port connection-type)))) (if (member (list username server) (mapcar @@ -164,26 +212,28 @@ With prefix argument, register a new account." ;;(jabber-clear-roster) (jabber-reset-choked) - (push (start-jabber-connection username - server - resource - registerp) + (push (start-jabber-connection username server resource + registerp password + network-server port connection-type) jabber-connections))) (define-state-machine jabber-connection - :start ((username server resource &optional registerp) + :start ((username server resource registerp password network-server port connection-type) "Start a Jabber connection." - (let ((connect-function - (jabber-get-connect-function jabber-connection-type)) + (let* ((connection-type + (or connection-type jabber-default-connection-type)) + (connect-function + (jabber-get-connect-function connection-type)) (send-function - (jabber-get-send-function jabber-connection-type))) - (funcall connect-function fsm server) + (jabber-get-send-function connection-type))) + (funcall connect-function fsm server network-server port) (list :connecting (list :send-function send-function :username username :server server :resource resource + :password password :registerp registerp))))) (define-enter-state jabber-connection nil diff --git a/jabber-keymap.el b/jabber-keymap.el index b1cd593..90b8da5 100644 --- a/jabber-keymap.el +++ b/jabber-keymap.el @@ -41,7 +41,7 @@ (defvar jabber-global-keymap (let ((map (make-sparse-keymap))) - (define-key map "\C-c" 'jabber-connect) + (define-key map "\C-c" 'jabber-connect-all) (define-key map "\C-d" 'jabber-disconnect) (define-key map "\C-r" 'jabber-switch-to-roster-buffer) (define-key map "\C-j" 'jabber-chat-with) diff --git a/jabber-logon.el b/jabber-logon.el index 76e8d11..7062b5c 100644 --- a/jabber-logon.el +++ b/jabber-logon.el @@ -40,7 +40,8 @@ (let (auth) (if (jabber-xml-get-children (jabber-iq-query xml-data) 'digest) ;; SHA1 digest passwords allowed - (let ((passwd (jabber-read-password (jabber-connection-bare-jid jc)))) + (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 diff --git a/jabber-sasl.el b/jabber-sasl.el index 7111d39..c4e880d 100644 --- a/jabber-sasl.el +++ b/jabber-sasl.el @@ -81,9 +81,11 @@ (cons client step)))))) (defun jabber-sasl-process-input (jc xml-data sasl-data) - (let ((sasl-read-passphrase (lexical-let ((bare-jid (jabber-connection-bare-jid jc))) - (lambda (prompt) - (jabber-read-password bare-jid prompt)))) + (let ((sasl-read-passphrase (lexical-let ((password (plist-get (fsm-get-state-data jc) :password)) + (bare-jid (jabber-connection-bare-jid jc))) + (if password + (lambda (prompt) password) + (lambda (prompt) (jabber-read-password bare-jid))))) (client (car sasl-data)) (step (cdr sasl-data))) (cond diff --git a/jabber-util.el b/jabber-util.el index e309936..11373fa 100644 --- a/jabber-util.el +++ b/jabber-util.el @@ -260,7 +260,7 @@ bare-or-muc Turn full JIDs to bare ones, except for in MUC" "Construct key for `password' library from BARE-JID." (concat "xmpp:" bare-jid)) -(defun jabber-read-password (bare-jid &optional prompt) +(defun jabber-read-password (bare-jid) "Read Jabber password, either from customized variable or from minibuffer. See `jabber-password'." (if jabber-password @@ -268,7 +268,7 @@ See `jabber-password'." ;; variable jabber-password is a high-convenience low-security ;; alternative anyway. (copy-sequence jabber-password) - (let ((prompt (or prompt (format "Jabber password for %s: " bare-jid)))) + (let ((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))))) diff --git a/jabber.el b/jabber.el index bbf8db5..7b92ca2 100644 --- a/jabber.el +++ b/jabber.el @@ -30,6 +30,43 @@ (defgroup jabber nil "Jabber instant messaging" :group 'applications) +(defcustom jabber-account-list nil + "List of Jabber accounts. +Each element of the list is a list describing a Jabber account +of the form (JID PASSWORD NETWORK-SERVER PORT CONNECTION-TYPE). + +JID is a full Jabber ID string (e.g. foo@bar.tld). You can also +specify the resource (e.g. foo@bar.tld/emacs). +PASSWORD is a string to authenticate ourself against the server. +It can be empty. +NETWORK-SERVER is a string identifying the address to connect to, +if it's different from the server part of the JID. +PORT is the port to use (default depends on connection type). +CONNECTION-TYPE is a symbol. Valid symbols are `starttls', +`network' and `ssl'. + +Only JID is mandatory. The rest can be guessed at run-time. + +Example: + ((\"xma01@jabber.fr/emacs\" \"\" \"\" nil network) + (\"xma01@gmail.com\" \"\" \"talk.google.com\" 5223 ssl))" + :type '(repeat + (list :tag "Account information" + (string :tag "JID") + (string :tag "Password") + (string :tag "Network server") + (choice :tag "Port" + (const :tag "Default" nil) + (integer :tag "Override" 5222)) + (choice :tag "Connection type" + ;; XXX: detect whether we have STARTTLS? option + ;; for enforcing encryption? + (const :tag "STARTTLS" starttls) + (const :tag "Unencrypted" network) + (const :tag "Legacy SSL/TLS" ssl)))) + :group 'jabber-core) + +;; XXX: kill these four variables (defcustom jabber-username "emacs" "jabber username (user part of JID)" :type 'string @@ -70,6 +107,7 @@ :type 'integer :group 'jabber) +;; XXX: kill this one too (defcustom jabber-nickname jabber-username "jabber nickname, used in chat buffer prompts and as default groupchat nickname." :type 'string