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