tclcross-platformservice-discoveryzeroconf

service discovery in tcl

I'm writing a little Tcl/Tk script, that uses a (custom) web-application (written in Python) to retrieve information from some central storage.

Everything works nicely, but only as long as the address of the webserver is known beforehand.

So I thought about adding some kind of service discovery, where my script would discover all running instances of my web-application on the local network, and automatically use them.

My first idea was to use Zeroconf/Bonjour/Avahi, and have my web-application publish a _my-web-service._tcp service with the actual query path (that the tcl client script should use to access the data) encoded in the TXT field:

avahi-publish-service MyService _my-web-service._tcp 8000 path=/data

Unfortunately, I haven't found anything that brings zeroconf-like service-discovery into the Tcl-world.

In particular, I was looking at the DNS entry on the Tcl Wiki but that only gets me as far as mDNS (and i currently have no clue how to proceed from there to zeroconf stack).

I'm not especially bound to Zeroconf/Bonjour/Avahi, but would like to run my script on Linux/Windows/macOS, and keep my build requirements minimal (that is: i would prefer it, if i don't have to compile my own wrapper code to interface with the service-discovery for each platform). Telling the users to install Bonjour or whatnot from 3rd-party sources would be tolerable though.

Solution

  • In particular, I was looking at the DNS entry on the Tcl Wiki but that only gets me as far as mDNS (and i currently have no clue how to proceed from there to zeroconf stack).

    You were looking at the right corner, but the code snippet at the Tcl'ers Wiki appears outdated. I was curious and gave it some love.

    This was tested using:

    % package req Tcl
8.6.12
% package req dns
1.4.1
% package req udp
1.0.11

    ... and by announcing an exemplary service on macOS via:

    dns-sd -R "Index" _http._tcp . 80 path=/index22.html

    I managed to discover the above service using the patched dns package, by retrieving the DNS-SD (RFC 6763) specific records, mainly the target and port from the SRV record(s), and extras (e.g., a path) from the corresponding TXT record(s):

    set instanceName "Index._http._tcp.local"
set tok [::dns::resolve $instanceName -protocol mdns -type SRV]
if {[::dns::wait $tok] eq "ok"} {

  set res [dict create {*}[lindex [::dns::result $tok] 0]]; # Pick first answer record, only!
  array set SRV [dict get $res rdata]
  ::dns::cleanup $tok
  
  
  set tok [::dns::resolve $instanceName -protocol mdns -type TXT]
  if {[::dns::wait $tok] eq "ok"} {
    array set TXT {}
    foreach txt [::dns::result $tok] {
      lassign [split [dict get $txt rdata] "="] k v
      set TXT($k) $v
    }
    ::dns::cleanup $tok
  }

  set tok [::dns::resolve $SRV(target) -protocol mdns -type A]
  if {[::dns::wait $tok] eq "ok"} {
    set res [dict create {*}[lindex [::dns::result $tok] 0]]; # Pick first answer record, only!
    puts "Service IP: [dict get $res rdata]"
    puts "Service port: $SRV(port)"
    puts "Service options: [array get TXT]"
  }
  ::dns::cleanup $tok
}

    This will print:

    Service IP: 192.168.0.14
Service port: 80
Service options: path /index222.html

    Patching tcllib's dns

    The snippet from Tcl'ers Wiki needs to be modified, yielding:

    proc ::dns::UdpTransmit {token} {
  # FRINK: nocheck
  variable $token
  upvar 0 $token state

  # setup the timeout
  if {$state(-timeout) > 0} {
    set state(after) [after $state(-timeout) \
                          [list [namespace origin reset] \
                               $token timeout\
                               "operation timed out"]]
  }
  
  if {[llength [package provide ceptcl]] > 0} {
    # using ceptcl
    set state(sock) [cep -type datagram $state(-nameserver) $state(-port)]
    chan configure $state(sock) -blocking 0
  } else {
    # using tcludp
    set state(sock) [udp_open]
    if { $state(-protocol) eq "mdns" } {
      set state(-nameserver) "224.0.0.251"
      set state(-port)       5353
      chan configure $state(sock) -mcastadd $state(-nameserver);
    }
  }
  chan configure $state(sock) -remote [list $state(-nameserver) $state(-port)] \
      -translation binary \
      -buffering none;
  
  set state(status) connect
  chan event $state(sock) readable [list [namespace current]::UdpEvent $token]
  puts -nonewline $state(sock) $state(request)
  
  return $token
}

    Background:

    (that is: i would prefer it, if i don't have to compile my own wrapper code to interface with the service-discovery for each platform)

    This way, you do not have to interface with any third-party library or exec to some executable (dns-sd), but you will have to bundle your Tcl/Tk script with the platform-specific TclUDP extension, as a starpack or starkit, maybe?