diff options
| author | Michael Albinus | 2008-04-08 19:56:20 +0000 |
|---|---|---|
| committer | Michael Albinus | 2008-04-08 19:56:20 +0000 |
| commit | 2e8cf9a72071b2a88a307e60315cd1c87832a3b7 (patch) | |
| tree | a4476c5bd4da615c8e41a3dc552bd4a36bde7bd2 | |
| parent | 074a226b428e67624b59e7169d875846ddbf1c40 (diff) | |
| download | emacs-2e8cf9a72071b2a88a307e60315cd1c87832a3b7.tar.gz emacs-2e8cf9a72071b2a88a307e60315cd1c87832a3b7.zip | |
* net/zeroconf.el: New file.
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/net/zeroconf.el | 675 |
2 files changed, 682 insertions, 0 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3e2ed4e2e00..b87ec1179f6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2008-04-08 Michael Albinus <michael.albinus@gmx.de> | ||
| 2 | |||
| 3 | * ps-samp.el (ps-add-printer, ps-remove-printer) | ||
| 4 | (ps-make-dynamic-printer-menu): New functions. | ||
| 5 | |||
| 6 | * net/zeroconf.el: New file. | ||
| 7 | |||
| 1 | 2008-04-08 Stefan Monnier <monnier@iro.umontreal.ca> | 8 | 2008-04-08 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 9 | ||
| 3 | * calendar/cal-hebrew.el (calendar-hebrew-list-yahrzeits): Typo. | 10 | * calendar/cal-hebrew.el (calendar-hebrew-list-yahrzeits): Typo. |
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 @@ | |||
| 1 | ;;; zeroconf.el --- Service browser using Avahi. | ||
| 2 | |||
| 3 | ;; Copyright (C) 2008 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, or (at your option) | ||
| 13 | ;; 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; see the file COPYING. If not, see | ||
| 22 | ;; <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; This package provides an interface to the Avahi, the zeroconf | ||
| 27 | ;; daemon under GNU/Linux. The communication mean with Avahi is | ||
| 28 | ;; D-Bus. | ||
| 29 | |||
| 30 | ;; In order to activate this package, you must add the following code | ||
| 31 | ;; into your .emacs: | ||
| 32 | |||
| 33 | ;; (require 'zeroconf) | ||
| 34 | ;; (zeroconf-init "dns-sd.org") | ||
| 35 | |||
| 36 | ;; "dns-sd.org" is an example the domain you wish to resolve services | ||
| 37 | ;; for. It can also be nil or "", which means the default local | ||
| 38 | ;; domain "local". | ||
| 39 | |||
| 40 | ;; The `zeroconf-init' function installs several handlers, which are | ||
| 41 | ;; activated by D-Bus signals sent from the Avahi daemon. | ||
| 42 | ;; Immediately, when a service is added or removed in the domain, a | ||
| 43 | ;; corresponding handler in Emacs is called. | ||
| 44 | |||
| 45 | ;; Service Discovery | ||
| 46 | ;; ----------------- | ||
| 47 | |||
| 48 | ;; The main purpose of zeroconf is service discovery. This means, | ||
| 49 | ;; that services are detected as soon as they appear or disappear in a | ||
| 50 | ;; given domain. A service is offered by a network device. It is | ||
| 51 | ;; assigned to a service type. | ||
| 52 | |||
| 53 | ;; In order to see all offered service types of the initialized | ||
| 54 | ;; domain, you can call | ||
| 55 | |||
| 56 | ;; (zeroconf-list-service-types) | ||
| 57 | |||
| 58 | ;; Service types are described at <http://www.dns-sd.org/ServiceTypes.html>. | ||
| 59 | ;; Detected services for a given service type, let's say "_ipp._tcp", | ||
| 60 | ;; are listed by | ||
| 61 | |||
| 62 | ;; (zeroconf-list-services "_ipp._tcp") | ||
| 63 | |||
| 64 | ;; It is possible to register an own handler (function) to be called | ||
| 65 | ;; when a service has been added or removed in the domain. The | ||
| 66 | ;; service type "_ipp._tcp" is used for printer services supporting | ||
| 67 | ;; the Internet Printing Protocol. | ||
| 68 | |||
| 69 | ;; (defun my-add-printer (service) | ||
| 70 | ;; (message "Printer `%s' detected" (zeroconf-service-name service))) | ||
| 71 | |||
| 72 | ;; (defun my-remove-printer (service) | ||
| 73 | ;; (message "Printer `%s' removed" (zeroconf-service-name service))) | ||
| 74 | |||
| 75 | ;; (zeroconf-service-add-hook "_ipp._tcp" :new 'my-add-printer) | ||
| 76 | ;; (zeroconf-service-add-hook "_ipp._tcp" :removed 'my-remove-printer) | ||
| 77 | |||
| 78 | ;; There are several functions returning information about a service, | ||
| 79 | ;; see the doc string of `zeroconf-service-add-hook'. | ||
| 80 | |||
| 81 | ;; Service Publishing | ||
| 82 | ;; ------------------ | ||
| 83 | |||
| 84 | ;; The function `zeroconf-publish-service' publishes a new service to | ||
| 85 | ;; the Avahi daemon. Although the domain, where to the service is | ||
| 86 | ;; published, can be specified by this function, it is usally the | ||
| 87 | ;; default domain "local" (also written as nil or ""). | ||
| 88 | |||
| 89 | ;; (zeroconf-publish-service | ||
| 90 | ;; "Example service" ;; Service name. | ||
| 91 | ;; "_example._tcp" ;; Service type. | ||
| 92 | ;; nil ;; Default domain ("local"). | ||
| 93 | ;; nil ;; Default host (concat (getenv "HOST") ".local"). | ||
| 94 | ;; 111 ;; Port number of the host, the service is offered. | ||
| 95 | ;; "1.2.3.4" ;; IPv4 address of the host. | ||
| 96 | ;; '("version=1.0" ;; TXT fields describing the service. | ||
| 97 | ;; "abc=456")) | ||
| 98 | |||
| 99 | ;; The lifetime of a published service is the lifetime of Emacs. | ||
| 100 | |||
| 101 | ;;; Code: | ||
| 102 | |||
| 103 | ;; Pacify byte-compiler. D-Bus support in the Emacs core can be | ||
| 104 | ;; disabled with configuration option "--without-dbus". Declare used | ||
| 105 | ;; subroutines and variables of `dbus' therefore. | ||
| 106 | (eval-when-compile | ||
| 107 | (require 'cl) | ||
| 108 | (declare-function dbus-call-method "dbusbind.c") | ||
| 109 | (declare-function dbus-register-signal "dbusbind.c") | ||
| 110 | (defvar dbus-debug)) | ||
| 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 | |||
| 196 | ;;; Services retrieval. | ||
| 197 | |||
| 198 | (defvar zeroconf-services-hash (make-hash-table :test 'equal) | ||
| 199 | "Hash table of discovered Avahi services. | ||
| 200 | |||
| 201 | The key of an entry is the concatenation of the service name and | ||
| 202 | service type of a discovered service. The value is the service | ||
| 203 | itself. The format of a service is | ||
| 204 | |||
| 205 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\) | ||
| 206 | |||
| 207 | The INTERFACE is a number, which represents the network interface | ||
| 208 | the service is located at. The corresponding network interface | ||
| 209 | name, like \"eth0\", can be retrieved with the function | ||
| 210 | `zeroconf-get-interface-name'. | ||
| 211 | |||
| 212 | PROTOCOL describes the used network protocol family the service | ||
| 213 | can be accessed. `zeroconf-avahi-protocol-inet4' means INET4, | ||
| 214 | `zeroconf-avahi-protocol-inet6' means INET6. An unspecified | ||
| 215 | protocol family is coded with `zeroconf-avahi-protocol-unspec'. | ||
| 216 | |||
| 217 | NAME is the string the service is known at Avahi. A service can | ||
| 218 | be known under the same name for different service types. | ||
| 219 | |||
| 220 | Each TYPE stands for a discovered service type of Avahi. The | ||
| 221 | format is described in RFC 2782. It is of the form | ||
| 222 | |||
| 223 | \"_APPLICATION-PROTOCOL._TRANSPORT-PROTOCOL\". | ||
| 224 | |||
| 225 | TRANSPORT-PROTOCOL must be either \"tcp\" or \"udp\". | ||
| 226 | APPLICATION-PROTOCOL must be a protocol name as specified in URL | ||
| 227 | `http://www.dns-sd.org/ServiceTypes.html'. Typical service types | ||
| 228 | are \"_workstation._tcp\" or \"_printer._tcp\". | ||
| 229 | |||
| 230 | DOMAIN is the domain name the service is registered in, like \"local\". | ||
| 231 | |||
| 232 | FLAGS, an integer, is used inside Avahi. When publishing a | ||
| 233 | service (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. | ||
| 237 | The key of an entry is the concatenation of the service name and | ||
| 238 | service type of a resolved service. The value is the service | ||
| 239 | itself. The format of a service is | ||
| 240 | |||
| 241 | \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\) | ||
| 242 | |||
| 243 | INTERFACE, PROTOCOL, NAME, TYPE, DOMAIN and FLAGS have the same | ||
| 244 | meaning as in `zeroconf-services-hash'. | ||
| 245 | |||
| 246 | HOST is the host name the service is registered. It is a fully | ||
| 247 | qualified name, i.e., it contains DOMAIN. | ||
| 248 | |||
| 249 | APROTOCOL stands for the network protocol family ADDRESS is | ||
| 250 | encoded (`zeroconf-avahi-protocol-inet4' means INET4, | ||
| 251 | `zeroconf-avahi-protocol-inet6' means INET6). It can be | ||
| 252 | different from PROTOCOL, when an adrress resolution has been | ||
| 253 | requested for another protocol family but the default one. | ||
| 254 | |||
| 255 | ADDRESS is the service address, encoded according to the | ||
| 256 | APROTOCOL network protocol family. PORT is the corresponding | ||
| 257 | port the service can be reached on ADDRESS. | ||
| 258 | |||
| 259 | TXT is an array of strings, describing additional attributes of | ||
| 260 | the service. Usually, every string is a key=value pair. The | ||
| 261 | supported 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. | ||
| 281 | The 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 | ||
| 284 | format 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. | ||
| 295 | The 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. | ||
| 299 | The 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 | |||
| 304 | EVENT must be either :new or :removed, indicating whether | ||
| 305 | FUNCTION shall be called when a new service has been newly | ||
| 306 | detected, or removed. | ||
| 307 | |||
| 308 | FUNCTION must accept one argument SERVICE, which identifies the | ||
| 309 | new service. Initially, when EVENT is :new, FUNCTION is called | ||
| 310 | for all already detected services of service type TYPE. | ||
| 311 | |||
| 312 | The 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))) | ||
| 337 | (t (error "EVENT must be either `:new' or `:removed'.")))) | ||
| 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. | ||
| 373 | NAME must be a string. The service must be of service type | ||
| 374 | TYPE. 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. | ||
| 383 | NAME must be a string. The service must be of service type | ||
| 384 | TYPE. 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 | |||
| 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. | ||
| 479 | DOMAIN is a string, like \"dns-sd.org\" or \"local\". When | ||
| 480 | DOMAIN 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 | ||
| 485 | zeroconf-interface-avahi-server "IsNSSSupportAvailable")) | ||
| 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 | |||
| 616 | ;;; Services publishing. | ||
| 617 | |||
| 618 | (defun zeroconf-publish-service (name type domain host port address txt) | ||
| 619 | "Publish a service at the Avahi daemon. | ||
| 620 | For 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) | ||
| 675 | ;;; zeroconf.el ends here | ||