雑な mDNS サーバ実装

mdnsserver.pl

#!/usr/bin/perl
# License: NYSL
use warnings;
use strict;
use Sys::Hostname;
use IO::Socket::Multicast;
use Net::DNS;
use IO::Interface::Simple;

my $sock = IO::Socket::Multicast->new(LocalPort => 5353);
$sock->mcast_add('224.0.0.251') or die;

my $addr;
my @ifs = IO::Interface::Simple->interfaces;
foreach my $i (@ifs) {
  next if $i->address eq '127.0.0.1';
  $addr = $i->address;
  last;
}
print "addr: $addr\n";

while ( 1 ) {
  my $data;
  $sock->recv($data, 4096) or next;

  my $query = new Net::DNS::Packet(\$data) or next;
  my @question = $query->question;
  my $q = $question[0] or next;

  next if ( $q->qname ne hostname . ".local");

  my $reply = new Net::DNS::Packet();
  $reply->header->qr(1);
  $reply->header->aa(1);
  $reply->header->id($query->header->id);
  if ( $q->qtype eq "A") {
    $reply->push(
      answer => new Net::DNS::RR(
        name => $q->qname,
        ttl => 10,
        type => 'A',
        address => $addr));
  }
  $sock->send($reply->data);
}