Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-396
Creator: Magnus Henoch <mange@freemail.hu> Add customization option for multiple accounts Based on a patch by Xavier Maillard.
This commit is contained in:
parent
c0d276fe1b
commit
a892ee0875
|
@ -61,23 +61,24 @@ and 5223 for SSL connections."
|
||||||
(integer :tag "Port number"))
|
(integer :tag "Port number"))
|
||||||
:group 'jabber-conn)
|
: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
|
(cond
|
||||||
;; Use STARTTLS if we can...
|
;; Use STARTTLS if we can...
|
||||||
((and (featurep 'starttls)
|
((jabber-have-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))))
|
|
||||||
'starttls)
|
'starttls)
|
||||||
;; ...else default to unencrypted connection.
|
;; ...else default to unencrypted connection.
|
||||||
(t
|
(t
|
||||||
'network))
|
'network))
|
||||||
"Type of connection to the jabber server, ssl or network most likely."
|
"Default connection type.
|
||||||
:type '(radio (const :tag "Encrypted connection, SSL" ssl)
|
See `jabber-connect-methods'.")
|
||||||
(const :tag "Negotiate encrypted connection when available (STARTTLS)" starttls)
|
|
||||||
(const :tag "Standard TCP/IP connection" network))
|
|
||||||
:group 'jabber-conn)
|
|
||||||
|
|
||||||
(defcustom jabber-connection-ssl-program nil
|
(defcustom jabber-connection-ssl-program nil
|
||||||
"Program used for SSL/TLS connections.
|
"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)))
|
(let ((entry (assq jabber-connection-type jabber-connect-methods)))
|
||||||
(nth 2 entry)))
|
(nth 2 entry)))
|
||||||
|
|
||||||
(defun jabber-srv-targets (server)
|
(defun jabber-srv-targets (server network-server port)
|
||||||
"Find host and port to connect to.
|
"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."
|
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 the user has specified a host or a port, obey that.
|
||||||
(if (or jabber-network-server jabber-port)
|
(if (or network-server port)
|
||||||
(list (cons (or jabber-network-server server)
|
(list (cons (or network-server server)
|
||||||
(or jabber-port 5222)))
|
(or port 5222)))
|
||||||
(or (condition-case nil
|
(or (condition-case nil
|
||||||
(srv-lookup (concat "_xmpp-client._tcp." server))
|
(srv-lookup (concat "_xmpp-client._tcp." server))
|
||||||
(error nil))
|
(error nil))
|
||||||
(list (cons server 5222)))))
|
(list (cons server 5222)))))
|
||||||
|
|
||||||
;; Plain TCP/IP connection
|
;; 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.
|
"Connect to a Jabber server with a plain network connection.
|
||||||
Send a message of the form (:connected CONNECTION) to FSM if
|
Send a message of the form (:connected CONNECTION) to FSM if
|
||||||
connection succeeds. Send a message :connection-failed if
|
connection succeeds. Send a message :connection-failed if
|
||||||
|
@ -132,7 +133,7 @@ connection fails."
|
||||||
;; XXX: asynchronous connection
|
;; XXX: asynchronous connection
|
||||||
(let ((coding-system-for-read 'utf-8)
|
(let ((coding-system-for-read 'utf-8)
|
||||||
(coding-system-for-write 'utf-8)
|
(coding-system-for-write 'utf-8)
|
||||||
(targets (jabber-srv-targets server)))
|
(targets (jabber-srv-targets server network-server port)))
|
||||||
(catch 'connected
|
(catch 'connected
|
||||||
(dolist (target targets)
|
(dolist (target targets)
|
||||||
(condition-case e
|
(condition-case e
|
||||||
|
@ -157,7 +158,7 @@ connection fails."
|
||||||
;; SSL connection, we use openssl's s_client function for encryption
|
;; SSL connection, we use openssl's s_client function for encryption
|
||||||
;; of the link
|
;; of the link
|
||||||
;; TODO: make this configurable
|
;; 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
|
"connect via OpenSSL or GnuTLS to a Jabber Server
|
||||||
Send a message of the form (:connected CONNECTION) to FSM if
|
Send a message of the form (:connected CONNECTION) to FSM if
|
||||||
connection succeeds. Send a message :connection-failed if
|
connection succeeds. Send a message :connection-failed if
|
||||||
|
@ -179,8 +180,8 @@ connection fails."
|
||||||
(funcall connect-function
|
(funcall connect-function
|
||||||
"jabber"
|
"jabber"
|
||||||
(generate-new-buffer jabber-process-buffer)
|
(generate-new-buffer jabber-process-buffer)
|
||||||
(or jabber-network-server server)
|
(or network-server server)
|
||||||
(or jabber-port 5223))))
|
(or port 5223))))
|
||||||
(if connection
|
(if connection
|
||||||
(fsm-send fsm (list :connected connection))
|
(fsm-send fsm (list :connected connection))
|
||||||
(fsm-send fsm :connection-failed)))))
|
(fsm-send fsm :connection-failed)))))
|
||||||
|
@ -191,14 +192,14 @@ connection fails."
|
||||||
(process-send-string connection string)
|
(process-send-string connection string)
|
||||||
(process-send-string connection "\n"))
|
(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.
|
"Connect via GnuTLS to a Jabber Server.
|
||||||
Send a message of the form (:connected CONNECTION) to FSM if
|
Send a message of the form (:connected CONNECTION) to FSM if
|
||||||
connection succeeds. Send a message :connection-failed if
|
connection succeeds. Send a message :connection-failed if
|
||||||
connection fails."
|
connection fails."
|
||||||
(let ((coding-system-for-read 'utf-8)
|
(let ((coding-system-for-read 'utf-8)
|
||||||
(coding-system-for-write '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)
|
(unless (fboundp 'starttls-open-stream)
|
||||||
(error "starttls.el not available"))
|
(error "starttls.el not available"))
|
||||||
(catch 'connected
|
(catch 'connected
|
||||||
|
|
112
jabber-core.el
112
jabber-core.el
|
@ -127,29 +127,77 @@ problems."
|
||||||
"Return non-nil if SASL functions are available."
|
"Return non-nil if SASL functions are available."
|
||||||
(featurep 'sasl))
|
(featurep 'sasl))
|
||||||
|
|
||||||
(defun jabber-connect (username server resource &optional registerp)
|
(defun jabber-connect-all ()
|
||||||
"connect to the jabber server and start a jabber xml stream
|
"Connect to all configured Jabber accounts.
|
||||||
With prefix argument, register a new account."
|
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
|
(interactive
|
||||||
(let* ((default (when (and jabber-username jabber-server)
|
(let* ((jid (completing-read "Enter your JID: " jabber-account-list))
|
||||||
(if jabber-resource
|
(entry (assoc jid jabber-account-list))
|
||||||
(format "%s@%s/%s"
|
password network-server port connection-type registerp)
|
||||||
jabber-username
|
(flet ((nonempty
|
||||||
jabber-server
|
(s)
|
||||||
jabber-resource)
|
(unless (zerop (length s)) s)))
|
||||||
(format "%s@%s"
|
(when entry
|
||||||
jabber-username
|
;; If the user entered the JID of one of the preconfigured
|
||||||
jabber-server))))
|
;; accounts, use that data.
|
||||||
(jid (read-string
|
(setq password (nonempty (nth 1 entry)))
|
||||||
(if default
|
(setq network-server (nonempty (nth 2 entry)))
|
||||||
(format "Enter your JID: (default %s) " default)
|
(setq port (nth 3 entry))
|
||||||
"Enter your JID: ")
|
(setq connection-type (nth 4 entry)))
|
||||||
nil nil default)))
|
(when (equal current-prefix-arg '(16))
|
||||||
(list (jabber-jid-username jid)
|
;; Double prefix arg: ask about everything.
|
||||||
(jabber-jid-server jid)
|
;; (except password, which is asked about later anyway)
|
||||||
(or (jabber-jid-resource jid) jabber-resource)
|
(setq password nil)
|
||||||
current-prefix-arg)))
|
(setq network-server
|
||||||
;; XXX: better way of specifying which account(s) to connect to.
|
(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
|
(if (member (list username
|
||||||
server)
|
server)
|
||||||
(mapcar
|
(mapcar
|
||||||
|
@ -164,26 +212,28 @@ With prefix argument, register a new account."
|
||||||
;;(jabber-clear-roster)
|
;;(jabber-clear-roster)
|
||||||
(jabber-reset-choked)
|
(jabber-reset-choked)
|
||||||
|
|
||||||
(push (start-jabber-connection username
|
(push (start-jabber-connection username server resource
|
||||||
server
|
registerp password
|
||||||
resource
|
network-server port connection-type)
|
||||||
registerp)
|
|
||||||
jabber-connections)))
|
jabber-connections)))
|
||||||
|
|
||||||
(define-state-machine jabber-connection
|
(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."
|
"Start a Jabber connection."
|
||||||
(let ((connect-function
|
(let* ((connection-type
|
||||||
(jabber-get-connect-function jabber-connection-type))
|
(or connection-type jabber-default-connection-type))
|
||||||
|
(connect-function
|
||||||
|
(jabber-get-connect-function connection-type))
|
||||||
(send-function
|
(send-function
|
||||||
(jabber-get-send-function jabber-connection-type)))
|
(jabber-get-send-function connection-type)))
|
||||||
(funcall connect-function fsm server)
|
(funcall connect-function fsm server network-server port)
|
||||||
|
|
||||||
(list :connecting
|
(list :connecting
|
||||||
(list :send-function send-function
|
(list :send-function send-function
|
||||||
:username username
|
:username username
|
||||||
:server server
|
:server server
|
||||||
:resource resource
|
:resource resource
|
||||||
|
:password password
|
||||||
:registerp registerp)))))
|
:registerp registerp)))))
|
||||||
|
|
||||||
(define-enter-state jabber-connection nil
|
(define-enter-state jabber-connection nil
|
||||||
|
|
|
@ -41,7 +41,7 @@
|
||||||
|
|
||||||
(defvar jabber-global-keymap
|
(defvar jabber-global-keymap
|
||||||
(let ((map (make-sparse-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-d" 'jabber-disconnect)
|
||||||
(define-key map "\C-r" 'jabber-switch-to-roster-buffer)
|
(define-key map "\C-r" 'jabber-switch-to-roster-buffer)
|
||||||
(define-key map "\C-j" 'jabber-chat-with)
|
(define-key map "\C-j" 'jabber-chat-with)
|
||||||
|
|
|
@ -40,7 +40,8 @@
|
||||||
(let (auth)
|
(let (auth)
|
||||||
(if (jabber-xml-get-children (jabber-iq-query xml-data) 'digest)
|
(if (jabber-xml-get-children (jabber-iq-query xml-data) 'digest)
|
||||||
;; SHA1 digest passwords allowed
|
;; 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
|
(if passwd
|
||||||
(setq auth `(digest () ,(sha1 (concat session-id passwd))))))
|
(setq auth `(digest () ,(sha1 (concat session-id passwd))))))
|
||||||
;; Plaintext passwords - allow on encrypted connections
|
;; Plaintext passwords - allow on encrypted connections
|
||||||
|
|
|
@ -81,9 +81,11 @@
|
||||||
(cons client step))))))
|
(cons client step))))))
|
||||||
|
|
||||||
(defun jabber-sasl-process-input (jc xml-data sasl-data)
|
(defun jabber-sasl-process-input (jc xml-data sasl-data)
|
||||||
(let ((sasl-read-passphrase (lexical-let ((bare-jid (jabber-connection-bare-jid jc)))
|
(let ((sasl-read-passphrase (lexical-let ((password (plist-get (fsm-get-state-data jc) :password))
|
||||||
(lambda (prompt)
|
(bare-jid (jabber-connection-bare-jid jc)))
|
||||||
(jabber-read-password bare-jid prompt))))
|
(if password
|
||||||
|
(lambda (prompt) password)
|
||||||
|
(lambda (prompt) (jabber-read-password bare-jid)))))
|
||||||
(client (car sasl-data))
|
(client (car sasl-data))
|
||||||
(step (cdr sasl-data)))
|
(step (cdr sasl-data)))
|
||||||
(cond
|
(cond
|
||||||
|
|
|
@ -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."
|
"Construct key for `password' library from BARE-JID."
|
||||||
(concat "xmpp:" 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.
|
"Read Jabber password, either from customized variable or from minibuffer.
|
||||||
See `jabber-password'."
|
See `jabber-password'."
|
||||||
(if jabber-password
|
(if jabber-password
|
||||||
|
@ -268,7 +268,7 @@ See `jabber-password'."
|
||||||
;; variable jabber-password is a high-convenience low-security
|
;; variable jabber-password is a high-convenience low-security
|
||||||
;; alternative anyway.
|
;; alternative anyway.
|
||||||
(copy-sequence jabber-password)
|
(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)
|
(if (fboundp 'password-read-and-add)
|
||||||
(password-read-and-add prompt (jabber-password-key bare-jid))
|
(password-read-and-add prompt (jabber-password-key bare-jid))
|
||||||
(read-passwd prompt)))))
|
(read-passwd prompt)))))
|
||||||
|
|
38
jabber.el
38
jabber.el
|
@ -30,6 +30,43 @@
|
||||||
(defgroup jabber nil "Jabber instant messaging"
|
(defgroup jabber nil "Jabber instant messaging"
|
||||||
:group 'applications)
|
: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"
|
(defcustom jabber-username "emacs"
|
||||||
"jabber username (user part of JID)"
|
"jabber username (user part of JID)"
|
||||||
:type 'string
|
:type 'string
|
||||||
|
@ -70,6 +107,7 @@
|
||||||
:type 'integer
|
:type 'integer
|
||||||
:group 'jabber)
|
:group 'jabber)
|
||||||
|
|
||||||
|
;; XXX: kill this one too
|
||||||
(defcustom jabber-nickname jabber-username
|
(defcustom jabber-nickname jabber-username
|
||||||
"jabber nickname, used in chat buffer prompts and as default groupchat nickname."
|
"jabber nickname, used in chat buffer prompts and as default groupchat nickname."
|
||||||
:type 'string
|
:type 'string
|
||||||
|
|
Loading…
Reference in New Issue