wgreenhouse
/
emacs-jabber
1
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-335 

Creator:  Magnus Henoch <mange@freemail.hu>

Fix account registration
This commit is contained in:
Magnus Henoch 2007-03-20 16:13:35 +00:00 committed by Kirill A. Korinskiy
parent 54ba5ca908
commit 5ab4ce3da8
3 changed files with 72 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
jabber-core.el
View File

@ -166,11 +166,12 @@ With prefix argument, register a new account."
(push (start-jabber-connection username
server
resource)
resource
registerp)
jabber-connections)))
(define-state-machine jabber-connection
:start ((username server resource)
:start ((username server resource &optional registerp)
"Start a Jabber connection."
(let ((connect-function
(jabber-get-connect-function jabber-connection-type))
@ -182,7 +183,8 @@ With prefix argument, register a new account."
(list :send-function send-function
:username username
:server server
:resource resource)))))
:resource resource
:registerp registerp)))))
(define-enter-state jabber-connection nil
(fsm state-data)
@ -202,7 +204,7 @@ With prefix argument, register a new account."
(case (or (car-safe event) event)
(:connected
(let ((connection (cadr event))
(registerp nil)) ;XXX: fix registration
(registerp (plist-get state-data :registerp)))
;; TLS connections leave data in the process buffer, which
;; the XML parser will choke on.
@ -216,8 +218,6 @@ With prefix argument, register a new account."
(set-process-filter connection (fsm-make-filter fsm))
(set-process-sentinel connection (fsm-make-sentinel fsm))
(setq jabber-register-p registerp)
(list :connected state-data)))
(:connection-failed
@ -269,7 +269,9 @@ With prefix argument, register a new account."
;; Stay in same state...
(list :connected state-data))
;; Register account?
;; XXX: implement later
((plist-get state-data :registerp)
;; XXX: require encryption for registration?
(list :register-account state-data))
;; Legacy authentication?
(t
(list :legacy-auth (plist-put state-data :session-id session-id))))))
@ -283,6 +285,12 @@ With prefix argument, register a new account."
(cond
((jabber-xml-get-children stanza 'starttls)
(list :starttls state-data))
;; XXX: require encryption for registration?
((plist-get state-data :registerp)
;; We could check for the <register/> element in stream
;; features, but as a client we would only lose by doing
;; that.
(list :register-account state-data))
(t
(list :sasl-auth (plist-put state-data :stream-features stanza))))))))
@ -312,6 +320,29 @@ With prefix argument, register a new account."
(message "STARTTLS negotiation failed")
(list nil state-data)))))
(define-enter-state jabber-connection :register-account
(fsm state-data)
(jabber-get-register fsm nil)
(list state-data nil))
(define-state jabber-connection :register-account
(fsm state-data event callback)
;; The connection will be closed in jabber-register
(case (or (car-safe event) event)
(:filter
(let ((process (cadr event))
(string (car (cddr event))))
(jabber-pre-filter process string fsm)
(list :register-account state-data)))
(:sentinel
(message "Jabber connection unexpectedly closed")
(list nil state-data))
(:stanza
(jabber-process-input fsm (cadr event))
(list :register-account state-data))))
(define-enter-state jabber-connection :legacy-auth
(fsm state-data)
(jabber-get-auth fsm (plist-get state-data :server)

54
jabber-register.el
View File

@ -45,41 +45,42 @@
((string= (jabber-iq-xmlns xml-data) "jabber:iq:search")
'search)
(t
(error "Namespace %s not handled by jabber-process-register-or-search" (jabber-iq-xmlns xml-data))))))
(error "Namespace %s not handled by jabber-process-register-or-search" (jabber-iq-xmlns xml-data)))))
(register-account
(plist-get (fsm-get-state-data jc) :registerp))
(username
(plist-get (fsm-get-state-data jc) :username))
(server
(plist-get (fsm-get-state-data jc) :server)))
(cond
((eq type 'register)
;; If there is no `from' attribute, we are registering with the server
(jabber-init-widget-buffer (or (jabber-xml-get-attribute xml-data 'from) jabber-server)))
(jabber-init-widget-buffer (or (jabber-xml-get-attribute xml-data 'from)
server)))
((eq type 'search)
;; no such thing here
(jabber-init-widget-buffer (jabber-xml-get-attribute xml-data 'from))))
(setq 'jabber-buffer-connection jc)
(setq jabber-buffer-connection jc)
(widget-insert (if (eq type 'register) "Register with " "Search ") jabber-submit-to "\n\n")
(when (and (eq type 'register)
jabber-register-p)
(widget-insert "Don't change the username here unless you also change ")
(widget-create 'link
:notify (lambda (&rest ignore)
(customize-variable 'jabber-username))
"jabber-username")
(widget-insert ".\n\n"))
(dolist (x (jabber-xml-get-children query 'x))
(when (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:data")
(setq have-xdata t)
;; If the registration form obeys JEP-0068, we know
;; for sure how to put a default username in it.
(jabber-render-xdata-form x
(if (and jabber-register-p
(if (and register-account
(string= (jabber-xdata-formtype x) "jabber:iq:register"))
(list (cons "username" jabber-username))
(list (cons "username" username))
nil))))
(if (not have-xdata)
(jabber-render-register-form query))
(jabber-render-register-form query
(when register-account
username)))
(widget-create 'push-button :notify (if (eq type 'register)
#'jabber-submit-register
@ -94,10 +95,11 @@
(defun jabber-submit-register (&rest ignore)
"Submit registration input. See `jabber-process-register-or-search'."
(let ((handler (if jabber-register-p
#'jabber-process-register-secondtime
#'jabber-report-success))
(text (concat "Registration with " jabber-submit-to)))
(let* ((registerp (plist-get (fsm-get-state-data jabber-buffer-connection) :registerp))
(handler (if registerp
#'jabber-process-register-secondtime
#'jabber-report-success))
(text (concat "Registration with " jabber-submit-to)))
(jabber-send-iq jabber-buffer-connection jabber-submit-to
"set"
@ -110,8 +112,8 @@
,(jabber-parse-xdata-form)))
(t
(error "Unknown form type: %s" jabber-form-type)))
handler (if jabber-register-p 'success text)
handler (if jabber-register-p 'failure text)))
handler (if registerp 'success text)
handler (if registerp 'failure text)))
(message "Registration sent"))
@ -120,13 +122,11 @@
CLOSURE-DATA is either 'success or 'error."
(cond
((eq closure-data 'success)
(message "Registration successful. Your JID is %s@%s. You may now connect to the server."
jabber-username jabber-server)
(sit-for 3)
(jabber-disconnect-one jc))
(message "Registration successful. You may now connect to the server."))
(t
(jabber-report-success jc xml-data "Account registration")
(sit-for 3))))
(jabber-report-success jc xml-data "Account registration")))
(sit-for 3)
(jabber-disconnect-one jc))
(defun jabber-remove-register (&rest ignore)
"Cancel registration. See `jabber-process-register-or-search'."

14
jabber-widget.el
View File

@ -1,7 +1,7 @@
;; jabber-widget.el - display various kinds of forms
;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - mange@freemail.hu
;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
;; Copyright (C) 2003, 2004 - Magnus Henoch - mange@freemail.hu
;; This file is a part of jabber.el.
@ -91,8 +91,9 @@
;; better way.
(rename-uniquely))
(defun jabber-render-register-form (query)
"Display widgets from <query/> element in jabber:iq:{register,search} namespace."
(defun jabber-render-register-form (query &optional default-username)
"Display widgets from <query/> element in jabber:iq:{register,search} namespace.
DEFAULT-USERNAME is the default value for the username field."
(make-local-variable 'jabber-widget-alist)
(setq jabber-widget-alist nil)
(make-local-variable 'jabber-form-type)
@ -127,10 +128,9 @@
;; Special case: when registering a new account, the default
;; username is the one specified in jabber-username. Things
;; will break if the user changes that name, though...
(let ((default-value (if (and jabber-register-p
(eq (jabber-xml-node-name field) 'username))
jabber-username
"")))
(let ((default-value (or (when (eq (jabber-xml-node-name field) 'username)
default-username)
"")))
(setq jabber-widget-alist
(cons
(cons (car entry)