]>
Commit | Line | Data |
---|---|---|
1 | ;; jabber-register.el - registration according to JEP-0077 -*- lexical-binding: t; -*- | |
2 | ||
3 | ;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - mange@freemail.hu | |
4 | ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net | |
5 | ||
6 | ;; This file is a part of jabber.el. | |
7 | ||
8 | ;; This program is free software; you can redistribute it and/or modify | |
9 | ;; it under the terms of the GNU General Public License as published by | |
10 | ;; the Free Software Foundation; either version 2 of the License, or | |
11 | ;; (at your option) any later version. | |
12 | ||
13 | ;; This program is distributed in the hope that it will be useful, | |
14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | ;; GNU General Public License for more details. | |
17 | ||
18 | ;; You should have received a copy of the GNU General Public License | |
19 | ;; along with this program; if not, write to the Free Software | |
20 | ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
21 | ||
22 | (require 'jabber-iq) | |
23 | (require 'jabber-widget) | |
24 | ||
25 | (add-to-list 'jabber-jid-service-menu | |
26 | (cons "Register with service" 'jabber-get-register)) | |
27 | (defun jabber-get-register (jc to) | |
28 | "Send IQ get request in namespace \"jabber:iq:register\". | |
29 | ||
30 | JC is the Jabber connection." | |
31 | (interactive (list (jabber-read-account) | |
32 | (jabber-read-jid-completing "Register with: "))) | |
33 | (jabber-send-iq jc to | |
34 | "get" | |
35 | '(query ((xmlns . "jabber:iq:register"))) | |
36 | #'jabber-process-data #'jabber-process-register-or-search | |
37 | #'jabber-report-success "Registration")) | |
38 | ||
39 | (defun jabber-process-register-or-search (jc xml-data) | |
40 | "Display results from jabber:iq:{register,search} query as a form. | |
41 | ||
42 | JC is the Jabber connection. | |
43 | XML-DATA is the parsed tree data from the stream (stanzas) | |
44 | obtained from `xml-parse-region'." | |
45 | ||
46 | (let ((query (jabber-iq-query xml-data)) | |
47 | (have-xdata nil) | |
48 | (type (cond | |
49 | ((string= (jabber-iq-xmlns xml-data) "jabber:iq:register") | |
50 | 'register) | |
51 | ((string= (jabber-iq-xmlns xml-data) "jabber:iq:search") | |
52 | 'search) | |
53 | (t | |
54 | (error "Namespace %s not handled by jabber-process-register-or-search" (jabber-iq-xmlns xml-data))))) | |
55 | (register-account | |
56 | (plist-get (fsm-get-state-data jc) :registerp)) | |
57 | (username | |
58 | (plist-get (fsm-get-state-data jc) :username)) | |
59 | (server | |
60 | (plist-get (fsm-get-state-data jc) :server))) | |
61 | ||
62 | (cond | |
63 | ((eq type 'register) | |
64 | ;; If there is no `from' attribute, we are registering with the server | |
65 | (jabber-init-widget-buffer (or (jabber-xml-get-attribute xml-data 'from) | |
66 | server))) | |
67 | ||
68 | ((eq type 'search) | |
69 | ;; no such thing here | |
70 | (jabber-init-widget-buffer (jabber-xml-get-attribute xml-data 'from)))) | |
71 | ||
72 | (setq jabber-buffer-connection jc) | |
73 | ||
74 | (widget-insert (if (eq type 'register) "Register with " "Search ") jabber-submit-to "\n\n") | |
75 | ||
76 | (dolist (x (jabber-xml-get-children query 'x)) | |
77 | (when (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:data") | |
78 | (setq have-xdata t) | |
79 | ;; If the registration form obeys XEP-0068, we know | |
80 | ;; for sure how to put a default username in it. | |
81 | (jabber-render-xdata-form x | |
82 | (if (and register-account | |
83 | (string= (jabber-xdata-formtype x) "jabber:iq:register")) | |
84 | (list (cons "username" username)) | |
85 | nil)))) | |
86 | (if (not have-xdata) | |
87 | (jabber-render-register-form query | |
88 | (when register-account | |
89 | username))) | |
90 | ||
91 | (widget-create 'push-button :notify (if (eq type 'register) | |
92 | #'jabber-submit-register | |
93 | #'jabber-submit-search) "Submit") | |
94 | (when (eq type 'register) | |
95 | (widget-insert "\t") | |
96 | (widget-create 'push-button :notify #'jabber-remove-register "Cancel registration")) | |
97 | (widget-insert "\n") | |
98 | (widget-setup) | |
99 | (widget-minor-mode 1))) | |
100 | ||
101 | (defun jabber-submit-register (&rest ignore) | |
102 | "Submit registration input. See `jabber-process-register-or-search'." | |
103 | (let* ((registerp (plist-get (fsm-get-state-data jabber-buffer-connection) :registerp)) | |
104 | (handler (if registerp | |
105 | #'jabber-process-register-secondtime | |
106 | #'jabber-report-success)) | |
107 | (text (concat "Registration with " jabber-submit-to))) | |
108 | (jabber-send-iq jabber-buffer-connection jabber-submit-to | |
109 | "set" | |
110 | ||
111 | (cond | |
112 | ((eq jabber-form-type 'register) | |
113 | `(query ((xmlns . "jabber:iq:register")) | |
114 | ,@(jabber-parse-register-form))) | |
115 | ((eq jabber-form-type 'xdata) | |
116 | `(query ((xmlns . "jabber:iq:register")) | |
117 | ,(jabber-parse-xdata-form))) | |
118 | (t | |
119 | (error "Unknown form type: %s" jabber-form-type))) | |
120 | handler (if registerp 'success text) | |
121 | handler (if registerp 'failure text))) | |
122 | ||
123 | (message "Registration sent")) | |
124 | ||
125 | (defun jabber-process-register-secondtime (jc xml-data closure-data) | |
126 | "Receive registration success or failure. | |
127 | CLOSURE-DATA is either 'success or 'error. | |
128 | ||
129 | JC is the Jabber connection. | |
130 | XML-DATA is the parsed tree data from the stream (stanzas) | |
131 | obtained from `xml-parse-region'." | |
132 | (cond | |
133 | ((eq closure-data 'success) | |
134 | (message "Registration successful. You may now connect to the server.")) | |
135 | (t | |
136 | (jabber-report-success jc xml-data "Account registration"))) | |
137 | (sit-for 3) | |
138 | (jabber-disconnect-one jc)) | |
139 | ||
140 | (defun jabber-remove-register (&rest ignore) | |
141 | "Cancel registration. See `jabber-process-register-or-search'." | |
142 | ||
143 | (if (or jabber-silent-mode (yes-or-no-p (concat "Are you sure that you want to cancel your registration to " jabber-submit-to "? "))) | |
144 | (jabber-send-iq jabber-buffer-connection jabber-submit-to | |
145 | "set" | |
146 | '(query ((xmlns . "jabber:iq:register")) | |
147 | (remove)) | |
148 | #'jabber-report-success "Unregistration" | |
149 | #'jabber-report-success "Unregistration"))) | |
150 | ||
151 | (provide 'jabber-register) | |
152 | ||
153 | ;;; arch-tag: e6b349d6-b1ad-4d19-a412-74459dfae239 |