jabber-iq.el

   1 ;; jabber-iq.el - infoquery functions
   2
   3 ;; Copyright (C) 2003, 2004, 2007, 2008 - 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-core)
  23 (require 'jabber-util)
  24 (require 'jabber-keymap)
  25
  26 (defvar *jabber-open-info-queries* nil
  27   "an alist of open query id and their callback functions")
  28
  29 (defvar jabber-iq-get-xmlns-alist nil
  30   "Mapping from XML namespace to handler for IQ GET requests.")
  31
  32 (defvar jabber-iq-set-xmlns-alist nil
  33   "Mapping from XML namespace to handler for IQ SET requests.")
  34
  35 (defvar jabber-browse-mode-map
  36   (let ((map (make-sparse-keymap)))
  37     (set-keymap-parent map jabber-common-keymap)
  38     (define-key map [mouse-2] 'jabber-popup-combined-menu)
  39     map))
  40
  41 (defcustom jabber-browse-mode-hook nil
  42   "Hook run when entering Browse mode."
  43   :group 'jabber
  44   :type 'hook)
  45
  46 (defgroup jabber-browse nil "browse display options"
  47   :group 'jabber)
  48
  49 (defcustom jabber-browse-buffer-format "*-jabber-browse:-%n-*"
  50   "The format specification for the name of browse buffers.
  51
  52 These fields are available at this moment:
  53
  54 %n   JID to browse"
  55   :type 'string
  56   :group 'jabber-browse)
  57
  58 (defun jabber-browse-mode ()
  59 "\\{jabber-browse-mode-map}"
  60   (kill-all-local-variables)
  61   (setq major-mode 'jabber-browse-mode
  62         mode-name "jabber-browse")
  63   (use-local-map jabber-browse-mode-map)
  64   (setq buffer-read-only t)
  65   (if (fboundp 'run-mode-hooks)
  66       (run-mode-hooks 'jabber-browse-mode-hook)
  67     (run-hooks 'jabber-browse-mode-hook)))
  68
  69 (put 'jabber-browse-mode 'mode-class 'special)
  70
  71 (add-to-list 'jabber-iq-chain 'jabber-process-iq)
  72 (defun jabber-process-iq (jc xml-data)
  73   "process an incoming iq stanza"
  74   (let* ((id (jabber-xml-get-attribute xml-data 'id))
  75          (type (jabber-xml-get-attribute xml-data 'type))
  76          (from (jabber-xml-get-attribute xml-data 'from))
  77          (query (jabber-iq-query xml-data))
  78          (callback (assoc id *jabber-open-info-queries*)))
  79     (cond
  80      ;; if type is "result" or "error", this is a response to a query we sent.
  81      ((or (string= type "result")
  82           (string= type "error"))
  83       (let ((callback-cons (nth (cdr (assoc type '(("result" . 0)
  84                                                    ("error" . 1)))) (cdr callback))))
  85         (if (consp callback-cons)
  86             (funcall (car callback-cons) jc xml-data (cdr callback-cons))))
  87       (setq *jabber-open-info-queries* (delq callback *jabber-open-info-queries*)))
  88
  89      ;; if type is "get" or "set", correct action depends on namespace of request.
  90      ((and (listp query)
  91            (or (string= type "get")
  92                (string= type "set")))
  93       (let* ((which-alist (eval (cdr (assoc type
  94                                             (list
  95                                              (cons "get" 'jabber-iq-get-xmlns-alist)
  96                                              (cons "set" 'jabber-iq-set-xmlns-alist))))))
  97              (handler (cdr (assoc (jabber-xml-get-attribute query 'xmlns) which-alist))))
  98         (if handler
  99             (condition-case error-var
 100                 (funcall handler jc xml-data)
 101               (jabber-error
 102                (apply 'jabber-send-iq-error jc from id query (cdr error-var)))
 103               (error (jabber-send-iq-error jc from id query "wait" 'internal-server-error (error-message-string error-var))))
 104           (jabber-send-iq-error jc from id query "cancel" 'feature-not-implemented)))))))
 105
 106 (defun jabber-send-iq (jc to type query success-callback success-closure-data
 107                           error-callback error-closure-data &optional result-id)
 108   "Send an iq stanza to the specified entity, and optionally set up a callback.
 109 JC is the Jabber connection.
 110 TO is the addressee.
 111 TYPE is one of \"get\", \"set\", \"result\" or \"error\".
 112 QUERY is a list containing the child of the iq node in the format `jabber-sexp2xml'
 113 accepts.
 114 SUCCESS-CALLBACK is the function to be called when a successful result arrives.
 115 SUCCESS-CLOSURE-DATA is an extra argument to SUCCESS-CALLBACK.
 116 ERROR-CALLBACK is the function to be called when an error arrives.
 117 ERROR-CLOSURE-DATA is an extra argument to ERROR-CALLBACK.
 118 RESULT-ID is the id to be used for a response to a received iq message.
 119 `jabber-report-success' and `jabber-process-data' are common callbacks.
 120
 121 The callback functions are called like this:
 122 \(funcall CALLBACK JC XML-DATA CLOSURE-DATA)
 123 with XML-DATA being the IQ stanza received in response. "
 124   (let ((id (or result-id (apply 'format "emacs-iq-%d.%d.%d" (current-time)))))
 125     (if (or success-callback error-callback)
 126         (setq *jabber-open-info-queries* (cons (list id
 127                                                      (cons success-callback success-closure-data)
 128                                                      (cons error-callback error-closure-data))
 129
 130                                                *jabber-open-info-queries*)))
 131     (jabber-send-sexp jc
 132                       (list 'iq (append
 133                                  (if to (list (cons 'to to)))
 134                                  (list (cons 'type type))
 135                                  (list (cons 'id id)))
 136                             query))))
 137
 138 (defun jabber-send-iq-error (jc to id original-query error-type condition
 139                                 &optional text app-specific)
 140   "Send an error iq stanza to the specified entity in response to a
 141 previously sent iq stanza.
 142 TO is the addressee.
 143 ID is the id of the iq stanza that caused the error.
 144 ORIGINAL-QUERY is the original query, which should be included in the
 145 error, or nil.
 146 ERROR-TYPE is one of \"cancel\", \"continue\", \"modify\", \"auth\"
 147 and \"wait\".
 148 CONDITION is a symbol denoting a defined XMPP condition.
 149 TEXT is a string to be sent in the error message, or nil for no text.
 150 APP-SPECIFIC is a list of extra XML tags.
 151
 152 See section 9.3 of XMPP Core."
 153   (jabber-send-sexp
 154    jc
 155    `(iq ((to . ,to)
 156          (type . "error")
 157          (id . ,id))
 158         ,original-query
 159         (error ((type . ,error-type))
 160                (,condition ((xmlns . "urn:ietf:params:xml:ns:xmpp-stanzas")))
 161                ,(if text
 162                     `(text ((xmlns . "urn:ietf:params:xml:ns:xmpp-stanzas"))
 163                            ,text))
 164                ,@app-specific))))
 165
 166 (defun jabber-process-data (jc xml-data closure-data)
 167   "Process random results from various requests."
 168   (let ((from (or (jabber-xml-get-attribute xml-data 'from) (plist-get (fsm-get-state-data jc) :server)))
 169         (xmlns (jabber-iq-xmlns xml-data))
 170         (type (jabber-xml-get-attribute xml-data 'type)))
 171     (with-current-buffer (get-buffer-create (format-spec jabber-browse-buffer-format
 172                                                          (list (cons ?n from))))
 173       (if (not (eq major-mode 'jabber-browse-mode))
 174           (jabber-browse-mode))
 175
 176       (setq buffer-read-only nil)
 177       (goto-char (point-max))
 178
 179       (insert (jabber-propertize from
 180                           'face 'jabber-title-large) "\n\n")
 181
 182       ;; Put point at beginning of data
 183       (save-excursion
 184         ;; If closure-data is a function, call it.  If it is a string,
 185         ;; output it along with a description of the error.  For other
 186         ;; values (e.g. nil), just dump the XML.
 187         (cond
 188          ((functionp closure-data)
 189           (funcall closure-data jc xml-data))
 190          ((stringp closure-data)
 191           (insert closure-data ": " (jabber-parse-error (jabber-iq-error xml-data)) "\n\n"))
 192          (t
 193           (insert (format "%S\n\n" xml-data))))
 194
 195         (dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks))
 196           (run-hook-with-args hook 'browse (current-buffer) (funcall jabber-alert-info-message-function 'browse (current-buffer))))))))
 197
 198 (provide 'jabber-iq)
 199
 200 ;;; arch-tag: 5585dfa3-b59a-42ee-9292-803652c85e26