Convert consecutive FSF copyright years to ranges.
[bpt/emacs.git] / lisp / net / zeroconf.el
CommitLineData
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
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 338
112dbc0e
MA
339(defun zeroconf-service-remove-hook (type event function)
340 "Remove FUNCTION from the hook of service type TYPE.
341
342EVENT must be either :new or :removed and has to match the event
343type 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.
390NAME must be a string. The service must be of service type
391TYPE. 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.
400NAME must be a string. The service must be of service type
401TYPE. 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.
496DOMAIN is a string, like \"dns-sd.org\" or \"local\". When
497DOMAIN 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.
637For 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