diff --git a/jabber-core.el b/jabber-core.el
index 279ff51..76f31f5 100644
--- a/jabber-core.el
+++ b/jabber-core.el
@@ -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 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)
diff --git a/jabber-register.el b/jabber-register.el
index b5b9665..7415f1a 100644
--- a/jabber-register.el
+++ b/jabber-register.el
@@ -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'."
diff --git a/jabber-widget.el b/jabber-widget.el
index d706339..9c31baf 100644
--- a/jabber-widget.el
+++ b/jabber-widget.el
@@ -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 element in jabber:iq:{register,search} namespace."
+(defun jabber-render-register-form (query &optional default-username)
+ "Display widgets from 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)