avahi service xml generator

avahi-service-xml.pl

#!/usr/bin/env perl

=head1 DESCRIPTION
  Generate avahi.service(5) XML from discovered services using avahi-browse.
  This is useful for spoofing, proxying, bridging services, etc.

=head1 USAGE
  echo _foo._tcp _bar._tcp | xargs -n1 avahi-browse -rtpk | perl avahi-service-xml.pl
  avahi-browse -artpk | perl avahi-service-xml.pl

=cut

use strict;
use warnings;

use XML::Generator;

my $xml = XML::Generator->new(
    pretty => 2,
    conformance => "strict",
    dtd => ["service-group","SYSTEM",'"avahi-service.dtd"']);

my %sgs;
while(<>) {
  my @rec = split(/;|\n/, $_);
  next unless $rec[0] eq "=";
  (my $name = $rec[3]) =~ s/\\0(\d\d)/chr(0+$1)/ge;
  my %s = (type => $rec[4], port => $rec[8], "host-name" => $rec[6]);
  my @elem = map { $xml->$_($s{$_}) } keys %s;
  push @elem, map { my $en = "txt-record"; $xml->$en($_) } ($rec[9] =~ m/"(.*?)"/g);
  $sgs{$name} = [] unless defined $sgs{$name};
  push @{$sgs{$name}}, $xml->service({protocol => "ipv4"}, @elem);
}
foreach my $name (keys %sgs) {
  my $en = "service-group";
  my $sg = $xml->$en($xml->name($name), @{$sgs{$name}});
  print $xml->xmldecl(), $sg, "\n";
}