djavu-asus/elpa/jabber-20230715.456/jabber-register.el

   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