Commit | Line | Data |
---|---|---|
2e8cf9a7 MA |
1 | ;;; zeroconf.el --- Service browser using Avahi. |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2008-2014 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 | |
c80e3b4a | 85 | ;; published, can be specified by this function, it is usually the |
2e8cf9a7 MA |
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. | |
95eafb14 | 105 | (defvar dbus-debug) |
2e8cf9a7 MA |
106 | |
107 | (require 'dbus) | |
108 | ||
109 | (defvar zeroconf-debug nil | |
110 | "Write messages during service discovery") | |
111 | ||
112 | (defconst zeroconf-service-avahi "org.freedesktop.Avahi" | |
113 | "The D-Bus name used to talk to Avahi.") | |
114 | ||
115 | (defconst zeroconf-path-avahi "/" | |
116 | "The D-Bus root object path used to talk to Avahi.") | |
117 | ||
118 | (defvar zeroconf-path-avahi-service-type-browser nil | |
119 | "The D-Bus object path used to talk to the Avahi service type browser.") | |
120 | ||
121 | (defvar zeroconf-path-avahi-service-browser-hash (make-hash-table :test 'equal) | |
122 | "The D-Bus object paths used to talk to the Avahi service browser.") | |
123 | ||
124 | (defvar zeroconf-path-avahi-service-resolver-hash (make-hash-table :test 'equal) | |
125 | "The D-Bus object paths used to talk to the Avahi service resolver.") | |
126 | ||
127 | ;; Methods: "Free", "Commit", "Reset", "GetState", "IsEmpty", | |
128 | ;; "AddService", "AddServiceSubtype", "UpdateServiceTxt", "AddAddress" | |
129 | ;; and "AddRecord". | |
130 | ;; Signals: "StateChanged". | |
131 | (defconst zeroconf-interface-avahi-entry-group | |
132 | (concat zeroconf-service-avahi ".EntryGroup") | |
133 | "The D-Bus entry group interface exported by Avahi.") | |
134 | ||
135 | ;; Methods: "GetVersionString", "GetAPIVersion", "GetHostName", | |
136 | ;; "SetHostName", "GetHostNameFqdn", "GetDomainName", | |
137 | ;; "IsNSSSupportAvailable", "GetState", "GetLocalServiceCookie", | |
138 | ;; "GetAlternativeHostName", "GetAlternativeServiceName", | |
139 | ;; "GetNetworkInterfaceNameByIndex", "GetNetworkInterfaceIndexByName", | |
140 | ;; "ResolveHostName", "ResolveAddress", "ResolveService", | |
141 | ;; "EntryGroupNew", "DomainBrowserNew", "ServiceTypeBrowserNew", | |
142 | ;; "ServiceBrowserNew", "ServiceResolverNew", "HostNameResolverNew", | |
143 | ;; "AddressResolverNew" and "RecordBrowserNew". | |
144 | ;; Signals: "StateChanged". | |
145 | (defconst zeroconf-interface-avahi-server | |
146 | (concat zeroconf-service-avahi ".Server") | |
147 | "The D-Bus server interface exported by Avahi.") | |
148 | ||
149 | ;; Methods: "Free". | |
150 | ;; Signals: "ItemNew", "ItemRemove", "CacheExhausted", "AllForNow" and | |
151 | ;; "Failure". | |
152 | (defconst zeroconf-interface-avahi-service-type-browser | |
153 | (concat zeroconf-service-avahi ".ServiceTypeBrowser") | |
154 | "The D-Bus service type browser interface exported by Avahi.") | |
155 | ||
156 | ;; Methods: "Free". | |
157 | ;; Signals: "ItemNew", "ItemRemove", "CacheExhausted", "AllForNow" and | |
158 | ;; "Failure". | |
159 | (defconst zeroconf-interface-avahi-service-browser | |
160 | (concat zeroconf-service-avahi ".ServiceBrowser") | |
161 | "The D-Bus service browser interface exported by Avahi.") | |
162 | ||
163 | ;; Methods: "Free". | |
164 | ;; Available signals are "Found" and "Failure". | |
165 | (defconst zeroconf-interface-avahi-service-resolver | |
166 | (concat zeroconf-service-avahi ".ServiceResolver") | |
167 | "The D-Bus service resolver interface exported by Avahi.") | |
168 | ||
169 | (defconst zeroconf-avahi-interface-unspec -1 | |
170 | "Wildcard Avahi interface spec.") | |
171 | ||
172 | (defconst zeroconf-avahi-protocol-unspec -1 | |
173 | "Wildcard Avahi protocol spec.") | |
174 | ||
175 | (defconst zeroconf-avahi-protocol-inet4 0 | |
176 | "Avahi INET4 address protocol family.") | |
177 | ||
178 | (defconst zeroconf-avahi-protocol-inet6 1 | |
179 | "Avahi INET6 address protocol family.") | |
180 | ||
181 | (defconst zeroconf-avahi-domain-unspec "" | |
182 | "Empty Avahi domain.") | |
183 | ||
184 | (defvar zeroconf-avahi-current-domain zeroconf-avahi-domain-unspec | |
185 | "Domain name services are resolved for.") | |
186 | ||
187 | (defconst zeroconf-avahi-flags-unspec 0 | |
188 | "No Avahi flags.") | |
189 | ||
190 | \f | |
191 | ;;; Services retrieval. | |
192 | ||
193 | (defvar zeroconf-services-hash (make-hash-table :test 'equal) | |
194 | "Hash table of discovered Avahi services. | |
195 | ||
196 | The key of an entry is the concatenation of the service name and | |
197 | service type of a discovered service. The value is the service | |
198 | itself. The format of a service is | |
199 | ||
200 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\) | |
201 | ||
202 | The INTERFACE is a number, which represents the network interface | |
203 | the service is located at. The corresponding network interface | |
204 | name, like \"eth0\", can be retrieved with the function | |
205 | `zeroconf-get-interface-name'. | |
206 | ||
207 | PROTOCOL describes the used network protocol family the service | |
208 | can be accessed. `zeroconf-avahi-protocol-inet4' means INET4, | |
209 | `zeroconf-avahi-protocol-inet6' means INET6. An unspecified | |
210 | protocol family is coded with `zeroconf-avahi-protocol-unspec'. | |
211 | ||
212 | NAME is the string the service is known at Avahi. A service can | |
213 | be known under the same name for different service types. | |
214 | ||
215 | Each TYPE stands for a discovered service type of Avahi. The | |
216 | format is described in RFC 2782. It is of the form | |
217 | ||
218 | \"_APPLICATION-PROTOCOL._TRANSPORT-PROTOCOL\". | |
219 | ||
220 | TRANSPORT-PROTOCOL must be either \"tcp\" or \"udp\". | |
221 | APPLICATION-PROTOCOL must be a protocol name as specified in URL | |
222 | `http://www.dns-sd.org/ServiceTypes.html'. Typical service types | |
223 | are \"_workstation._tcp\" or \"_printer._tcp\". | |
224 | ||
225 | DOMAIN is the domain name the service is registered in, like \"local\". | |
226 | ||
227 | FLAGS, an integer, is used inside Avahi. When publishing a | |
228 | service (see `zeroconf-publish-service', the flag 0 is used.") | |
229 | ||
230 | (defvar zeroconf-resolved-services-hash (make-hash-table :test 'equal) | |
231 | "Hash table of resolved Avahi services. | |
232 | The key of an entry is the concatenation of the service name and | |
233 | service type of a resolved service. The value is the service | |
234 | itself. The format of a service is | |
235 | ||
236 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\) | |
237 | ||
238 | INTERFACE, PROTOCOL, NAME, TYPE, DOMAIN and FLAGS have the same | |
239 | meaning as in `zeroconf-services-hash'. | |
240 | ||
241 | HOST is the host name the service is registered. It is a fully | |
242 | qualified name, i.e., it contains DOMAIN. | |
243 | ||
244 | APROTOCOL stands for the network protocol family ADDRESS is | |
245 | encoded (`zeroconf-avahi-protocol-inet4' means INET4, | |
246 | `zeroconf-avahi-protocol-inet6' means INET6). It can be | |
91af3942 | 247 | different from PROTOCOL, when an address resolution has been |
2e8cf9a7 MA |
248 | requested for another protocol family but the default one. |
249 | ||
250 | ADDRESS is the service address, encoded according to the | |
251 | APROTOCOL network protocol family. PORT is the corresponding | |
252 | port the service can be reached on ADDRESS. | |
253 | ||
254 | TXT is an array of strings, describing additional attributes of | |
255 | the service. Usually, every string is a key=value pair. The | |
256 | supported keys depend on the service type.") | |
257 | ||
258 | (defun zeroconf-list-service-names () | |
259 | "Returns all discovered Avahi service names as list." | |
260 | (let (result) | |
261 | (maphash | |
262 | (lambda (key value) (add-to-list 'result (zeroconf-service-name value))) | |
263 | zeroconf-services-hash) | |
264 | result)) | |
265 | ||
266 | (defun zeroconf-list-service-types () | |
267 | "Returns all discovered Avahi service types as list." | |
268 | (let (result) | |
269 | (maphash | |
270 | (lambda (key value) (add-to-list 'result (zeroconf-service-type value))) | |
271 | zeroconf-services-hash) | |
272 | result)) | |
273 | ||
274 | (defun zeroconf-list-services (type) | |
275 | "Returns all discovered Avahi services for a given service type TYPE. | |
276 | The service type is one of the returned values of | |
277 | `zeroconf-list-service-types'. The return value is a list | |
278 | \(SERVICE1 SERVICE2 ...\). See `zeroconf-services-hash' for the | |
279 | format of SERVICE." | |
280 | (let (result) | |
281 | (maphash | |
282 | (lambda (key value) | |
283 | (when (equal type (zeroconf-service-type value)) | |
284 | (add-to-list 'result value))) | |
285 | zeroconf-services-hash) | |
286 | result)) | |
287 | ||
288 | (defvar zeroconf-service-added-hooks-hash (make-hash-table :test 'equal) | |
289 | "Hash table of hooks for newly added services. | |
290 | The key of an entry is a service type.") | |
291 | ||
292 | (defvar zeroconf-service-removed-hooks-hash (make-hash-table :test 'equal) | |
293 | "Hash table of hooks for removed services. | |
294 | The key of an entry is a service type.") | |
295 | ||
296 | (defun zeroconf-service-add-hook (type event function) | |
297 | "Add FUNCTION to the hook of service type TYPE. | |
298 | ||
299 | EVENT must be either :new or :removed, indicating whether | |
300 | FUNCTION shall be called when a new service has been newly | |
301 | detected, or removed. | |
302 | ||
303 | FUNCTION must accept one argument SERVICE, which identifies the | |
304 | new service. Initially, when EVENT is :new, FUNCTION is called | |
305 | for all already detected services of service type TYPE. | |
306 | ||
307 | The attributes of SERVICE can be retrieved via the functions | |
308 | ||
309 | `zeroconf-service-interface' | |
310 | `zeroconf-service-protocol' | |
311 | `zeroconf-service-name' | |
312 | `zeroconf-service-type' | |
313 | `zeroconf-service-domain' | |
314 | `zeroconf-service-flags' | |
315 | `zeroconf-service-host' | |
316 | `zeroconf-service-aprotocol' | |
317 | `zeroconf-service-address' | |
318 | `zeroconf-service-port' | |
319 | `zeroconf-service-txt'" | |
320 | ||
321 | (cond | |
322 | ((equal event :new) | |
323 | (let ((l-hook (gethash type zeroconf-service-added-hooks-hash nil))) | |
324 | (add-hook 'l-hook function) | |
325 | (puthash type l-hook zeroconf-service-added-hooks-hash) | |
326 | (dolist (service (zeroconf-list-services type)) | |
327 | (funcall function service)))) | |
328 | ((equal event :removed) | |
329 | (let ((l-hook (gethash type zeroconf-service-removed-hooks-hash nil))) | |
330 | (add-hook 'l-hook function) | |
331 | (puthash type l-hook zeroconf-service-removed-hooks-hash))) | |
5a0c3f56 | 332 | (t (error "EVENT must be either `:new' or `:removed'")))) |
2e8cf9a7 | 333 | |
112dbc0e MA |
334 | (defun zeroconf-service-remove-hook (type event function) |
335 | "Remove FUNCTION from the hook of service type TYPE. | |
336 | ||
337 | EVENT must be either :new or :removed and has to match the event | |
338 | type used when registering FUNCTION." | |
339 | (let* ((table (cond | |
340 | ((equal event :new) | |
341 | zeroconf-service-added-hooks-hash) | |
342 | ((equal event :removed) | |
343 | zeroconf-service-removed-hooks-hash) | |
344 | (t (error "EVENT must be either `:new' or `:removed'")))) | |
345 | (l-hook (gethash type table nil))) | |
346 | (remove-hook 'l-hook function) | |
347 | (if l-hook | |
348 | (puthash type l-hook table) | |
349 | (remhash type table)))) | |
350 | ||
2e8cf9a7 MA |
351 | (defun zeroconf-get-host () |
352 | "Returns the local host name as string." | |
353 | (dbus-call-method | |
354 | :system zeroconf-service-avahi zeroconf-path-avahi | |
355 | zeroconf-interface-avahi-server "GetHostName")) | |
356 | ||
357 | (defun zeroconf-get-domain () | |
358 | "Returns the domain name as string." | |
359 | (dbus-call-method | |
360 | :system zeroconf-service-avahi zeroconf-path-avahi | |
361 | zeroconf-interface-avahi-server "GetDomainName")) | |
362 | ||
363 | (defun zeroconf-get-host-domain () | |
364 | "Returns the local host name FQDN as string." | |
365 | (dbus-call-method | |
366 | :system zeroconf-service-avahi zeroconf-path-avahi | |
367 | zeroconf-interface-avahi-server "GetHostNameFqdn")) | |
368 | ||
369 | (defun zeroconf-get-interface-name (number) | |
370 | "Return the interface name of internal interface NUMBER." | |
371 | (dbus-call-method | |
372 | :system zeroconf-service-avahi zeroconf-path-avahi | |
373 | zeroconf-interface-avahi-server "GetNetworkInterfaceNameByIndex" | |
374 | :int32 number)) | |
375 | ||
376 | (defun zeroconf-get-interface-number (name) | |
377 | "Return the internal interface number of interface NAME." | |
378 | (dbus-call-method | |
379 | :system zeroconf-service-avahi zeroconf-path-avahi | |
380 | zeroconf-interface-avahi-server "GetNetworkInterfaceIndexByName" | |
381 | name)) | |
382 | ||
383 | (defun zeroconf-get-service (name type) | |
384 | "Return the service description of service NAME as list. | |
385 | NAME must be a string. The service must be of service type | |
386 | TYPE. The resulting list has the format | |
387 | ||
388 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\)." | |
389 | ;; Due to the service browser, all known services are kept in | |
390 | ;; `zeroconf-services-hash'. | |
391 | (gethash (concat name "/" type) zeroconf-services-hash nil)) | |
392 | ||
393 | (defun zeroconf-resolve-service (service) | |
394 | "Return all service attributes SERVICE as list. | |
395 | NAME must be a string. The service must be of service type | |
396 | TYPE. The resulting list has the format | |
397 | ||
398 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\)." | |
399 | (let* ((name (zeroconf-service-name service)) | |
400 | (type (zeroconf-service-type service)) | |
401 | (key (concat name "/" type))) | |
402 | ||
403 | (or | |
404 | ;; Check whether we know this service already. | |
405 | (gethash key zeroconf-resolved-services-hash nil) | |
406 | ||
407 | ;; Resolve the service. We don't propagate D-Bus errors. | |
408 | (dbus-ignore-errors | |
409 | (let* ((result | |
410 | (dbus-call-method | |
411 | :system zeroconf-service-avahi zeroconf-path-avahi | |
412 | zeroconf-interface-avahi-server "ResolveService" | |
413 | zeroconf-avahi-interface-unspec | |
414 | zeroconf-avahi-protocol-unspec | |
415 | name type | |
416 | zeroconf-avahi-current-domain | |
417 | zeroconf-avahi-protocol-unspec | |
418 | zeroconf-avahi-flags-unspec)) | |
419 | (elt (nth 9 result))) ;; TXT. | |
420 | ;; The TXT field has the signature "aay". Transform to "as". | |
421 | (while elt | |
5d1cd8bd | 422 | (setcar elt (dbus-byte-array-to-string (car elt))) |
2e8cf9a7 MA |
423 | (setq elt (cdr elt))) |
424 | ||
425 | (when nil ;; We discard it, no use so far. | |
426 | ;; Register a service resolver. | |
427 | (let ((object-path (zeroconf-register-service-resolver name type))) | |
428 | ;; Register the signals. | |
429 | (dolist (member '("Found" "Failure")) | |
430 | (dbus-register-signal | |
431 | :system zeroconf-service-avahi object-path | |
432 | zeroconf-interface-avahi-service-resolver member | |
433 | 'zeroconf-service-resolver-handler))) | |
434 | ) | |
435 | ||
436 | ;; Return the resolved service. | |
437 | (puthash key result zeroconf-resolved-services-hash)))))) | |
438 | ||
439 | (defun zeroconf-service-interface (service) | |
440 | "Return the internal interface number of SERVICE." | |
441 | (nth 0 service)) | |
442 | ||
443 | (defun zeroconf-service-protocol (service) | |
444 | "Return the protocol number of SERVICE." | |
445 | (nth 1 service)) | |
446 | ||
447 | (defun zeroconf-service-name (service) | |
448 | "Return the service name of SERVICE." | |
449 | (nth 2 service)) | |
450 | ||
451 | (defun zeroconf-service-type (service) | |
452 | "Return the type name of SERVICE." | |
453 | (nth 3 service)) | |
454 | ||
455 | (defun zeroconf-service-domain (service) | |
456 | "Return the domain name of SERVICE." | |
457 | (nth 4 service)) | |
458 | ||
459 | (defun zeroconf-service-flags (service) | |
460 | "Return the flags of SERVICE." | |
461 | (nth 5 service)) | |
462 | ||
463 | (defun zeroconf-service-host (service) | |
464 | "Return the host name of SERVICE." | |
465 | (nth 5 (zeroconf-resolve-service service))) | |
466 | ||
467 | (defun zeroconf-service-aprotocol (service) | |
468 | "Return the aprotocol number of SERVICE." | |
469 | (nth 6 (zeroconf-resolve-service service))) | |
470 | ||
471 | (defun zeroconf-service-address (service) | |
472 | "Return the IP address of SERVICE." | |
473 | (nth 7 (zeroconf-resolve-service service))) | |
474 | ||
475 | (defun zeroconf-service-port (service) | |
476 | "Return the port number of SERVICE." | |
477 | (nth 8 (zeroconf-resolve-service service))) | |
478 | ||
479 | (defun zeroconf-service-txt (service) | |
480 | "Return the text strings of SERVICE." | |
481 | (nth 9 (zeroconf-resolve-service service))) | |
482 | ||
483 | \f | |
8350f087 | 484 | ;;; Services signaling. |
2e8cf9a7 MA |
485 | |
486 | ;; Register for the service type browser. Service registrations will | |
487 | ;; happen in `zeroconf-service-type-browser-handler', when there is an | |
488 | ;; "ItemNew" signal from the service type browser. | |
489 | (defun zeroconf-init (&optional domain) | |
490 | "Instantiate an Avahi service type browser for domain DOMAIN. | |
491 | DOMAIN is a string, like \"dns-sd.org\" or \"local\". When | |
492 | DOMAIN is nil, the local domain is used." | |
493 | (when (and (or (null domain) (stringp domain)) | |
494 | (dbus-ping :system zeroconf-service-avahi) | |
495 | (dbus-call-method | |
496 | :system zeroconf-service-avahi zeroconf-path-avahi | |
51768bc8 | 497 | zeroconf-interface-avahi-server "GetVersionString")) |
2e8cf9a7 MA |
498 | |
499 | ;; Reset all stored values. | |
500 | (setq zeroconf-path-avahi-service-type-browser nil | |
501 | zeroconf-avahi-current-domain (or domain | |
502 | zeroconf-avahi-domain-unspec)) | |
503 | (clrhash zeroconf-path-avahi-service-browser-hash) | |
504 | (clrhash zeroconf-path-avahi-service-resolver-hash) | |
505 | (clrhash zeroconf-services-hash) | |
506 | (clrhash zeroconf-resolved-services-hash) | |
507 | (clrhash zeroconf-service-added-hooks-hash) | |
508 | (clrhash zeroconf-service-removed-hooks-hash) | |
509 | ||
510 | ;; Register a service type browser. | |
511 | (let ((object-path (zeroconf-register-service-type-browser))) | |
512 | ;; Register the signals. | |
513 | (dolist (member '("ItemNew" "ItemRemove" "Failure")) | |
514 | (dbus-register-signal | |
515 | :system zeroconf-service-avahi object-path | |
516 | zeroconf-interface-avahi-service-type-browser member | |
517 | 'zeroconf-service-type-browser-handler))) | |
518 | ||
519 | ;; Register state changed signal. | |
520 | (dbus-register-signal | |
521 | :system zeroconf-service-avahi zeroconf-path-avahi | |
522 | zeroconf-interface-avahi-service-type-browser "StateChanged" | |
523 | 'zeroconf-service-type-browser-handler))) | |
524 | ||
525 | (defun zeroconf-register-service-type-browser () | |
526 | "Register a service type browser at the Avahi daemon." | |
527 | (or zeroconf-path-avahi-service-type-browser | |
528 | (setq zeroconf-path-avahi-service-type-browser | |
529 | (dbus-call-method | |
530 | :system zeroconf-service-avahi zeroconf-path-avahi | |
531 | zeroconf-interface-avahi-server "ServiceTypeBrowserNew" | |
532 | zeroconf-avahi-interface-unspec | |
533 | zeroconf-avahi-protocol-unspec | |
534 | zeroconf-avahi-current-domain | |
535 | zeroconf-avahi-flags-unspec)))) | |
536 | ||
537 | (defun zeroconf-service-type-browser-handler (&rest val) | |
538 | "Registered service type browser handler at the Avahi daemon." | |
539 | (when zeroconf-debug | |
540 | (message "zeroconf-service-type-browser-handler: %s %S" | |
541 | (dbus-event-member-name last-input-event) val)) | |
542 | (cond | |
543 | ((string-equal (dbus-event-member-name last-input-event) "ItemNew") | |
544 | ;; Parameters: (interface protocol type domain flags) | |
545 | ;; Register a service browser. | |
a464a6c7 | 546 | (let ((object-path (zeroconf-register-service-browser (nth 2 val)))) |
2e8cf9a7 MA |
547 | ;; Register the signals. |
548 | (dolist (member '("ItemNew" "ItemRemove" "Failure")) | |
549 | (dbus-register-signal | |
550 | :system zeroconf-service-avahi object-path | |
551 | zeroconf-interface-avahi-service-browser member | |
552 | 'zeroconf-service-browser-handler)))))) | |
553 | ||
554 | (defun zeroconf-register-service-browser (type) | |
555 | "Register a service browser at the Avahi daemon." | |
556 | (or (gethash type zeroconf-path-avahi-service-browser-hash nil) | |
557 | (puthash type | |
558 | (dbus-call-method | |
559 | :system zeroconf-service-avahi zeroconf-path-avahi | |
560 | zeroconf-interface-avahi-server "ServiceBrowserNew" | |
561 | zeroconf-avahi-interface-unspec | |
562 | zeroconf-avahi-protocol-unspec | |
563 | type | |
564 | zeroconf-avahi-current-domain | |
565 | zeroconf-avahi-flags-unspec) | |
566 | zeroconf-path-avahi-service-browser-hash))) | |
567 | ||
568 | (defun zeroconf-service-browser-handler (&rest val) | |
569 | "Registered service browser handler at the Avahi daemon." | |
570 | ;; Parameters: (interface protocol name type domain flags) | |
571 | (when zeroconf-debug | |
572 | (message "zeroconf-service-browser-handler: %s %S" | |
573 | (dbus-event-member-name last-input-event) val)) | |
574 | (let* ((name (zeroconf-service-name val)) | |
575 | (type (zeroconf-service-type val)) | |
576 | (key (concat name "/" type)) | |
577 | (ahook (gethash type zeroconf-service-added-hooks-hash nil)) | |
578 | (rhook (gethash type zeroconf-service-removed-hooks-hash nil))) | |
579 | (cond | |
580 | ((string-equal (dbus-event-member-name last-input-event) "ItemNew") | |
581 | ;; Add new service. | |
582 | (puthash key val zeroconf-services-hash) | |
583 | (run-hook-with-args 'ahook val)) | |
584 | ||
585 | ((string-equal (dbus-event-member-name last-input-event) "ItemRemove") | |
586 | ;; Remove the service. | |
587 | (remhash key zeroconf-services-hash) | |
588 | (remhash key zeroconf-resolved-services-hash) | |
589 | (run-hook-with-args 'rhook val))))) | |
590 | ||
591 | (defun zeroconf-register-service-resolver (name type) | |
592 | "Register a service resolver at the Avahi daemon." | |
593 | (let ((key (concat name "/" type))) | |
594 | (or (gethash key zeroconf-path-avahi-service-resolver-hash nil) | |
595 | (puthash key | |
596 | (dbus-call-method | |
597 | :system zeroconf-service-avahi zeroconf-path-avahi | |
598 | zeroconf-interface-avahi-server "ServiceResolverNew" | |
599 | zeroconf-avahi-interface-unspec | |
600 | zeroconf-avahi-protocol-unspec | |
601 | name type | |
602 | zeroconf-avahi-current-domain | |
603 | zeroconf-avahi-protocol-unspec | |
604 | zeroconf-avahi-flags-unspec) | |
605 | zeroconf-resolved-services-hash)))) | |
606 | ||
607 | (defun zeroconf-service-resolver-handler (&rest val) | |
608 | "Registered service resolver handler at the Avahi daemon." | |
609 | ;; Parameters: (interface protocol name type domain host aprotocol | |
610 | ;; address port txt flags) | |
611 | ;; The "TXT" field has the signature "aay". Transform to "as". | |
612 | (let ((elt (nth 9 val))) | |
613 | (while elt | |
5d1cd8bd | 614 | (setcar elt (dbus-byte-array-to-string (car elt))) |
2e8cf9a7 MA |
615 | (setq elt (cdr elt)))) |
616 | (when zeroconf-debug | |
617 | (message "zeroconf-service-resolver-handler: %s %S" | |
618 | (dbus-event-member-name last-input-event) val)) | |
619 | (cond | |
620 | ;; A new service has been detected. Add it to | |
621 | ;; `zeroconf-resolved-services-hash'. | |
622 | ((string-equal (dbus-event-member-name last-input-event) "Found") | |
623 | (puthash | |
624 | (concat (zeroconf-service-name val) "/" (zeroconf-service-type val)) | |
625 | val zeroconf-resolved-services-hash)))) | |
626 | ||
627 | \f | |
628 | ;;; Services publishing. | |
629 | ||
630 | (defun zeroconf-publish-service (name type domain host port address txt) | |
631 | "Publish a service at the Avahi daemon. | |
632 | For the description of arguments, see `zeroconf-resolved-services-hash'." | |
633 | ;; NAME and TYPE must not be empty. | |
634 | (when (zerop (length name)) | |
635 | (error "Invalid argument NAME: %s" name)) | |
636 | (when (zerop (length type)) | |
637 | (error "Invalid argument TYPE: %s" type)) | |
638 | ||
639 | ;; Set default values for DOMAIN, HOST and PORT. | |
640 | (when (zerop (length domain)) | |
641 | (setq domain (zeroconf-get-domain))) | |
642 | (when (zerop (length host)) | |
643 | (setq host (zeroconf-get-host-domain))) | |
644 | (when (null port) | |
645 | (setq port 0)) | |
646 | ||
647 | ;; Create an entry in the daemon. | |
648 | (let ((object-path | |
649 | (dbus-call-method | |
650 | :system zeroconf-service-avahi zeroconf-path-avahi | |
651 | zeroconf-interface-avahi-server "EntryGroupNew")) | |
652 | result) | |
653 | ||
654 | ;; The TXT field has the signature "as". Transform to "aay". | |
655 | (dolist (elt txt) | |
5d1cd8bd | 656 | (add-to-list 'result (dbus-string-to-byte-array elt))) |
2e8cf9a7 MA |
657 | |
658 | ;; Add the service. | |
659 | (dbus-call-method | |
660 | :system zeroconf-service-avahi object-path | |
661 | zeroconf-interface-avahi-entry-group "AddService" | |
662 | zeroconf-avahi-interface-unspec | |
663 | zeroconf-avahi-protocol-unspec | |
664 | zeroconf-avahi-flags-unspec | |
665 | name type domain host :uint16 port (append '(:array) result)) | |
666 | ||
667 | ;; Add the address. | |
668 | (unless (zerop (length address)) | |
669 | (dbus-call-method | |
670 | :system zeroconf-service-avahi object-path | |
671 | zeroconf-interface-avahi-entry-group "AddAddress" | |
672 | zeroconf-avahi-interface-unspec | |
673 | zeroconf-avahi-protocol-unspec | |
674 | zeroconf-avahi-flags-unspec | |
675 | host address)) | |
676 | ||
677 | ;; Make it persistent in the daemon. | |
678 | (dbus-call-method | |
679 | :system zeroconf-service-avahi object-path | |
680 | zeroconf-interface-avahi-entry-group "Commit"))) | |
681 | ||
682 | (provide 'zeroconf) | |
dc6ee347 | 683 | |
2e8cf9a7 | 684 | ;;; zeroconf.el ends here |