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:
Magnus Henoch
Kirill A. Korinskiy
parent
c0d276fe1b
commit
a892ee0875
|
|
@ -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
|
||||
|
|
|
|||
112
jabber-core.el
112
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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
38
jabber.el
38
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue