Commit | Line | Data |
---|---|---|
2e8cf9a7 MA |
1 | ;;; zeroconf.el --- Service browser using Avahi. |
2 | ||
73b0cd50 | 3 | ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. |
2e8cf9a7 MA |
4 | |
5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | |
6 | ;; Keywords: comm, hardware | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
874a927a | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
2e8cf9a7 | 11 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
2e8cf9a7 MA |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
874a927a | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
2e8cf9a7 MA |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; This package provides an interface to the Avahi, the zeroconf | |
26 | ;; daemon under GNU/Linux. The communication mean with Avahi is | |
27 | ;; D-Bus. | |
28 | ||
29 | ;; In order to activate this package, you must add the following code | |
30 | ;; into your .emacs: | |
31 | ||
32 | ;; (require 'zeroconf) | |
33 | ;; (zeroconf-init "dns-sd.org") | |
34 | ||
35 | ;; "dns-sd.org" is an example the domain you wish to resolve services | |
36 | ;; for. It can also be nil or "", which means the default local | |
37 | ;; domain "local". | |
38 | ||
39 | ;; The `zeroconf-init' function installs several handlers, which are | |
40 | ;; activated by D-Bus signals sent from the Avahi daemon. | |
41 | ;; Immediately, when a service is added or removed in the domain, a | |
42 | ;; corresponding handler in Emacs is called. | |
43 | ||
44 | ;; Service Discovery | |
45 | ;; ----------------- | |
46 | ||
47 | ;; The main purpose of zeroconf is service discovery. This means, | |
48 | ;; that services are detected as soon as they appear or disappear in a | |
49 | ;; given domain. A service is offered by a network device. It is | |
50 | ;; assigned to a service type. | |
51 | ||
52 | ;; In order to see all offered service types of the initialized | |
53 | ;; domain, you can call | |
54 | ||
55 | ;; (zeroconf-list-service-types) | |
56 | ||
57 | ;; Service types are described at <http://www.dns-sd.org/ServiceTypes.html>. | |
58 | ;; Detected services for a given service type, let's say "_ipp._tcp", | |
59 | ;; are listed by | |
60 | ||
61 | ;; (zeroconf-list-services "_ipp._tcp") | |
62 | ||
63 | ;; It is possible to register an own handler (function) to be called | |
64 | ;; when a service has been added or removed in the domain. The | |
65 | ;; service type "_ipp._tcp" is used for printer services supporting | |
66 | ;; the Internet Printing Protocol. | |
67 | ||
68 | ;; (defun my-add-printer (service) | |
69 | ;; (message "Printer `%s' detected" (zeroconf-service-name service))) | |
70 | ||
71 | ;; (defun my-remove-printer (service) | |
72 | ;; (message "Printer `%s' removed" (zeroconf-service-name service))) | |
73 | ||
74 | ;; (zeroconf-service-add-hook "_ipp._tcp" :new 'my-add-printer) | |
75 | ;; (zeroconf-service-add-hook "_ipp._tcp" :removed 'my-remove-printer) | |
76 | ||
77 | ;; There are several functions returning information about a service, | |
78 | ;; see the doc string of `zeroconf-service-add-hook'. | |
79 | ||
80 | ;; Service Publishing | |
81 | ;; ------------------ | |
82 | ||
83 | ;; The function `zeroconf-publish-service' publishes a new service to | |
84 | ;; the Avahi daemon. Although the domain, where to the service is | |
85 | ;; published, can be specified by this function, it is usally the | |
86 | ;; default domain "local" (also written as nil or ""). | |
87 | ||
88 | ;; (zeroconf-publish-service | |
89 | ;; "Example service" ;; Service name. | |
90 | ;; "_example._tcp" ;; Service type. | |
91 | ;; nil ;; Default domain ("local"). | |
92 | ;; nil ;; Default host (concat (getenv "HOST") ".local"). | |
93 | ;; 111 ;; Port number of the host, the service is offered. | |
94 | ;; "1.2.3.4" ;; IPv4 address of the host. | |
95 | ;; '("version=1.0" ;; TXT fields describing the service. | |
96 | ;; "abc=456")) | |
97 | ||
98 | ;; The lifetime of a published service is the lifetime of Emacs. | |
99 | ||
100 | ;;; Code: | |
101 | ||
102 | ;; Pacify byte-compiler. D-Bus support in the Emacs core can be | |
103 | ;; disabled with configuration option "--without-dbus". Declare used | |
104 | ;; subroutines and variables of `dbus' therefore. | |
105 | (eval-when-compile | |
95eafb14 DN |
106 | (require 'cl)) |
107 | ||
108 | (declare-function dbus-call-method "dbusbind.c") | |
109 | (declare-function dbus-register-signal "dbusbind.c") | |
110 | (defvar dbus-debug) | |
2e8cf9a7 MA |
111 | |
112 | (require 'dbus) | |
113 | ||
114 | (defvar zeroconf-debug nil | |
115 | "Write messages during service discovery") | |
116 | ||
117 | (defconst zeroconf-service-avahi "org.freedesktop.Avahi" | |
118 | "The D-Bus name used to talk to Avahi.") | |
119 | ||
120 | (defconst zeroconf-path-avahi "/" | |
121 | "The D-Bus root object path used to talk to Avahi.") | |
122 | ||
123 | (defvar zeroconf-path-avahi-service-type-browser nil | |
124 | "The D-Bus object path used to talk to the Avahi service type browser.") | |
125 | ||
126 | (defvar zeroconf-path-avahi-service-browser-hash (make-hash-table :test 'equal) | |
127 | "The D-Bus object paths used to talk to the Avahi service browser.") | |
128 | ||
129 | (defvar zeroconf-path-avahi-service-resolver-hash (make-hash-table :test 'equal) | |
130 | "The D-Bus object paths used to talk to the Avahi service resolver.") | |
131 | ||
132 | ;; Methods: "Free", "Commit", "Reset", "GetState", "IsEmpty", | |
133 | ;; "AddService", "AddServiceSubtype", "UpdateServiceTxt", "AddAddress" | |
134 | ;; and "AddRecord". | |
135 | ;; Signals: "StateChanged". | |
136 | (defconst zeroconf-interface-avahi-entry-group | |
137 | (concat zeroconf-service-avahi ".EntryGroup") | |
138 | "The D-Bus entry group interface exported by Avahi.") | |
139 | ||
140 | ;; Methods: "GetVersionString", "GetAPIVersion", "GetHostName", | |
141 | ;; "SetHostName", "GetHostNameFqdn", "GetDomainName", | |
142 | ;; "IsNSSSupportAvailable", "GetState", "GetLocalServiceCookie", | |
143 | ;; "GetAlternativeHostName", "GetAlternativeServiceName", | |
144 | ;; "GetNetworkInterfaceNameByIndex", "GetNetworkInterfaceIndexByName", | |
145 | ;; "ResolveHostName", "ResolveAddress", "ResolveService", | |
146 | ;; "EntryGroupNew", "DomainBrowserNew", "ServiceTypeBrowserNew", | |
147 | ;; "ServiceBrowserNew", "ServiceResolverNew", "HostNameResolverNew", | |
148 | ;; "AddressResolverNew" and "RecordBrowserNew". | |
149 | ;; Signals: "StateChanged". | |
150 | (defconst zeroconf-interface-avahi-server | |
151 | (concat zeroconf-service-avahi ".Server") | |
152 | "The D-Bus server interface exported by Avahi.") | |
153 | ||
154 | ;; Methods: "Free". | |
155 | ;; Signals: "ItemNew", "ItemRemove", "CacheExhausted", "AllForNow" and | |
156 | ;; "Failure". | |
157 | (defconst zeroconf-interface-avahi-service-type-browser | |
158 | (concat zeroconf-service-avahi ".ServiceTypeBrowser") | |
159 | "The D-Bus service type browser interface exported by Avahi.") | |
160 | ||
161 | ;; Methods: "Free". | |
162 | ;; Signals: "ItemNew", "ItemRemove", "CacheExhausted", "AllForNow" and | |
163 | ;; "Failure". | |
164 | (defconst zeroconf-interface-avahi-service-browser | |
165 | (concat zeroconf-service-avahi ".ServiceBrowser") | |
166 | "The D-Bus service browser interface exported by Avahi.") | |
167 | ||
168 | ;; Methods: "Free". | |
169 | ;; Available signals are "Found" and "Failure". | |
170 | (defconst zeroconf-interface-avahi-service-resolver | |
171 | (concat zeroconf-service-avahi ".ServiceResolver") | |
172 | "The D-Bus service resolver interface exported by Avahi.") | |
173 | ||
174 | (defconst zeroconf-avahi-interface-unspec -1 | |
175 | "Wildcard Avahi interface spec.") | |
176 | ||
177 | (defconst zeroconf-avahi-protocol-unspec -1 | |
178 | "Wildcard Avahi protocol spec.") | |
179 | ||
180 | (defconst zeroconf-avahi-protocol-inet4 0 | |
181 | "Avahi INET4 address protocol family.") | |
182 | ||
183 | (defconst zeroconf-avahi-protocol-inet6 1 | |
184 | "Avahi INET6 address protocol family.") | |
185 | ||
186 | (defconst zeroconf-avahi-domain-unspec "" | |
187 | "Empty Avahi domain.") | |
188 | ||
189 | (defvar zeroconf-avahi-current-domain zeroconf-avahi-domain-unspec | |
190 | "Domain name services are resolved for.") | |
191 | ||
192 | (defconst zeroconf-avahi-flags-unspec 0 | |
193 | "No Avahi flags.") | |
194 | ||
195 | \f | |
196 | ;;; Services retrieval. | |
197 | ||
198 | (defvar zeroconf-services-hash (make-hash-table :test 'equal) | |
199 | "Hash table of discovered Avahi services. | |
200 | ||
201 | The key of an entry is the concatenation of the service name and | |
202 | service type of a discovered service. The value is the service | |
203 | itself. The format of a service is | |
204 | ||
205 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\) | |
206 | ||
207 | The INTERFACE is a number, which represents the network interface | |
208 | the service is located at. The corresponding network interface | |
209 | name, like \"eth0\", can be retrieved with the function | |
210 | `zeroconf-get-interface-name'. | |
211 | ||
212 | PROTOCOL describes the used network protocol family the service | |
213 | can be accessed. `zeroconf-avahi-protocol-inet4' means INET4, | |
214 | `zeroconf-avahi-protocol-inet6' means INET6. An unspecified | |
215 | protocol family is coded with `zeroconf-avahi-protocol-unspec'. | |
216 | ||
217 | NAME is the string the service is known at Avahi. A service can | |
218 | be known under the same name for different service types. | |
219 | ||
220 | Each TYPE stands for a discovered service type of Avahi. The | |
221 | format is described in RFC 2782. It is of the form | |
222 | ||
223 | \"_APPLICATION-PROTOCOL._TRANSPORT-PROTOCOL\". | |
224 | ||
225 | TRANSPORT-PROTOCOL must be either \"tcp\" or \"udp\". | |
226 | APPLICATION-PROTOCOL must be a protocol name as specified in URL | |
227 | `http://www.dns-sd.org/ServiceTypes.html'. Typical service types | |
228 | are \"_workstation._tcp\" or \"_printer._tcp\". | |
229 | ||
230 | DOMAIN is the domain name the service is registered in, like \"local\". | |
231 | ||
232 | FLAGS, an integer, is used inside Avahi. When publishing a | |
233 | service (see `zeroconf-publish-service', the flag 0 is used.") | |
234 | ||
235 | (defvar zeroconf-resolved-services-hash (make-hash-table :test 'equal) | |
236 | "Hash table of resolved Avahi services. | |
237 | The key of an entry is the concatenation of the service name and | |
238 | service type of a resolved service. The value is the service | |
239 | itself. The format of a service is | |
240 | ||
241 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\) | |
242 | ||
243 | INTERFACE, PROTOCOL, NAME, TYPE, DOMAIN and FLAGS have the same | |
244 | meaning as in `zeroconf-services-hash'. | |
245 | ||
246 | HOST is the host name the service is registered. It is a fully | |
247 | qualified name, i.e., it contains DOMAIN. | |
248 | ||
249 | APROTOCOL stands for the network protocol family ADDRESS is | |
250 | encoded (`zeroconf-avahi-protocol-inet4' means INET4, | |
251 | `zeroconf-avahi-protocol-inet6' means INET6). It can be | |
252 | different from PROTOCOL, when an adrress resolution has been | |
253 | requested for another protocol family but the default one. | |
254 | ||
255 | ADDRESS is the service address, encoded according to the | |
256 | APROTOCOL network protocol family. PORT is the corresponding | |
257 | port the service can be reached on ADDRESS. | |
258 | ||
259 | TXT is an array of strings, describing additional attributes of | |
260 | the service. Usually, every string is a key=value pair. The | |
261 | supported keys depend on the service type.") | |
262 | ||
263 | (defun zeroconf-list-service-names () | |
264 | "Returns all discovered Avahi service names as list." | |
265 | (let (result) | |
266 | (maphash | |
267 | (lambda (key value) (add-to-list 'result (zeroconf-service-name value))) | |
268 | zeroconf-services-hash) | |
269 | result)) | |
270 | ||
271 | (defun zeroconf-list-service-types () | |
272 | "Returns all discovered Avahi service types as list." | |
273 | (let (result) | |
274 | (maphash | |
275 | (lambda (key value) (add-to-list 'result (zeroconf-service-type value))) | |
276 | zeroconf-services-hash) | |
277 | result)) | |
278 | ||
279 | (defun zeroconf-list-services (type) | |
280 | "Returns all discovered Avahi services for a given service type TYPE. | |
281 | The service type is one of the returned values of | |
282 | `zeroconf-list-service-types'. The return value is a list | |
283 | \(SERVICE1 SERVICE2 ...\). See `zeroconf-services-hash' for the | |
284 | format of SERVICE." | |
285 | (let (result) | |
286 | (maphash | |
287 | (lambda (key value) | |
288 | (when (equal type (zeroconf-service-type value)) | |
289 | (add-to-list 'result value))) | |
290 | zeroconf-services-hash) | |
291 | result)) | |
292 | ||
293 | (defvar zeroconf-service-added-hooks-hash (make-hash-table :test 'equal) | |
294 | "Hash table of hooks for newly added services. | |
295 | The key of an entry is a service type.") | |
296 | ||
297 | (defvar zeroconf-service-removed-hooks-hash (make-hash-table :test 'equal) | |
298 | "Hash table of hooks for removed services. | |
299 | The key of an entry is a service type.") | |
300 | ||
301 | (defun zeroconf-service-add-hook (type event function) | |
302 | "Add FUNCTION to the hook of service type TYPE. | |
303 | ||
304 | EVENT must be either :new or :removed, indicating whether | |
305 | FUNCTION shall be called when a new service has been newly | |
306 | detected, or removed. | |
307 | ||
308 | FUNCTION must accept one argument SERVICE, which identifies the | |
309 | new service. Initially, when EVENT is :new, FUNCTION is called | |
310 | for all already detected services of service type TYPE. | |
311 | ||
312 | The attributes of SERVICE can be retrieved via the functions | |
313 | ||
314 | `zeroconf-service-interface' | |
315 | `zeroconf-service-protocol' | |
316 | `zeroconf-service-name' | |
317 | `zeroconf-service-type' | |
318 | `zeroconf-service-domain' | |
319 | `zeroconf-service-flags' | |
320 | `zeroconf-service-host' | |
321 | `zeroconf-service-aprotocol' | |
322 | `zeroconf-service-address' | |
323 | `zeroconf-service-port' | |
324 | `zeroconf-service-txt'" | |
325 | ||
326 | (cond | |
327 | ((equal event :new) | |
328 | (let ((l-hook (gethash type zeroconf-service-added-hooks-hash nil))) | |
329 | (add-hook 'l-hook function) | |
330 | (puthash type l-hook zeroconf-service-added-hooks-hash) | |
331 | (dolist (service (zeroconf-list-services type)) | |
332 | (funcall function service)))) | |
333 | ((equal event :removed) | |
334 | (let ((l-hook (gethash type zeroconf-service-removed-hooks-hash nil))) | |
335 | (add-hook 'l-hook function) | |
336 | (puthash type l-hook zeroconf-service-removed-hooks-hash))) | |
5a0c3f56 | 337 | (t (error "EVENT must be either `:new' or `:removed'")))) |
2e8cf9a7 | 338 | |
112dbc0e MA |
339 | (defun zeroconf-service-remove-hook (type event function) |
340 | "Remove FUNCTION from the hook of service type TYPE. | |
341 | ||
342 | EVENT must be either :new or :removed and has to match the event | |
343 | type used when registering FUNCTION." | |
344 | (let* ((table (cond | |
345 | ((equal event :new) | |
346 | zeroconf-service-added-hooks-hash) | |
347 | ((equal event :removed) | |
348 | zeroconf-service-removed-hooks-hash) | |
349 | (t (error "EVENT must be either `:new' or `:removed'")))) | |
350 | (l-hook (gethash type table nil))) | |
351 | (remove-hook 'l-hook function) | |
352 | (if l-hook | |
353 | (puthash type l-hook table) | |
354 | (remhash type table)))) | |
355 | ||
2e8cf9a7 MA |
356 | (defun zeroconf-get-host () |
357 | "Returns the local host name as string." | |
358 | (dbus-call-method | |
359 | :system zeroconf-service-avahi zeroconf-path-avahi | |
360 | zeroconf-interface-avahi-server "GetHostName")) | |
361 | ||
362 | (defun zeroconf-get-domain () | |
363 | "Returns the domain name as string." | |
364 | (dbus-call-method | |
365 | :system zeroconf-service-avahi zeroconf-path-avahi | |
366 | zeroconf-interface-avahi-server "GetDomainName")) | |
367 | ||
368 | (defun zeroconf-get-host-domain () | |
369 | "Returns the local host name FQDN as string." | |
370 | (dbus-call-method | |
371 | :system zeroconf-service-avahi zeroconf-path-avahi | |
372 | zeroconf-interface-avahi-server "GetHostNameFqdn")) | |
373 | ||
374 | (defun zeroconf-get-interface-name (number) | |
375 | "Return the interface name of internal interface NUMBER." | |
376 | (dbus-call-method | |
377 | :system zeroconf-service-avahi zeroconf-path-avahi | |
378 | zeroconf-interface-avahi-server "GetNetworkInterfaceNameByIndex" | |
379 | :int32 number)) | |
380 | ||
381 | (defun zeroconf-get-interface-number (name) | |
382 | "Return the internal interface number of interface NAME." | |
383 | (dbus-call-method | |
384 | :system zeroconf-service-avahi zeroconf-path-avahi | |
385 | zeroconf-interface-avahi-server "GetNetworkInterfaceIndexByName" | |
386 | name)) | |
387 | ||
388 | (defun zeroconf-get-service (name type) | |
389 | "Return the service description of service NAME as list. | |
390 | NAME must be a string. The service must be of service type | |
391 | TYPE. The resulting list has the format | |
392 | ||
393 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\)." | |
394 | ;; Due to the service browser, all known services are kept in | |
395 | ;; `zeroconf-services-hash'. | |
396 | (gethash (concat name "/" type) zeroconf-services-hash nil)) | |
397 | ||
398 | (defun zeroconf-resolve-service (service) | |
399 | "Return all service attributes SERVICE as list. | |
400 | NAME must be a string. The service must be of service type | |
401 | TYPE. The resulting list has the format | |
402 | ||
403 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\)." | |
404 | (let* ((name (zeroconf-service-name service)) | |
405 | (type (zeroconf-service-type service)) | |
406 | (key (concat name "/" type))) | |
407 | ||
408 | (or | |
409 | ;; Check whether we know this service already. | |
410 | (gethash key zeroconf-resolved-services-hash nil) | |
411 | ||
412 | ;; Resolve the service. We don't propagate D-Bus errors. | |
413 | (dbus-ignore-errors | |
414 | (let* ((result | |
415 | (dbus-call-method | |
416 | :system zeroconf-service-avahi zeroconf-path-avahi | |
417 | zeroconf-interface-avahi-server "ResolveService" | |
418 | zeroconf-avahi-interface-unspec | |
419 | zeroconf-avahi-protocol-unspec | |
420 | name type | |
421 | zeroconf-avahi-current-domain | |
422 | zeroconf-avahi-protocol-unspec | |
423 | zeroconf-avahi-flags-unspec)) | |
424 | (elt (nth 9 result))) ;; TXT. | |
425 | ;; The TXT field has the signature "aay". Transform to "as". | |
426 | (while elt | |
5d1cd8bd | 427 | (setcar elt (dbus-byte-array-to-string (car elt))) |
2e8cf9a7 MA |
428 | (setq elt (cdr elt))) |
429 | ||
430 | (when nil ;; We discard it, no use so far. | |
431 | ;; Register a service resolver. | |
432 | (let ((object-path (zeroconf-register-service-resolver name type))) | |
433 | ;; Register the signals. | |
434 | (dolist (member '("Found" "Failure")) | |
435 | (dbus-register-signal | |
436 | :system zeroconf-service-avahi object-path | |
437 | zeroconf-interface-avahi-service-resolver member | |
438 | 'zeroconf-service-resolver-handler))) | |
439 | ) | |
440 | ||
441 | ;; Return the resolved service. | |
442 | (puthash key result zeroconf-resolved-services-hash)))))) | |
443 | ||
444 | (defun zeroconf-service-interface (service) | |
445 | "Return the internal interface number of SERVICE." | |
446 | (nth 0 service)) | |
447 | ||
448 | (defun zeroconf-service-protocol (service) | |
449 | "Return the protocol number of SERVICE." | |
450 | (nth 1 service)) | |
451 | ||
452 | (defun zeroconf-service-name (service) | |
453 | "Return the service name of SERVICE." | |
454 | (nth 2 service)) | |
455 | ||
456 | (defun zeroconf-service-type (service) | |
457 | "Return the type name of SERVICE." | |
458 | (nth 3 service)) | |
459 | ||
460 | (defun zeroconf-service-domain (service) | |
461 | "Return the domain name of SERVICE." | |
462 | (nth 4 service)) | |
463 | ||
464 | (defun zeroconf-service-flags (service) | |
465 | "Return the flags of SERVICE." | |
466 | (nth 5 service)) | |
467 | ||
468 | (defun zeroconf-service-host (service) | |
469 | "Return the host name of SERVICE." | |
470 | (nth 5 (zeroconf-resolve-service service))) | |
471 | ||
472 | (defun zeroconf-service-aprotocol (service) | |
473 | "Return the aprotocol number of SERVICE." | |
474 | (nth 6 (zeroconf-resolve-service service))) | |
475 | ||
476 | (defun zeroconf-service-address (service) | |
477 | "Return the IP address of SERVICE." | |
478 | (nth 7 (zeroconf-resolve-service service))) | |
479 | ||
480 | (defun zeroconf-service-port (service) | |
481 | "Return the port number of SERVICE." | |
482 | (nth 8 (zeroconf-resolve-service service))) | |
483 | ||
484 | (defun zeroconf-service-txt (service) | |
485 | "Return the text strings of SERVICE." | |
486 | (nth 9 (zeroconf-resolve-service service))) | |
487 | ||
488 | \f | |
489 | ;;; Services signalling. | |
490 | ||
491 | ;; Register for the service type browser. Service registrations will | |
492 | ;; happen in `zeroconf-service-type-browser-handler', when there is an | |
493 | ;; "ItemNew" signal from the service type browser. | |
494 | (defun zeroconf-init (&optional domain) | |
495 | "Instantiate an Avahi service type browser for domain DOMAIN. | |
496 | DOMAIN is a string, like \"dns-sd.org\" or \"local\". When | |
497 | DOMAIN is nil, the local domain is used." | |
498 | (when (and (or (null domain) (stringp domain)) | |
499 | (dbus-ping :system zeroconf-service-avahi) | |
500 | (dbus-call-method | |
501 | :system zeroconf-service-avahi zeroconf-path-avahi | |
51768bc8 | 502 | zeroconf-interface-avahi-server "GetVersionString")) |
2e8cf9a7 MA |
503 | |
504 | ;; Reset all stored values. | |
505 | (setq zeroconf-path-avahi-service-type-browser nil | |
506 | zeroconf-avahi-current-domain (or domain | |
507 | zeroconf-avahi-domain-unspec)) | |
508 | (clrhash zeroconf-path-avahi-service-browser-hash) | |
509 | (clrhash zeroconf-path-avahi-service-resolver-hash) | |
510 | (clrhash zeroconf-services-hash) | |
511 | (clrhash zeroconf-resolved-services-hash) | |
512 | (clrhash zeroconf-service-added-hooks-hash) | |
513 | (clrhash zeroconf-service-removed-hooks-hash) | |
514 | ||
515 | ;; Register a service type browser. | |
516 | (let ((object-path (zeroconf-register-service-type-browser))) | |
517 | ;; Register the signals. | |
518 | (dolist (member '("ItemNew" "ItemRemove" "Failure")) | |
519 | (dbus-register-signal | |
520 | :system zeroconf-service-avahi object-path | |
521 | zeroconf-interface-avahi-service-type-browser member | |
522 | 'zeroconf-service-type-browser-handler))) | |
523 | ||
524 | ;; Register state changed signal. | |
525 | (dbus-register-signal | |
526 | :system zeroconf-service-avahi zeroconf-path-avahi | |
527 | zeroconf-interface-avahi-service-type-browser "StateChanged" | |
528 | 'zeroconf-service-type-browser-handler))) | |
529 | ||
530 | (defun zeroconf-register-service-type-browser () | |
531 | "Register a service type browser at the Avahi daemon." | |
532 | (or zeroconf-path-avahi-service-type-browser | |
533 | (setq zeroconf-path-avahi-service-type-browser | |
534 | (dbus-call-method | |
535 | :system zeroconf-service-avahi zeroconf-path-avahi | |
536 | zeroconf-interface-avahi-server "ServiceTypeBrowserNew" | |
537 | zeroconf-avahi-interface-unspec | |
538 | zeroconf-avahi-protocol-unspec | |
539 | zeroconf-avahi-current-domain | |
540 | zeroconf-avahi-flags-unspec)))) | |
541 | ||
542 | (defun zeroconf-service-type-browser-handler (&rest val) | |
543 | "Registered service type browser handler at the Avahi daemon." | |
544 | (when zeroconf-debug | |
545 | (message "zeroconf-service-type-browser-handler: %s %S" | |
546 | (dbus-event-member-name last-input-event) val)) | |
547 | (cond | |
548 | ((string-equal (dbus-event-member-name last-input-event) "ItemNew") | |
549 | ;; Parameters: (interface protocol type domain flags) | |
550 | ;; Register a service browser. | |
551 | (let ((object-path (zeroconf-register-service-browser (nth-value 2 val)))) | |
552 | ;; Register the signals. | |
553 | (dolist (member '("ItemNew" "ItemRemove" "Failure")) | |
554 | (dbus-register-signal | |
555 | :system zeroconf-service-avahi object-path | |
556 | zeroconf-interface-avahi-service-browser member | |
557 | 'zeroconf-service-browser-handler)))))) | |
558 | ||
559 | (defun zeroconf-register-service-browser (type) | |
560 | "Register a service browser at the Avahi daemon." | |
561 | (or (gethash type zeroconf-path-avahi-service-browser-hash nil) | |
562 | (puthash type | |
563 | (dbus-call-method | |
564 | :system zeroconf-service-avahi zeroconf-path-avahi | |
565 | zeroconf-interface-avahi-server "ServiceBrowserNew" | |
566 | zeroconf-avahi-interface-unspec | |
567 | zeroconf-avahi-protocol-unspec | |
568 | type | |
569 | zeroconf-avahi-current-domain | |
570 | zeroconf-avahi-flags-unspec) | |
571 | zeroconf-path-avahi-service-browser-hash))) | |
572 | ||
573 | (defun zeroconf-service-browser-handler (&rest val) | |
574 | "Registered service browser handler at the Avahi daemon." | |
575 | ;; Parameters: (interface protocol name type domain flags) | |
576 | (when zeroconf-debug | |
577 | (message "zeroconf-service-browser-handler: %s %S" | |
578 | (dbus-event-member-name last-input-event) val)) | |
579 | (let* ((name (zeroconf-service-name val)) | |
580 | (type (zeroconf-service-type val)) | |
581 | (key (concat name "/" type)) | |
582 | (ahook (gethash type zeroconf-service-added-hooks-hash nil)) | |
583 | (rhook (gethash type zeroconf-service-removed-hooks-hash nil))) | |
584 | (cond | |
585 | ((string-equal (dbus-event-member-name last-input-event) "ItemNew") | |
586 | ;; Add new service. | |
587 | (puthash key val zeroconf-services-hash) | |
588 | (run-hook-with-args 'ahook val)) | |
589 | ||
590 | ((string-equal (dbus-event-member-name last-input-event) "ItemRemove") | |
591 | ;; Remove the service. | |
592 | (remhash key zeroconf-services-hash) | |
593 | (remhash key zeroconf-resolved-services-hash) | |
594 | (run-hook-with-args 'rhook val))))) | |
595 | ||
596 | (defun zeroconf-register-service-resolver (name type) | |
597 | "Register a service resolver at the Avahi daemon." | |
598 | (let ((key (concat name "/" type))) | |
599 | (or (gethash key zeroconf-path-avahi-service-resolver-hash nil) | |
600 | (puthash key | |
601 | (dbus-call-method | |
602 | :system zeroconf-service-avahi zeroconf-path-avahi | |
603 | zeroconf-interface-avahi-server "ServiceResolverNew" | |
604 | zeroconf-avahi-interface-unspec | |
605 | zeroconf-avahi-protocol-unspec | |
606 | name type | |
607 | zeroconf-avahi-current-domain | |
608 | zeroconf-avahi-protocol-unspec | |
609 | zeroconf-avahi-flags-unspec) | |
610 | zeroconf-resolved-services-hash)))) | |
611 | ||
612 | (defun zeroconf-service-resolver-handler (&rest val) | |
613 | "Registered service resolver handler at the Avahi daemon." | |
614 | ;; Parameters: (interface protocol name type domain host aprotocol | |
615 | ;; address port txt flags) | |
616 | ;; The "TXT" field has the signature "aay". Transform to "as". | |
617 | (let ((elt (nth 9 val))) | |
618 | (while elt | |
5d1cd8bd | 619 | (setcar elt (dbus-byte-array-to-string (car elt))) |
2e8cf9a7 MA |
620 | (setq elt (cdr elt)))) |
621 | (when zeroconf-debug | |
622 | (message "zeroconf-service-resolver-handler: %s %S" | |
623 | (dbus-event-member-name last-input-event) val)) | |
624 | (cond | |
625 | ;; A new service has been detected. Add it to | |
626 | ;; `zeroconf-resolved-services-hash'. | |
627 | ((string-equal (dbus-event-member-name last-input-event) "Found") | |
628 | (puthash | |
629 | (concat (zeroconf-service-name val) "/" (zeroconf-service-type val)) | |
630 | val zeroconf-resolved-services-hash)))) | |
631 | ||
632 | \f | |
633 | ;;; Services publishing. | |
634 | ||
635 | (defun zeroconf-publish-service (name type domain host port address txt) | |
636 | "Publish a service at the Avahi daemon. | |
637 | For the description of arguments, see `zeroconf-resolved-services-hash'." | |
638 | ;; NAME and TYPE must not be empty. | |
639 | (when (zerop (length name)) | |
640 | (error "Invalid argument NAME: %s" name)) | |
641 | (when (zerop (length type)) | |
642 | (error "Invalid argument TYPE: %s" type)) | |
643 | ||
644 | ;; Set default values for DOMAIN, HOST and PORT. | |
645 | (when (zerop (length domain)) | |
646 | (setq domain (zeroconf-get-domain))) | |
647 | (when (zerop (length host)) | |
648 | (setq host (zeroconf-get-host-domain))) | |
649 | (when (null port) | |
650 | (setq port 0)) | |
651 | ||
652 | ;; Create an entry in the daemon. | |
653 | (let ((object-path | |
654 | (dbus-call-method | |
655 | :system zeroconf-service-avahi zeroconf-path-avahi | |
656 | zeroconf-interface-avahi-server "EntryGroupNew")) | |
657 | result) | |
658 | ||
659 | ;; The TXT field has the signature "as". Transform to "aay". | |
660 | (dolist (elt txt) | |
5d1cd8bd | 661 | (add-to-list 'result (dbus-string-to-byte-array elt))) |
2e8cf9a7 MA |
662 | |
663 | ;; Add the service. | |
664 | (dbus-call-method | |
665 | :system zeroconf-service-avahi object-path | |
666 | zeroconf-interface-avahi-entry-group "AddService" | |
667 | zeroconf-avahi-interface-unspec | |
668 | zeroconf-avahi-protocol-unspec | |
669 | zeroconf-avahi-flags-unspec | |
670 | name type domain host :uint16 port (append '(:array) result)) | |
671 | ||
672 | ;; Add the address. | |
673 | (unless (zerop (length address)) | |
674 | (dbus-call-method | |
675 | :system zeroconf-service-avahi object-path | |
676 | zeroconf-interface-avahi-entry-group "AddAddress" | |
677 | zeroconf-avahi-interface-unspec | |
678 | zeroconf-avahi-protocol-unspec | |
679 | zeroconf-avahi-flags-unspec | |
680 | host address)) | |
681 | ||
682 | ;; Make it persistent in the daemon. | |
683 | (dbus-call-method | |
684 | :system zeroconf-service-avahi object-path | |
685 | zeroconf-interface-avahi-entry-group "Commit"))) | |
686 | ||
687 | (provide 'zeroconf) | |
dc6ee347 | 688 | |
2e8cf9a7 | 689 | ;;; zeroconf.el ends here |