145 lines
5.3 KiB
EmacsLisp
145 lines
5.3 KiB
EmacsLisp
;; jabber-register.el - registration according to JEP-0077
|
|
|
|
;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - mange@freemail.hu
|
|
;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
|
|
|
|
;; This file is a part of jabber.el.
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; if not, write to the Free Software
|
|
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
(require 'jabber-iq)
|
|
(require 'jabber-widget)
|
|
|
|
(add-to-list 'jabber-jid-service-menu
|
|
(cons "Register with service" 'jabber-get-register))
|
|
(defun jabber-get-register (jc to)
|
|
"Send IQ get request in namespace \"jabber:iq:register\"."
|
|
(interactive (list (jabber-read-account)
|
|
(jabber-read-jid-completing "Register with: ")))
|
|
(jabber-send-iq jc to
|
|
"get"
|
|
'(query ((xmlns . "jabber:iq:register")))
|
|
#'jabber-process-data #'jabber-process-register-or-search
|
|
#'jabber-report-success "Registration"))
|
|
|
|
(defun jabber-process-register-or-search (jc xml-data)
|
|
"Display results from jabber:iq:{register,search} query as a form."
|
|
|
|
(let ((query (jabber-iq-query xml-data))
|
|
(have-xdata nil)
|
|
(type (cond
|
|
((string= (jabber-iq-xmlns xml-data) "jabber:iq:register")
|
|
'register)
|
|
((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)))))
|
|
(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)
|
|
server)))
|
|
|
|
((eq type 'search)
|
|
;; no such thing here
|
|
(jabber-init-widget-buffer (jabber-xml-get-attribute xml-data 'from))))
|
|
|
|
(setq jabber-buffer-connection jc)
|
|
|
|
(widget-insert (if (eq type 'register) "Register with " "Search ") jabber-submit-to "\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 register-account
|
|
(string= (jabber-xdata-formtype x) "jabber:iq:register"))
|
|
(list (cons "username" username))
|
|
nil))))
|
|
(if (not have-xdata)
|
|
(jabber-render-register-form query
|
|
(when register-account
|
|
username)))
|
|
|
|
(widget-create 'push-button :notify (if (eq type 'register)
|
|
#'jabber-submit-register
|
|
#'jabber-submit-search) "Submit")
|
|
(when (eq type 'register)
|
|
(widget-insert "\t")
|
|
(widget-create 'push-button :notify #'jabber-remove-register "Cancel registration"))
|
|
(widget-insert "\n")
|
|
(widget-setup)
|
|
(widget-minor-mode 1)))
|
|
|
|
(defun jabber-submit-register (&rest ignore)
|
|
"Submit registration input. See `jabber-process-register-or-search'."
|
|
|
|
(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"
|
|
|
|
(cond
|
|
((eq jabber-form-type 'register)
|
|
`(query ((xmlns . "jabber:iq:register"))
|
|
,@(jabber-parse-register-form)))
|
|
((eq jabber-form-type 'xdata)
|
|
`(query ((xmlns . "jabber:iq:register"))
|
|
,(jabber-parse-xdata-form)))
|
|
(t
|
|
(error "Unknown form type: %s" jabber-form-type)))
|
|
handler (if registerp 'success text)
|
|
handler (if registerp 'failure text)))
|
|
|
|
(message "Registration sent"))
|
|
|
|
(defun jabber-process-register-secondtime (jc xml-data closure-data)
|
|
"Receive registration success or failure.
|
|
CLOSURE-DATA is either 'success or 'error."
|
|
(cond
|
|
((eq closure-data 'success)
|
|
(message "Registration successful. You may now connect to the server."))
|
|
(t
|
|
(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'."
|
|
|
|
(if (or jabber-silent-mode (yes-or-no-p (concat "Are you sure that you want to cancel your registration to " jabber-submit-to "? ")))
|
|
(jabber-send-iq jabber-buffer-connection jabber-submit-to
|
|
"set"
|
|
'(query ((xmlns . "jabber:iq:register"))
|
|
(remove))
|
|
#'jabber-report-success "Unregistration"
|
|
#'jabber-report-success "Unregistration")))
|
|
|
|
(provide 'jabber-register)
|
|
|
|
;;; arch-tag: e6b349d6-b1ad-4d19-a412-74459dfae239
|