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

Creator:  Magnus Henoch <mange@freemail.hu>

Fix account registration

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 <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)

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 
+  (let* ((registerp (plist-get (fsm-get-state-data jabber-buffer-connection) :registerp))
-		     #'jabber-process-register-secondtime
+	 (handler (if registerp
-		   #'jabber-report-success))
+		      #'jabber-process-register-secondtime
-	(text (concat "Registration with " jabber-submit-to)))
+		    #'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 registerp 'success text)
-		    handler (if jabber-register-p 'failure 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."
+    (message "Registration successful.  You may now connect to the server."))
-	     jabber-username jabber-server)
-    (sit-for 3)
-    (jabber-disconnect-one jc))
    (t
-    (jabber-report-success jc xml-data "Account registration")
+    (jabber-report-success jc xml-data "Account registration")))
-    (sit-for 3))))
+  (sit-for 3)
+    (jabber-disconnect-one jc))
 
 (defun jabber-remove-register (&rest ignore)
   "Cancel registration.  See `jabber-process-register-or-search'."

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)
+(defun jabber-render-register-form (query &optional default-username)
-  "Display widgets from <query/> element in jabber:iq:{register,search} namespace."
+  "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
+	  (let ((default-value (or (when (eq (jabber-xml-node-name field) 'username)
-					(eq (jabber-xml-node-name field) 'username))
+				     default-username)
-				   jabber-username
+				   "")))
-				 "")))
 	    (setq jabber-widget-alist 
 		  (cons
 		   (cons (car entry)