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)