Menu
▾
▴
emacs-jabber jabber-conn.el, 2.8, 2.9 jabber.el, 1.75, 1.76 jabber-core.el, 1.62, 1.63 jabber-sasl.el, 2.11, 2.12 jabber-keymap.el, 1.9, 1.10 jabber-util.el, 2.49, 2.50 jabber-logon.el, 1.14, 1.15
|
From: Magnus H. <leg...@us...> - 2007-08-29 01:45:44
|
Update of /cvsroot/emacs-jabber/emacs-jabber
In directory sc8-pr-cvs17:/tmp/cvs-serv10930
Modified Files:
jabber-conn.el jabber.el jabber-core.el jabber-sasl.el
jabber-keymap.el jabber-util.el jabber-logon.el
Log Message:
Revision: ma...@fr...--2005/emacs-jabber--cvs-head--0--patch-396
Creator: Magnus Henoch <ma...@fr...>
Add customization option for multiple accounts
Based on a patch by Xavier Maillard.
Index: jabber-sasl.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-sasl.el,v
retrieving revision 2.11
retrieving revision 2.12
diff -u -d -r2.11 -r2.12
--- jabber-sasl.el 24 Aug 2007 03:12:14 -0000 2.11
+++ jabber-sasl.el 29 Aug 2007 01:45:36 -0000 2.12
@@ -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
Index: jabber.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber.el,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -d -r1.75 -r1.76
--- jabber.el 24 Aug 2007 01:36:05 -0000 1.75
+++ jabber.el 29 Aug 2007 01:45:36 -0000 1.76
@@ -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. fo...@ba...). You can also
+specify the resource (e.g. fo...@ba.../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:
+ ((\"xm...@ja.../emacs\" \"\" \"\" nil network)
+ (\"xm...@gm...\" \"\" \"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
Index: jabber-util.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-util.el,v
retrieving revision 2.49
retrieving revision 2.50
diff -u -d -r2.49 -r2.50
--- jabber-util.el 24 Aug 2007 02:43:50 -0000 2.49
+++ jabber-util.el 29 Aug 2007 01:45:36 -0000 2.50
@@ -260,7 +260,7 @@
"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 @@
;; 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)))))
Index: jabber-core.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-core.el,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -d -r1.62 -r1.63
--- jabber-core.el 28 Aug 2007 16:28:29 -0000 1.62
+++ jabber-core.el 29 Aug 2007 01:45:36 -0000 1.63
@@ -127,29 +127,77 @@
"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 @@
;;(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
Index: jabber-logon.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-logon.el,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- jabber-logon.el 24 Aug 2007 03:12:14 -0000 1.14
+++ jabber-logon.el 29 Aug 2007 01:45:36 -0000 1.15
@@ -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
Index: jabber-keymap.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-keymap.el,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- jabber-keymap.el 15 Apr 2007 23:53:09 -0000 1.9
+++ jabber-keymap.el 29 Aug 2007 01:45:36 -0000 1.10
@@ -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)
Index: jabber-conn.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-conn.el,v
retrieving revision 2.8
retrieving revision 2.9
diff -u -d -r2.8 -r2.9
--- jabber-conn.el 5 Feb 2007 21:59:02 -0000 2.8
+++ jabber-conn.el 29 Aug 2007 01:45:36 -0000 2.9
@@ -61,23 +61,24 @@
(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 @@
(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 @@
;; 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 @@
;; 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 @@
(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 @@
(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
|
