service discovery in tcl

Question

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.

Answer 1

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:

• This is mainly to reflect changes to udp API (udp_conf is replaced by chan configure /socket/ -remote)
• ... but also: the original snippet does not join the multicast IP to listen for the mDNS responses (-mcastadd).
• Other than that, dns is capable of decoding the DNS resource records (SRV, TXT) etc. just fine.

(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?