diff options
Diffstat (limited to 'jabber-iq.el')
| -rw-r--r-- | jabber-iq.el | 213 |
1 files changed, 213 insertions, 0 deletions
diff --git a/jabber-iq.el b/jabber-iq.el new file mode 100644 index 0000000..a4a4121 --- /dev/null +++ b/jabber-iq.el @@ -0,0 +1,213 @@ +;; jabber-iq.el - infoquery functions + +;; Copyright (C) 2003, 2004, 2007, 2008 - 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-core) +(require 'jabber-util) +(require 'jabber-keymap) + +(defvar *jabber-open-info-queries* nil + "an alist of open query id and their callback functions") + +(defvar jabber-iq-get-xmlns-alist nil + "Mapping from XML namespace to handler for IQ GET requests.") + +(defvar jabber-iq-set-xmlns-alist nil + "Mapping from XML namespace to handler for IQ SET requests.") + +(defvar jabber-browse-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map jabber-common-keymap) + (define-key map [mouse-2] 'jabber-popup-combined-menu) + map)) + +(defcustom jabber-browse-mode-hook nil + "Hook run when entering Browse mode." + :group 'jabber + :type 'hook) + +(defgroup jabber-browse nil "browse display options" + :group 'jabber) + +(defcustom jabber-browse-buffer-format "*-jabber-browse:-%n-*" + "The format specification for the name of browse buffers. + +These fields are available at this moment: + +%n JID to browse" + :type 'string + :group 'jabber-browse) + +(defun jabber-browse-mode () +"\\{jabber-browse-mode-map}" + (kill-all-local-variables) + (setq major-mode 'jabber-browse-mode + mode-name "jabber-browse") + (use-local-map jabber-browse-mode-map) + (setq buffer-read-only t) + (if (fboundp 'run-mode-hooks) + (run-mode-hooks 'jabber-browse-mode-hook) + (run-hooks 'jabber-browse-mode-hook))) + +(put 'jabber-browse-mode 'mode-class 'special) + +(add-to-list 'jabber-iq-chain 'jabber-process-iq) +(defun jabber-process-iq (jc xml-data) + "process an incoming iq stanza" + (let* ((id (jabber-xml-get-attribute xml-data 'id)) + (type (jabber-xml-get-attribute xml-data 'type)) + (from (jabber-xml-get-attribute xml-data 'from)) + (query (jabber-iq-query xml-data)) + (callback (assoc id *jabber-open-info-queries*))) + (cond + ;; if type is "result" or "error", this is a response to a query we sent. + ((or (string= type "result") + (string= type "error")) + (let ((callback-cons (nth (cdr (assoc type '(("result" . 0) + ("error" . 1)))) (cdr callback)))) + (if (consp callback-cons) + (funcall (car callback-cons) jc xml-data (cdr callback-cons)))) + (setq *jabber-open-info-queries* (delq callback *jabber-open-info-queries*))) + + ;; if type is "get" or "set", correct action depends on namespace of request. + ((and (listp query) + (or (string= type "get") + (string= type "set"))) + (let* ((which-alist (eval (cdr (assoc type + (list + (cons "get" 'jabber-iq-get-xmlns-alist) + (cons "set" 'jabber-iq-set-xmlns-alist)))))) + (handler (cdr (assoc (jabber-xml-get-attribute query 'xmlns) which-alist)))) + (if handler + (condition-case error-var + (funcall handler jc xml-data) + (jabber-error + (apply 'jabber-send-iq-error jc from id query (cdr error-var))) + (error (jabber-send-iq-error jc from id query "wait" 'internal-server-error (error-message-string error-var)))) + (jabber-send-iq-error jc from id query "cancel" 'feature-not-implemented))))))) + +(defun jabber-send-iq (jc to type query success-callback success-closure-data + error-callback error-closure-data &optional result-id) + "Send an iq stanza to the specified entity, and optionally set up a callback. +JC is the Jabber connection. +TO is the addressee. +TYPE is one of \"get\", \"set\", \"result\" or \"error\". +QUERY is a list containing the child of the iq node in the format `jabber-sexp2xml' +accepts. +SUCCESS-CALLBACK is the function to be called when a successful result arrives. +SUCCESS-CLOSURE-DATA is an extra argument to SUCCESS-CALLBACK. +ERROR-CALLBACK is the function to be called when an error arrives. +ERROR-CLOSURE-DATA is an extra argument to ERROR-CALLBACK. +RESULT-ID is the id to be used for a response to a received iq message. +`jabber-report-success' and `jabber-process-data' are common callbacks. + +The callback functions are called like this: +\(funcall CALLBACK JC XML-DATA CLOSURE-DATA) +with XML-DATA being the IQ stanza received in response. " + (let ((id (or result-id (apply 'format "emacs-iq-%d.%d.%d" (current-time))))) + (if (or success-callback error-callback) + (setq *jabber-open-info-queries* (cons (list id + (cons success-callback success-closure-data) + (cons error-callback error-closure-data)) + + *jabber-open-info-queries*))) + (jabber-send-sexp jc + (list 'iq (append + (if to (list (cons 'to to))) + (list (cons 'type type)) + (list (cons 'id id))) + query)))) + +(defun jabber-send-iq-error (jc to id original-query error-type condition + &optional text app-specific) + "Send an error iq stanza to the specified entity in response to a +previously sent iq stanza. +TO is the addressee. +ID is the id of the iq stanza that caused the error. +ORIGINAL-QUERY is the original query, which should be included in the +error, or nil. +ERROR-TYPE is one of \"cancel\", \"continue\", \"modify\", \"auth\" +and \"wait\". +CONDITION is a symbol denoting a defined XMPP condition. +TEXT is a string to be sent in the error message, or nil for no text. +APP-SPECIFIC is a list of extra XML tags. + +See section 9.3 of XMPP Core." + (jabber-send-sexp + jc + `(iq (,@(when to `((to . ,to))) + (type . "error") + (id . ,(or id ""))) + ,original-query + (error ((type . ,error-type)) + (,condition ((xmlns . "urn:ietf:params:xml:ns:xmpp-stanzas"))) + ,(if text + `(text ((xmlns . "urn:ietf:params:xml:ns:xmpp-stanzas")) + ,text)) + ,@app-specific)))) + +(defun jabber-process-data (jc xml-data closure-data) + "Process random results from various requests." + (let ((from (or (jabber-xml-get-attribute xml-data 'from) (plist-get (fsm-get-state-data jc) :server))) + (xmlns (jabber-iq-xmlns xml-data)) + (type (jabber-xml-get-attribute xml-data 'type))) + (with-current-buffer (get-buffer-create (format-spec jabber-browse-buffer-format + (list (cons ?n from)))) + (if (not (eq major-mode 'jabber-browse-mode)) + (jabber-browse-mode)) + + (setq buffer-read-only nil) + (goto-char (point-max)) + + (insert (jabber-propertize from + 'face 'jabber-title-large) "\n\n") + + ;; Put point at beginning of data + (save-excursion + ;; If closure-data is a function, call it. If it is a string, + ;; output it along with a description of the error. For other + ;; values (e.g. nil), just dump the XML. + (cond + ((functionp closure-data) + (funcall closure-data jc xml-data)) + ((stringp closure-data) + (insert closure-data ": " (jabber-parse-error (jabber-iq-error xml-data)) "\n\n")) + (t + (insert (format "%S\n\n" xml-data)))) + + (dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks)) + (run-hook-with-args hook 'browse (current-buffer) (funcall jabber-alert-info-message-function 'browse (current-buffer)))))))) + +(defun jabber-silent-process-data (jc xml-data closure-data) + "Process random results from various requests to only alert hooks." + (let ((text (cond + ((functionp closure-data) + (funcall closure-data jc xml-data)) + ((stringp closure-data) + (concat closure-data ": " (jabber-parse-error (jabber-iq-error xml-data)))) + (t + (format "%S" xml-data))))) + (dolist (hook '(jabber-info-message-hooks jabber-alert-info-message-hooks)) + (run-hook-with-args hook 'browse (current-buffer) + text)))) + +(provide 'jabber-iq) + +;;; arch-tag: 5585dfa3-b59a-42ee-9292-803652c85e26 |