LCOV - code coverage report
Current view: top level - lisp/net - zeroconf.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 222 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 34 0.0 %

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

Generated by: LCOV version 1.12