summaryrefslogtreecommitdiff
path: root/lisp/net/zeroconf.el
diff options
context:
space:
mode:
authorMichael Albinus <michael.albinus@gmx.de>2008-04-08 19:56:20 +0000
committerMichael Albinus <michael.albinus@gmx.de>2008-04-08 19:56:20 +0000
commit2e8cf9a72071b2a88a307e60315cd1c87832a3b7 (patch)
treea4476c5bd4da615c8e41a3dc552bd4a36bde7bd2 /lisp/net/zeroconf.el
parent074a226b428e67624b59e7169d875846ddbf1c40 (diff)
downloademacs-2e8cf9a72071b2a88a307e60315cd1c87832a3b7.tar.gz
* net/zeroconf.el: New file.
Diffstat (limited to 'lisp/net/zeroconf.el')
-rw-r--r--lisp/net/zeroconf.el675
1 files changed, 675 insertions, 0 deletions
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
new file mode 100644
index 00000000000..9bd63c1ee10
--- /dev/null
+++ b/lisp/net/zeroconf.el
@@ -0,0 +1,675 @@
+;;; zeroconf.el --- Service browser using Avahi.
+
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, hardware
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides an interface to the Avahi, the zeroconf
+;; daemon under GNU/Linux. The communication mean with Avahi is
+;; D-Bus.
+
+;; In order to activate this package, you must add the following code
+;; into your .emacs:
+
+;; (require 'zeroconf)
+;; (zeroconf-init "dns-sd.org")
+
+;; "dns-sd.org" is an example the domain you wish to resolve services
+;; for. It can also be nil or "", which means the default local
+;; domain "local".
+
+;; The `zeroconf-init' function installs several handlers, which are
+;; activated by D-Bus signals sent from the Avahi daemon.
+;; Immediately, when a service is added or removed in the domain, a
+;; corresponding handler in Emacs is called.
+
+;; Service Discovery
+;; -----------------
+
+;; The main purpose of zeroconf is service discovery. This means,
+;; that services are detected as soon as they appear or disappear in a
+;; given domain. A service is offered by a network device. It is
+;; assigned to a service type.
+
+;; In order to see all offered service types of the initialized
+;; domain, you can call
+
+;; (zeroconf-list-service-types)
+
+;; Service types are described at <http://www.dns-sd.org/ServiceTypes.html>.
+;; Detected services for a given service type, let's say "_ipp._tcp",
+;; are listed by
+
+;; (zeroconf-list-services "_ipp._tcp")
+
+;; It is possible to register an own handler (function) to be called
+;; when a service has been added or removed in the domain. The
+;; service type "_ipp._tcp" is used for printer services supporting
+;; the Internet Printing Protocol.
+
+;; (defun my-add-printer (service)
+;; (message "Printer `%s' detected" (zeroconf-service-name service)))
+
+;; (defun my-remove-printer (service)
+;; (message "Printer `%s' removed" (zeroconf-service-name service)))
+
+;; (zeroconf-service-add-hook "_ipp._tcp" :new 'my-add-printer)
+;; (zeroconf-service-add-hook "_ipp._tcp" :removed 'my-remove-printer)
+
+;; There are several functions returning information about a service,
+;; see the doc string of `zeroconf-service-add-hook'.
+
+;; Service Publishing
+;; ------------------
+
+;; The function `zeroconf-publish-service' publishes a new service to
+;; the Avahi daemon. Although the domain, where to the service is
+;; published, can be specified by this function, it is usally the
+;; default domain "local" (also written as nil or "").
+
+;; (zeroconf-publish-service
+;; "Example service" ;; Service name.
+;; "_example._tcp" ;; Service type.
+;; nil ;; Default domain ("local").
+;; nil ;; Default host (concat (getenv "HOST") ".local").
+;; 111 ;; Port number of the host, the service is offered.
+;; "1.2.3.4" ;; IPv4 address of the host.
+;; '("version=1.0" ;; TXT fields describing the service.
+;; "abc=456"))
+
+;; The lifetime of a published service is the lifetime of Emacs.
+
+;;; Code:
+
+;; Pacify byte-compiler. D-Bus support in the Emacs core can be
+;; disabled with configuration option "--without-dbus". Declare used
+;; subroutines and variables of `dbus' therefore.
+(eval-when-compile
+ (require 'cl)
+ (declare-function dbus-call-method "dbusbind.c")
+ (declare-function dbus-register-signal "dbusbind.c")
+ (defvar dbus-debug))
+
+(require 'dbus)
+
+(defvar zeroconf-debug nil
+ "Write messages during service discovery")
+
+(defconst zeroconf-service-avahi "org.freedesktop.Avahi"
+ "The D-Bus name used to talk to Avahi.")
+
+(defconst zeroconf-path-avahi "/"
+ "The D-Bus root object path used to talk to Avahi.")
+
+(defvar zeroconf-path-avahi-service-type-browser nil
+ "The D-Bus object path used to talk to the Avahi service type browser.")
+
+(defvar zeroconf-path-avahi-service-browser-hash (make-hash-table :test 'equal)
+ "The D-Bus object paths used to talk to the Avahi service browser.")
+
+(defvar zeroconf-path-avahi-service-resolver-hash (make-hash-table :test 'equal)
+ "The D-Bus object paths used to talk to the Avahi service resolver.")
+
+;; Methods: "Free", "Commit", "Reset", "GetState", "IsEmpty",
+;; "AddService", "AddServiceSubtype", "UpdateServiceTxt", "AddAddress"
+;; and "AddRecord".
+;; Signals: "StateChanged".
+(defconst zeroconf-interface-avahi-entry-group
+ (concat zeroconf-service-avahi ".EntryGroup")
+ "The D-Bus entry group interface exported by Avahi.")
+
+;; Methods: "GetVersionString", "GetAPIVersion", "GetHostName",
+;; "SetHostName", "GetHostNameFqdn", "GetDomainName",
+;; "IsNSSSupportAvailable", "GetState", "GetLocalServiceCookie",
+;; "GetAlternativeHostName", "GetAlternativeServiceName",
+;; "GetNetworkInterfaceNameByIndex", "GetNetworkInterfaceIndexByName",
+;; "ResolveHostName", "ResolveAddress", "ResolveService",
+;; "EntryGroupNew", "DomainBrowserNew", "ServiceTypeBrowserNew",
+;; "ServiceBrowserNew", "ServiceResolverNew", "HostNameResolverNew",
+;; "AddressResolverNew" and "RecordBrowserNew".
+;; Signals: "StateChanged".
+(defconst zeroconf-interface-avahi-server
+ (concat zeroconf-service-avahi ".Server")
+ "The D-Bus server interface exported by Avahi.")
+
+;; Methods: "Free".
+;; Signals: "ItemNew", "ItemRemove", "CacheExhausted", "AllForNow" and
+;; "Failure".
+(defconst zeroconf-interface-avahi-service-type-browser
+ (concat zeroconf-service-avahi ".ServiceTypeBrowser")
+ "The D-Bus service type browser interface exported by Avahi.")
+
+;; Methods: "Free".
+;; Signals: "ItemNew", "ItemRemove", "CacheExhausted", "AllForNow" and
+;; "Failure".
+(defconst zeroconf-interface-avahi-service-browser
+ (concat zeroconf-service-avahi ".ServiceBrowser")
+ "The D-Bus service browser interface exported by Avahi.")
+
+;; Methods: "Free".
+;; Available signals are "Found" and "Failure".
+(defconst zeroconf-interface-avahi-service-resolver
+ (concat zeroconf-service-avahi ".ServiceResolver")
+ "The D-Bus service resolver interface exported by Avahi.")
+
+(defconst zeroconf-avahi-interface-unspec -1
+ "Wildcard Avahi interface spec.")
+
+(defconst zeroconf-avahi-protocol-unspec -1
+ "Wildcard Avahi protocol spec.")
+
+(defconst zeroconf-avahi-protocol-inet4 0
+ "Avahi INET4 address protocol family.")
+
+(defconst zeroconf-avahi-protocol-inet6 1
+ "Avahi INET6 address protocol family.")
+
+(defconst zeroconf-avahi-domain-unspec ""
+ "Empty Avahi domain.")
+
+(defvar zeroconf-avahi-current-domain zeroconf-avahi-domain-unspec
+ "Domain name services are resolved for.")
+
+(defconst zeroconf-avahi-flags-unspec 0
+ "No Avahi flags.")
+
+
+;;; Services retrieval.
+
+(defvar zeroconf-services-hash (make-hash-table :test 'equal)
+ "Hash table of discovered Avahi services.
+
+The key of an entry is the concatenation of the service name and
+service type of a discovered service. The value is the service
+itself. The format of a service is
+
+ \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\)
+
+The INTERFACE is a number, which represents the network interface
+the service is located at. The corresponding network interface
+name, like \"eth0\", can be retrieved with the function
+`zeroconf-get-interface-name'.
+
+PROTOCOL describes the used network protocol family the service
+can be accessed. `zeroconf-avahi-protocol-inet4' means INET4,
+`zeroconf-avahi-protocol-inet6' means INET6. An unspecified
+protocol family is coded with `zeroconf-avahi-protocol-unspec'.
+
+NAME is the string the service is known at Avahi. A service can
+be known under the same name for different service types.
+
+Each TYPE stands for a discovered service type of Avahi. The
+format is described in RFC 2782. It is of the form
+
+ \"_APPLICATION-PROTOCOL._TRANSPORT-PROTOCOL\".
+
+TRANSPORT-PROTOCOL must be either \"tcp\" or \"udp\".
+APPLICATION-PROTOCOL must be a protocol name as specified in URL
+`http://www.dns-sd.org/ServiceTypes.html'. Typical service types
+are \"_workstation._tcp\" or \"_printer._tcp\".
+
+DOMAIN is the domain name the service is registered in, like \"local\".
+
+FLAGS, an integer, is used inside Avahi. When publishing a
+service (see `zeroconf-publish-service', the flag 0 is used.")
+
+(defvar zeroconf-resolved-services-hash (make-hash-table :test 'equal)
+ "Hash table of resolved Avahi services.
+The key of an entry is the concatenation of the service name and
+service type of a resolved service. The value is the service
+itself. The format of a service is
+
+ \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\)
+
+INTERFACE, PROTOCOL, NAME, TYPE, DOMAIN and FLAGS have the same
+meaning as in `zeroconf-services-hash'.
+
+HOST is the host name the service is registered. It is a fully
+qualified name, i.e., it contains DOMAIN.
+
+APROTOCOL stands for the network protocol family ADDRESS is
+encoded (`zeroconf-avahi-protocol-inet4' means INET4,
+`zeroconf-avahi-protocol-inet6' means INET6). It can be
+different from PROTOCOL, when an adrress resolution has been
+requested for another protocol family but the default one.
+
+ADDRESS is the service address, encoded according to the
+APROTOCOL network protocol family. PORT is the corresponding
+port the service can be reached on ADDRESS.
+
+TXT is an array of strings, describing additional attributes of
+the service. Usually, every string is a key=value pair. The
+supported keys depend on the service type.")
+
+(defun zeroconf-list-service-names ()
+ "Returns all discovered Avahi service names as list."
+ (let (result)
+ (maphash
+ (lambda (key value) (add-to-list 'result (zeroconf-service-name value)))
+ zeroconf-services-hash)
+ result))
+
+(defun zeroconf-list-service-types ()
+ "Returns all discovered Avahi service types as list."
+ (let (result)
+ (maphash
+ (lambda (key value) (add-to-list 'result (zeroconf-service-type value)))
+ zeroconf-services-hash)
+ result))
+
+(defun zeroconf-list-services (type)
+ "Returns all discovered Avahi services for a given service type TYPE.
+The service type is one of the returned values of
+`zeroconf-list-service-types'. The return value is a list
+\(SERVICE1 SERVICE2 ...\). See `zeroconf-services-hash' for the
+format of SERVICE."
+ (let (result)
+ (maphash
+ (lambda (key value)
+ (when (equal type (zeroconf-service-type value))
+ (add-to-list 'result value)))
+ zeroconf-services-hash)
+ result))
+
+(defvar zeroconf-service-added-hooks-hash (make-hash-table :test 'equal)
+ "Hash table of hooks for newly added services.
+The key of an entry is a service type.")
+
+(defvar zeroconf-service-removed-hooks-hash (make-hash-table :test 'equal)
+ "Hash table of hooks for removed services.
+The key of an entry is a service type.")
+
+(defun zeroconf-service-add-hook (type event function)
+ "Add FUNCTION to the hook of service type TYPE.
+
+EVENT must be either :new or :removed, indicating whether
+FUNCTION shall be called when a new service has been newly
+detected, or removed.
+
+FUNCTION must accept one argument SERVICE, which identifies the
+new service. Initially, when EVENT is :new, FUNCTION is called
+for all already detected services of service type TYPE.
+
+The attributes of SERVICE can be retrieved via the functions
+
+ `zeroconf-service-interface'
+ `zeroconf-service-protocol'
+ `zeroconf-service-name'
+ `zeroconf-service-type'
+ `zeroconf-service-domain'
+ `zeroconf-service-flags'
+ `zeroconf-service-host'
+ `zeroconf-service-aprotocol'
+ `zeroconf-service-address'
+ `zeroconf-service-port'
+ `zeroconf-service-txt'"
+
+ (cond
+ ((equal event :new)
+ (let ((l-hook (gethash type zeroconf-service-added-hooks-hash nil)))
+ (add-hook 'l-hook function)
+ (puthash type l-hook zeroconf-service-added-hooks-hash)
+ (dolist (service (zeroconf-list-services type))
+ (funcall function service))))
+ ((equal event :removed)
+ (let ((l-hook (gethash type zeroconf-service-removed-hooks-hash nil)))
+ (add-hook 'l-hook function)
+ (puthash type l-hook zeroconf-service-removed-hooks-hash)))
+ (t (error "EVENT must be either `:new' or `:removed'."))))
+
+(defun zeroconf-get-host ()
+ "Returns the local host name as string."
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "GetHostName"))
+
+(defun zeroconf-get-domain ()
+ "Returns the domain name as string."
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "GetDomainName"))
+
+(defun zeroconf-get-host-domain ()
+ "Returns the local host name FQDN as string."
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "GetHostNameFqdn"))
+
+(defun zeroconf-get-interface-name (number)
+ "Return the interface name of internal interface NUMBER."
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "GetNetworkInterfaceNameByIndex"
+ :int32 number))
+
+(defun zeroconf-get-interface-number (name)
+ "Return the internal interface number of interface NAME."
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "GetNetworkInterfaceIndexByName"
+ name))
+
+(defun zeroconf-get-service (name type)
+ "Return the service description of service NAME as list.
+NAME must be a string. The service must be of service type
+TYPE. The resulting list has the format
+
+ \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\)."
+ ;; Due to the service browser, all known services are kept in
+ ;; `zeroconf-services-hash'.
+ (gethash (concat name "/" type) zeroconf-services-hash nil))
+
+(defun zeroconf-resolve-service (service)
+ "Return all service attributes SERVICE as list.
+NAME must be a string. The service must be of service type
+TYPE. The resulting list has the format
+
+ \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\)."
+ (let* ((name (zeroconf-service-name service))
+ (type (zeroconf-service-type service))
+ (key (concat name "/" type)))
+
+ (or
+ ;; Check whether we know this service already.
+ (gethash key zeroconf-resolved-services-hash nil)
+
+ ;; Resolve the service. We don't propagate D-Bus errors.
+ (dbus-ignore-errors
+ (let* ((result
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "ResolveService"
+ zeroconf-avahi-interface-unspec
+ zeroconf-avahi-protocol-unspec
+ name type
+ zeroconf-avahi-current-domain
+ zeroconf-avahi-protocol-unspec
+ zeroconf-avahi-flags-unspec))
+ (elt (nth 9 result))) ;; TXT.
+ ;; The TXT field has the signature "aay". Transform to "as".
+ (while elt
+ (setcar elt (apply 'string (car elt)))
+ (setq elt (cdr elt)))
+
+ (when nil ;; We discard it, no use so far.
+ ;; Register a service resolver.
+ (let ((object-path (zeroconf-register-service-resolver name type)))
+ ;; Register the signals.
+ (dolist (member '("Found" "Failure"))
+ (dbus-register-signal
+ :system zeroconf-service-avahi object-path
+ zeroconf-interface-avahi-service-resolver member
+ 'zeroconf-service-resolver-handler)))
+ )
+
+ ;; Return the resolved service.
+ (puthash key result zeroconf-resolved-services-hash))))))
+
+(defun zeroconf-service-interface (service)
+ "Return the internal interface number of SERVICE."
+ (nth 0 service))
+
+(defun zeroconf-service-protocol (service)
+ "Return the protocol number of SERVICE."
+ (nth 1 service))
+
+(defun zeroconf-service-name (service)
+ "Return the service name of SERVICE."
+ (nth 2 service))
+
+(defun zeroconf-service-type (service)
+ "Return the type name of SERVICE."
+ (nth 3 service))
+
+(defun zeroconf-service-domain (service)
+ "Return the domain name of SERVICE."
+ (nth 4 service))
+
+(defun zeroconf-service-flags (service)
+ "Return the flags of SERVICE."
+ (nth 5 service))
+
+(defun zeroconf-service-host (service)
+ "Return the host name of SERVICE."
+ (nth 5 (zeroconf-resolve-service service)))
+
+(defun zeroconf-service-aprotocol (service)
+ "Return the aprotocol number of SERVICE."
+ (nth 6 (zeroconf-resolve-service service)))
+
+(defun zeroconf-service-address (service)
+ "Return the IP address of SERVICE."
+ (nth 7 (zeroconf-resolve-service service)))
+
+(defun zeroconf-service-port (service)
+ "Return the port number of SERVICE."
+ (nth 8 (zeroconf-resolve-service service)))
+
+(defun zeroconf-service-txt (service)
+ "Return the text strings of SERVICE."
+ (nth 9 (zeroconf-resolve-service service)))
+
+
+;;; Services signalling.
+
+;; Register for the service type browser. Service registrations will
+;; happen in `zeroconf-service-type-browser-handler', when there is an
+;; "ItemNew" signal from the service type browser.
+(defun zeroconf-init (&optional domain)
+ "Instantiate an Avahi service type browser for domain DOMAIN.
+DOMAIN is a string, like \"dns-sd.org\" or \"local\". When
+DOMAIN is nil, the local domain is used."
+ (when (and (or (null domain) (stringp domain))
+ (dbus-ping :system zeroconf-service-avahi)
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "IsNSSSupportAvailable"))
+
+ ;; Reset all stored values.
+ (setq zeroconf-path-avahi-service-type-browser nil
+ zeroconf-avahi-current-domain (or domain
+ zeroconf-avahi-domain-unspec))
+ (clrhash zeroconf-path-avahi-service-browser-hash)
+ (clrhash zeroconf-path-avahi-service-resolver-hash)
+ (clrhash zeroconf-services-hash)
+ (clrhash zeroconf-resolved-services-hash)
+ (clrhash zeroconf-service-added-hooks-hash)
+ (clrhash zeroconf-service-removed-hooks-hash)
+
+ ;; Register a service type browser.
+ (let ((object-path (zeroconf-register-service-type-browser)))
+ ;; Register the signals.
+ (dolist (member '("ItemNew" "ItemRemove" "Failure"))
+ (dbus-register-signal
+ :system zeroconf-service-avahi object-path
+ zeroconf-interface-avahi-service-type-browser member
+ 'zeroconf-service-type-browser-handler)))
+
+ ;; Register state changed signal.
+ (dbus-register-signal
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-service-type-browser "StateChanged"
+ 'zeroconf-service-type-browser-handler)))
+
+(defun zeroconf-register-service-type-browser ()
+ "Register a service type browser at the Avahi daemon."
+ (or zeroconf-path-avahi-service-type-browser
+ (setq zeroconf-path-avahi-service-type-browser
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "ServiceTypeBrowserNew"
+ zeroconf-avahi-interface-unspec
+ zeroconf-avahi-protocol-unspec
+ zeroconf-avahi-current-domain
+ zeroconf-avahi-flags-unspec))))
+
+(defun zeroconf-service-type-browser-handler (&rest val)
+ "Registered service type browser handler at the Avahi daemon."
+ (when zeroconf-debug
+ (message "zeroconf-service-type-browser-handler: %s %S"
+ (dbus-event-member-name last-input-event) val))
+ (cond
+ ((string-equal (dbus-event-member-name last-input-event) "ItemNew")
+ ;; Parameters: (interface protocol type domain flags)
+ ;; Register a service browser.
+ (let ((object-path (zeroconf-register-service-browser (nth-value 2 val))))
+ ;; Register the signals.
+ (dolist (member '("ItemNew" "ItemRemove" "Failure"))
+ (dbus-register-signal
+ :system zeroconf-service-avahi object-path
+ zeroconf-interface-avahi-service-browser member
+ 'zeroconf-service-browser-handler))))))
+
+(defun zeroconf-register-service-browser (type)
+ "Register a service browser at the Avahi daemon."
+ (or (gethash type zeroconf-path-avahi-service-browser-hash nil)
+ (puthash type
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "ServiceBrowserNew"
+ zeroconf-avahi-interface-unspec
+ zeroconf-avahi-protocol-unspec
+ type
+ zeroconf-avahi-current-domain
+ zeroconf-avahi-flags-unspec)
+ zeroconf-path-avahi-service-browser-hash)))
+
+(defun zeroconf-service-browser-handler (&rest val)
+ "Registered service browser handler at the Avahi daemon."
+ ;; Parameters: (interface protocol name type domain flags)
+ (when zeroconf-debug
+ (message "zeroconf-service-browser-handler: %s %S"
+ (dbus-event-member-name last-input-event) val))
+ (let* ((name (zeroconf-service-name val))
+ (type (zeroconf-service-type val))
+ (key (concat name "/" type))
+ (ahook (gethash type zeroconf-service-added-hooks-hash nil))
+ (rhook (gethash type zeroconf-service-removed-hooks-hash nil)))
+ (cond
+ ((string-equal (dbus-event-member-name last-input-event) "ItemNew")
+ ;; Add new service.
+ (puthash key val zeroconf-services-hash)
+ (run-hook-with-args 'ahook val))
+
+ ((string-equal (dbus-event-member-name last-input-event) "ItemRemove")
+ ;; Remove the service.
+ (remhash key zeroconf-services-hash)
+ (remhash key zeroconf-resolved-services-hash)
+ (run-hook-with-args 'rhook val)))))
+
+(defun zeroconf-register-service-resolver (name type)
+ "Register a service resolver at the Avahi daemon."
+ (let ((key (concat name "/" type)))
+ (or (gethash key zeroconf-path-avahi-service-resolver-hash nil)
+ (puthash key
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "ServiceResolverNew"
+ zeroconf-avahi-interface-unspec
+ zeroconf-avahi-protocol-unspec
+ name type
+ zeroconf-avahi-current-domain
+ zeroconf-avahi-protocol-unspec
+ zeroconf-avahi-flags-unspec)
+ zeroconf-resolved-services-hash))))
+
+(defun zeroconf-service-resolver-handler (&rest val)
+ "Registered service resolver handler at the Avahi daemon."
+ ;; Parameters: (interface protocol name type domain host aprotocol
+ ;; address port txt flags)
+ ;; The "TXT" field has the signature "aay". Transform to "as".
+ (let ((elt (nth 9 val)))
+ (while elt
+ (setcar elt (apply 'string (car elt)))
+ (setq elt (cdr elt))))
+ (when zeroconf-debug
+ (message "zeroconf-service-resolver-handler: %s %S"
+ (dbus-event-member-name last-input-event) val))
+ (cond
+ ;; A new service has been detected. Add it to
+ ;; `zeroconf-resolved-services-hash'.
+ ((string-equal (dbus-event-member-name last-input-event) "Found")
+ (puthash
+ (concat (zeroconf-service-name val) "/" (zeroconf-service-type val))
+ val zeroconf-resolved-services-hash))))
+
+
+;;; Services publishing.
+
+(defun zeroconf-publish-service (name type domain host port address txt)
+ "Publish a service at the Avahi daemon.
+For the description of arguments, see `zeroconf-resolved-services-hash'."
+ ;; NAME and TYPE must not be empty.
+ (when (zerop (length name))
+ (error "Invalid argument NAME: %s" name))
+ (when (zerop (length type))
+ (error "Invalid argument TYPE: %s" type))
+
+ ;; Set default values for DOMAIN, HOST and PORT.
+ (when (zerop (length domain))
+ (setq domain (zeroconf-get-domain)))
+ (when (zerop (length host))
+ (setq host (zeroconf-get-host-domain)))
+ (when (null port)
+ (setq port 0))
+
+ ;; Create an entry in the daemon.
+ (let ((object-path
+ (dbus-call-method
+ :system zeroconf-service-avahi zeroconf-path-avahi
+ zeroconf-interface-avahi-server "EntryGroupNew"))
+ result)
+
+ ;; The TXT field has the signature "as". Transform to "aay".
+ (dolist (elt txt)
+ (let (args)
+ (add-to-list
+ 'result
+ (dolist (elt1 (string-to-list elt) (append '(:array) args))
+ (setq args (append args (list :byte elt1)))))))
+
+ ;; Add the service.
+ (dbus-call-method
+ :system zeroconf-service-avahi object-path
+ zeroconf-interface-avahi-entry-group "AddService"
+ zeroconf-avahi-interface-unspec
+ zeroconf-avahi-protocol-unspec
+ zeroconf-avahi-flags-unspec
+ name type domain host :uint16 port (append '(:array) result))
+
+ ;; Add the address.
+ (unless (zerop (length address))
+ (dbus-call-method
+ :system zeroconf-service-avahi object-path
+ zeroconf-interface-avahi-entry-group "AddAddress"
+ zeroconf-avahi-interface-unspec
+ zeroconf-avahi-protocol-unspec
+ zeroconf-avahi-flags-unspec
+ host address))
+
+ ;; Make it persistent in the daemon.
+ (dbus-call-method
+ :system zeroconf-service-avahi object-path
+ zeroconf-interface-avahi-entry-group "Commit")))
+
+(provide 'zeroconf)
+;;; zeroconf.el ends here