1 ;; jabber-disco.el - service discovery functions
3 ;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - mange@freemail.hu
4 ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
6 ;; This file is a part of jabber.el.
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.
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.
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
23 ;;; All the client part should be seriously rewritten, or at least
24 ;;; reconsidered. I'm imagining a separation between backend and
25 ;;; frontend, so that various functions can perform disco queries for
26 ;;; their own purposes, and maybe some caching with that.
30 (require 'jabber-menu
)
32 ;; Advertise your features here. Add the namespace to this list.
33 (defvar jabber-advertised-features
34 (list "http://jabber.org/protocol/disco#info")
35 "Features advertised on service discovery requests")
37 (defvar jabber-disco-items-nodes
40 "Alist of node names and information about returning disco item data.
41 Key is node name as a string, or \"\" for no node specified. Value is
44 First item is data to return. If it is a function, that function is
45 called and its return value is used; if it is a list, that list is
46 used. The list should be the XML data to be returned inside the
47 <query/> element, like this:
49 \((item ((name . \"Name of first item\")
50 (jid . \"first.item\")
53 Second item is access control function. That function is passed the
54 JID, and returns non-nil if access is granted. If the second item is
55 nil, access is always granted.")
57 (defvar jabber-disco-info-nodes
59 (list "" #'jabber-disco-return-client-info nil
))
60 "Alist of node names and information returning disco info data.
61 Key is node name as a string, or \"\" for no node specified. Value is
64 First item is data to return. If it is a function, that function is
65 called and its return value is used; if it is a list, that list is
66 used. The list should be the XML data to be returned inside the
67 <query/> element, like this:
69 \((identity ((category . \"client\")
71 (name . \"Jabber client\")))
72 (feature ((var . \"some-feature\"))))
74 Second item is access control function. That function is passed the
75 JID, and returns non-nil if access is granted. If the second item is
76 nil, access is always granted.")
78 (defun jabber-process-disco-info (jc xml-data
)
79 "Handle results from info disco requests."
81 (let ((beginning (point)))
82 (dolist (x (jabber-xml-node-children (jabber-iq-query xml-data
)))
84 ((eq (jabber-xml-node-name x
) 'identity
)
85 (let ((name (jabber-xml-get-attribute x
'name
))
86 (category (jabber-xml-get-attribute x
'category
))
87 (type (jabber-xml-get-attribute x
'type
)))
88 (insert (jabber-propertize (if name
91 'face
'jabber-title-medium
)
92 "\n\nCategory:\t" category
"\n")
94 (insert "Type:\t\t" type
"\n"))
96 ((eq (jabber-xml-node-name x
) 'feature
)
97 (let ((var (jabber-xml-get-attribute x
'var
)))
98 (insert "Feature:\t" var
"\n")))))
99 (put-text-property beginning
(point)
100 'jabber-jid
(jabber-xml-get-attribute xml-data
'from
))
101 (put-text-property beginning
(point)
102 'jabber-account jc
)))
104 (defun jabber-process-disco-items (jc xml-data
)
105 "Handle results from items disco requests."
107 (let ((items (jabber-xml-get-children (jabber-iq-query xml-data
) 'item
)))
110 (let ((jid (jabber-xml-get-attribute item
'jid
))
111 (name (jabber-xml-get-attribute item
'name
))
112 (node (jabber-xml-get-attribute item
'node
)))
117 (concat jid
"\n" (if node
(format "Node: %s\n" node
)))
118 'face
'jabber-title-medium
)
122 'jabber-node node
))))
123 (insert "No items found.\n"))))
125 (add-to-list 'jabber-iq-get-xmlns-alist
126 (cons "http://jabber.org/protocol/disco#info" 'jabber-return-disco-info
))
127 (add-to-list 'jabber-iq-get-xmlns-alist
128 (cons "http://jabber.org/protocol/disco#items" 'jabber-return-disco-info
))
129 (defun jabber-return-disco-info (jc xml-data
)
130 "Respond to a service discovery request.
132 (let* ((to (jabber-xml-get-attribute xml-data
'from
))
133 (id (jabber-xml-get-attribute xml-data
'id
))
134 (xmlns (jabber-iq-xmlns xml-data
))
135 (which-alist (eval (cdr (assoc xmlns
137 (cons "http://jabber.org/protocol/disco#info" 'jabber-disco-info-nodes
)
138 (cons "http://jabber.org/protocol/disco#items" 'jabber-disco-items-nodes
))))))
140 (jabber-xml-get-attribute (jabber-iq-query xml-data
) 'node
)
142 (return-list (cdr (assoc node which-alist
)))
143 (func (nth 0 return-list
))
144 (access-control (nth 1 return-list
)))
146 (if (and (functionp access-control
)
147 (not (funcall access-control to
)))
148 (jabber-signal-error "cancel" 'not-allowed
)
149 ;; Access control passed
150 (let ((result (if (functionp func
)
151 (funcall func jc xml-data
)
153 (jabber-send-iq jc to
"result"
154 `(query ((xmlns .
,xmlns
)
156 (list (cons 'node node
))))
158 nil nil nil nil id
)))
161 (jabber-signal-error "cancel" 'item-not-found
))))
163 (defun jabber-disco-return-client-info (jc xml-data
)
165 ;; If running under a window system, this is
166 ;; a GUI client. If not, it is a console client.
167 (identity ((category .
"client")
168 (name .
"Emacs Jabber client")
169 (type .
,(if (memq window-system
174 #'(lambda (featurename)
175 `(feature ((var .
,featurename
))))
176 jabber-advertised-features
)))
178 (add-to-list 'jabber-jid-info-menu
179 (cons "Send items disco query" 'jabber-get-disco-items
))
180 (defun jabber-get-disco-items (jc to
&optional node
)
181 "Send a service discovery request for items"
182 (interactive (list (jabber-read-account)
183 (jabber-read-jid-completing "Send items disco request to: ")
184 (jabber-read-node "Node (or leave empty): ")))
185 (jabber-send-iq jc to
187 (list 'query
(append (list (cons 'xmlns
"http://jabber.org/protocol/disco#items"))
188 (if (> (length node
) 0)
189 (list (cons 'node node
)))))
190 #'jabber-process-data
#'jabber-process-disco-items
191 #'jabber-process-data
"Item discovery failed"))
193 (add-to-list 'jabber-jid-info-menu
194 (cons "Send info disco query" 'jabber-get-disco-info
))
195 (defun jabber-get-disco-info (jc to
&optional node
)
196 "Send a service discovery request for info"
197 (interactive (list (jabber-read-account)
198 (jabber-read-jid-completing "Send info disco request to: ")
199 (jabber-read-node "Node (or leave empty): ")))
200 (jabber-send-iq jc to
202 (list 'query
(append (list (cons 'xmlns
"http://jabber.org/protocol/disco#info"))
203 (if (> (length node
) 0)
204 (list (cons 'node node
)))))
205 #'jabber-process-data
#'jabber-process-disco-info
206 #'jabber-process-data
"Info discovery failed"))
208 (provide 'jabber-disco
)
210 ;;; arch-tag: 71f5c76f-2956-4ed2-b871-9f5fe198092d