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