Fix typos.
[bpt/emacs.git] / lisp / net / zeroconf.el
CommitLineData
2e8cf9a7
MA
1;;; zeroconf.el --- Service browser using Avahi.
2
ae940284 3;; Copyright (C) 2008, 2009 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
201The key of an entry is the concatenation of the service name and
202service type of a discovered service. The value is the service
203itself. The format of a service is
204
205 \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\)
206
207The INTERFACE is a number, which represents the network interface
208the service is located at. The corresponding network interface
209name, like \"eth0\", can be retrieved with the function
210`zeroconf-get-interface-name'.
211
212PROTOCOL describes the used network protocol family the service
213can be accessed. `zeroconf-avahi-protocol-inet4' means INET4,
214`zeroconf-avahi-protocol-inet6' means INET6. An unspecified
215protocol family is coded with `zeroconf-avahi-protocol-unspec'.
216
217NAME is the string the service is known at Avahi. A service can
218be known under the same name for different service types.
219
220Each TYPE stands for a discovered service type of Avahi. The
221format is described in RFC 2782. It is of the form
222
223 \"_APPLICATION-PROTOCOL._TRANSPORT-PROTOCOL\".
224
225TRANSPORT-PROTOCOL must be either \"tcp\" or \"udp\".
226APPLICATION-PROTOCOL must be a protocol name as specified in URL
227`http://www.dns-sd.org/ServiceTypes.html'. Typical service types
228are \"_workstation._tcp\" or \"_printer._tcp\".
229
230DOMAIN is the domain name the service is registered in, like \"local\".
231
232FLAGS, an integer, is used inside Avahi. When publishing a
233service (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.
237The key of an entry is the concatenation of the service name and
238service type of a resolved service. The value is the service
239itself. The format of a service is
240
241 \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\)
242
243INTERFACE, PROTOCOL, NAME, TYPE, DOMAIN and FLAGS have the same
244meaning as in `zeroconf-services-hash'.
245
246HOST is the host name the service is registered. It is a fully
247qualified name, i.e., it contains DOMAIN.
248
249APROTOCOL stands for the network protocol family ADDRESS is
250encoded (`zeroconf-avahi-protocol-inet4' means INET4,
251`zeroconf-avahi-protocol-inet6' means INET6). It can be
252different from PROTOCOL, when an adrress resolution has been
253requested for another protocol family but the default one.
254
255ADDRESS is the service address, encoded according to the
256APROTOCOL network protocol family. PORT is the corresponding
257port the service can be reached on ADDRESS.
258
259TXT is an array of strings, describing additional attributes of
260the service. Usually, every string is a key=value pair. The
261supported 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.
281The 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
284format 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.
295The 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.
299The 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
304EVENT must be either :new or :removed, indicating whether
305FUNCTION shall be called when a new service has been newly
306detected, or removed.
307
308FUNCTION must accept one argument SERVICE, which identifies the
309new service. Initially, when EVENT is :new, FUNCTION is called
310for all already detected services of service type TYPE.
311
312The 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
MA
338
339(defun zeroconf-get-host ()
340 "Returns the local host name as string."
341 (dbus-call-method
342 :system zeroconf-service-avahi zeroconf-path-avahi
343 zeroconf-interface-avahi-server "GetHostName"))
344
345(defun zeroconf-get-domain ()
346 "Returns the domain name as string."
347 (dbus-call-method
348 :system zeroconf-service-avahi zeroconf-path-avahi
349 zeroconf-interface-avahi-server "GetDomainName"))
350
351(defun zeroconf-get-host-domain ()
352 "Returns the local host name FQDN as string."
353 (dbus-call-method
354 :system zeroconf-service-avahi zeroconf-path-avahi
355 zeroconf-interface-avahi-server "GetHostNameFqdn"))
356
357(defun zeroconf-get-interface-name (number)
358 "Return the interface name of internal interface NUMBER."
359 (dbus-call-method
360 :system zeroconf-service-avahi zeroconf-path-avahi
361 zeroconf-interface-avahi-server "GetNetworkInterfaceNameByIndex"
362 :int32 number))
363
364(defun zeroconf-get-interface-number (name)
365 "Return the internal interface number of interface NAME."
366 (dbus-call-method
367 :system zeroconf-service-avahi zeroconf-path-avahi
368 zeroconf-interface-avahi-server "GetNetworkInterfaceIndexByName"
369 name))
370
371(defun zeroconf-get-service (name type)
372 "Return the service description of service NAME as list.
373NAME must be a string. The service must be of service type
374TYPE. The resulting list has the format
375
376 \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\)."
377 ;; Due to the service browser, all known services are kept in
378 ;; `zeroconf-services-hash'.
379 (gethash (concat name "/" type) zeroconf-services-hash nil))
380
381(defun zeroconf-resolve-service (service)
382 "Return all service attributes SERVICE as list.
383NAME must be a string. The service must be of service type
384TYPE. The resulting list has the format
385
386 \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\)."
387 (let* ((name (zeroconf-service-name service))
388 (type (zeroconf-service-type service))
389 (key (concat name "/" type)))
390
391 (or
392 ;; Check whether we know this service already.
393 (gethash key zeroconf-resolved-services-hash nil)
394
395 ;; Resolve the service. We don't propagate D-Bus errors.
396 (dbus-ignore-errors
397 (let* ((result
398 (dbus-call-method
399 :system zeroconf-service-avahi zeroconf-path-avahi
400 zeroconf-interface-avahi-server "ResolveService"
401 zeroconf-avahi-interface-unspec
402 zeroconf-avahi-protocol-unspec
403 name type
404 zeroconf-avahi-current-domain
405 zeroconf-avahi-protocol-unspec
406 zeroconf-avahi-flags-unspec))
407 (elt (nth 9 result))) ;; TXT.
408 ;; The TXT field has the signature "aay". Transform to "as".
409 (while elt
410 (setcar elt (apply 'string (car elt)))
411 (setq elt (cdr elt)))
412
413 (when nil ;; We discard it, no use so far.
414 ;; Register a service resolver.
415 (let ((object-path (zeroconf-register-service-resolver name type)))
416 ;; Register the signals.
417 (dolist (member '("Found" "Failure"))
418 (dbus-register-signal
419 :system zeroconf-service-avahi object-path
420 zeroconf-interface-avahi-service-resolver member
421 'zeroconf-service-resolver-handler)))
422 )
423
424 ;; Return the resolved service.
425 (puthash key result zeroconf-resolved-services-hash))))))
426
427(defun zeroconf-service-interface (service)
428 "Return the internal interface number of SERVICE."
429 (nth 0 service))
430
431(defun zeroconf-service-protocol (service)
432 "Return the protocol number of SERVICE."
433 (nth 1 service))
434
435(defun zeroconf-service-name (service)
436 "Return the service name of SERVICE."
437 (nth 2 service))
438
439(defun zeroconf-service-type (service)
440 "Return the type name of SERVICE."
441 (nth 3 service))
442
443(defun zeroconf-service-domain (service)
444 "Return the domain name of SERVICE."
445 (nth 4 service))
446
447(defun zeroconf-service-flags (service)
448 "Return the flags of SERVICE."
449 (nth 5 service))
450
451(defun zeroconf-service-host (service)
452 "Return the host name of SERVICE."
453 (nth 5 (zeroconf-resolve-service service)))
454
455(defun zeroconf-service-aprotocol (service)
456 "Return the aprotocol number of SERVICE."
457 (nth 6 (zeroconf-resolve-service service)))
458
459(defun zeroconf-service-address (service)
460 "Return the IP address of SERVICE."
461 (nth 7 (zeroconf-resolve-service service)))
462
463(defun zeroconf-service-port (service)
464 "Return the port number of SERVICE."
465 (nth 8 (zeroconf-resolve-service service)))
466
467(defun zeroconf-service-txt (service)
468 "Return the text strings of SERVICE."
469 (nth 9 (zeroconf-resolve-service service)))
470
471\f
472;;; Services signalling.
473
474;; Register for the service type browser. Service registrations will
475;; happen in `zeroconf-service-type-browser-handler', when there is an
476;; "ItemNew" signal from the service type browser.
477(defun zeroconf-init (&optional domain)
478 "Instantiate an Avahi service type browser for domain DOMAIN.
479DOMAIN is a string, like \"dns-sd.org\" or \"local\". When
480DOMAIN is nil, the local domain is used."
481 (when (and (or (null domain) (stringp domain))
482 (dbus-ping :system zeroconf-service-avahi)
483 (dbus-call-method
484 :system zeroconf-service-avahi zeroconf-path-avahi
51768bc8 485 zeroconf-interface-avahi-server "GetVersionString"))
2e8cf9a7
MA
486
487 ;; Reset all stored values.
488 (setq zeroconf-path-avahi-service-type-browser nil
489 zeroconf-avahi-current-domain (or domain
490 zeroconf-avahi-domain-unspec))
491 (clrhash zeroconf-path-avahi-service-browser-hash)
492 (clrhash zeroconf-path-avahi-service-resolver-hash)
493 (clrhash zeroconf-services-hash)
494 (clrhash zeroconf-resolved-services-hash)
495 (clrhash zeroconf-service-added-hooks-hash)
496 (clrhash zeroconf-service-removed-hooks-hash)
497
498 ;; Register a service type browser.
499 (let ((object-path (zeroconf-register-service-type-browser)))
500 ;; Register the signals.
501 (dolist (member '("ItemNew" "ItemRemove" "Failure"))
502 (dbus-register-signal
503 :system zeroconf-service-avahi object-path
504 zeroconf-interface-avahi-service-type-browser member
505 'zeroconf-service-type-browser-handler)))
506
507 ;; Register state changed signal.
508 (dbus-register-signal
509 :system zeroconf-service-avahi zeroconf-path-avahi
510 zeroconf-interface-avahi-service-type-browser "StateChanged"
511 'zeroconf-service-type-browser-handler)))
512
513(defun zeroconf-register-service-type-browser ()
514 "Register a service type browser at the Avahi daemon."
515 (or zeroconf-path-avahi-service-type-browser
516 (setq zeroconf-path-avahi-service-type-browser
517 (dbus-call-method
518 :system zeroconf-service-avahi zeroconf-path-avahi
519 zeroconf-interface-avahi-server "ServiceTypeBrowserNew"
520 zeroconf-avahi-interface-unspec
521 zeroconf-avahi-protocol-unspec
522 zeroconf-avahi-current-domain
523 zeroconf-avahi-flags-unspec))))
524
525(defun zeroconf-service-type-browser-handler (&rest val)
526 "Registered service type browser handler at the Avahi daemon."
527 (when zeroconf-debug
528 (message "zeroconf-service-type-browser-handler: %s %S"
529 (dbus-event-member-name last-input-event) val))
530 (cond
531 ((string-equal (dbus-event-member-name last-input-event) "ItemNew")
532 ;; Parameters: (interface protocol type domain flags)
533 ;; Register a service browser.
534 (let ((object-path (zeroconf-register-service-browser (nth-value 2 val))))
535 ;; Register the signals.
536 (dolist (member '("ItemNew" "ItemRemove" "Failure"))
537 (dbus-register-signal
538 :system zeroconf-service-avahi object-path
539 zeroconf-interface-avahi-service-browser member
540 'zeroconf-service-browser-handler))))))
541
542(defun zeroconf-register-service-browser (type)
543 "Register a service browser at the Avahi daemon."
544 (or (gethash type zeroconf-path-avahi-service-browser-hash nil)
545 (puthash type
546 (dbus-call-method
547 :system zeroconf-service-avahi zeroconf-path-avahi
548 zeroconf-interface-avahi-server "ServiceBrowserNew"
549 zeroconf-avahi-interface-unspec
550 zeroconf-avahi-protocol-unspec
551 type
552 zeroconf-avahi-current-domain
553 zeroconf-avahi-flags-unspec)
554 zeroconf-path-avahi-service-browser-hash)))
555
556(defun zeroconf-service-browser-handler (&rest val)
557 "Registered service browser handler at the Avahi daemon."
558 ;; Parameters: (interface protocol name type domain flags)
559 (when zeroconf-debug
560 (message "zeroconf-service-browser-handler: %s %S"
561 (dbus-event-member-name last-input-event) val))
562 (let* ((name (zeroconf-service-name val))
563 (type (zeroconf-service-type val))
564 (key (concat name "/" type))
565 (ahook (gethash type zeroconf-service-added-hooks-hash nil))
566 (rhook (gethash type zeroconf-service-removed-hooks-hash nil)))
567 (cond
568 ((string-equal (dbus-event-member-name last-input-event) "ItemNew")
569 ;; Add new service.
570 (puthash key val zeroconf-services-hash)
571 (run-hook-with-args 'ahook val))
572
573 ((string-equal (dbus-event-member-name last-input-event) "ItemRemove")
574 ;; Remove the service.
575 (remhash key zeroconf-services-hash)
576 (remhash key zeroconf-resolved-services-hash)
577 (run-hook-with-args 'rhook val)))))
578
579(defun zeroconf-register-service-resolver (name type)
580 "Register a service resolver at the Avahi daemon."
581 (let ((key (concat name "/" type)))
582 (or (gethash key zeroconf-path-avahi-service-resolver-hash nil)
583 (puthash key
584 (dbus-call-method
585 :system zeroconf-service-avahi zeroconf-path-avahi
586 zeroconf-interface-avahi-server "ServiceResolverNew"
587 zeroconf-avahi-interface-unspec
588 zeroconf-avahi-protocol-unspec
589 name type
590 zeroconf-avahi-current-domain
591 zeroconf-avahi-protocol-unspec
592 zeroconf-avahi-flags-unspec)
593 zeroconf-resolved-services-hash))))
594
595(defun zeroconf-service-resolver-handler (&rest val)
596 "Registered service resolver handler at the Avahi daemon."
597 ;; Parameters: (interface protocol name type domain host aprotocol
598 ;; address port txt flags)
599 ;; The "TXT" field has the signature "aay". Transform to "as".
600 (let ((elt (nth 9 val)))
601 (while elt
602 (setcar elt (apply 'string (car elt)))
603 (setq elt (cdr elt))))
604 (when zeroconf-debug
605 (message "zeroconf-service-resolver-handler: %s %S"
606 (dbus-event-member-name last-input-event) val))
607 (cond
608 ;; A new service has been detected. Add it to
609 ;; `zeroconf-resolved-services-hash'.
610 ((string-equal (dbus-event-member-name last-input-event) "Found")
611 (puthash
612 (concat (zeroconf-service-name val) "/" (zeroconf-service-type val))
613 val zeroconf-resolved-services-hash))))
614
615\f
616;;; Services publishing.
617
618(defun zeroconf-publish-service (name type domain host port address txt)
619 "Publish a service at the Avahi daemon.
620For the description of arguments, see `zeroconf-resolved-services-hash'."
621 ;; NAME and TYPE must not be empty.
622 (when (zerop (length name))
623 (error "Invalid argument NAME: %s" name))
624 (when (zerop (length type))
625 (error "Invalid argument TYPE: %s" type))
626
627 ;; Set default values for DOMAIN, HOST and PORT.
628 (when (zerop (length domain))
629 (setq domain (zeroconf-get-domain)))
630 (when (zerop (length host))
631 (setq host (zeroconf-get-host-domain)))
632 (when (null port)
633 (setq port 0))
634
635 ;; Create an entry in the daemon.
636 (let ((object-path
637 (dbus-call-method
638 :system zeroconf-service-avahi zeroconf-path-avahi
639 zeroconf-interface-avahi-server "EntryGroupNew"))
640 result)
641
642 ;; The TXT field has the signature "as". Transform to "aay".
643 (dolist (elt txt)
644 (let (args)
645 (add-to-list
646 'result
647 (dolist (elt1 (string-to-list elt) (append '(:array) args))
648 (setq args (append args (list :byte elt1)))))))
649
650 ;; Add the service.
651 (dbus-call-method
652 :system zeroconf-service-avahi object-path
653 zeroconf-interface-avahi-entry-group "AddService"
654 zeroconf-avahi-interface-unspec
655 zeroconf-avahi-protocol-unspec
656 zeroconf-avahi-flags-unspec
657 name type domain host :uint16 port (append '(:array) result))
658
659 ;; Add the address.
660 (unless (zerop (length address))
661 (dbus-call-method
662 :system zeroconf-service-avahi object-path
663 zeroconf-interface-avahi-entry-group "AddAddress"
664 zeroconf-avahi-interface-unspec
665 zeroconf-avahi-protocol-unspec
666 zeroconf-avahi-flags-unspec
667 host address))
668
669 ;; Make it persistent in the daemon.
670 (dbus-call-method
671 :system zeroconf-service-avahi object-path
672 zeroconf-interface-avahi-entry-group "Commit")))
673
674(provide 'zeroconf)
dc6ee347
MB
675
676;; arch-tag: ea578165-7fa8-44f4-90f0-de3940aec69f
2e8cf9a7 677;;; zeroconf.el ends here