mDNS in pure Perl, no extra modules needed

mdns.pl

#!/usr/bin/perl
use warnings;
use strict;

use IO::Select;
use IO::Socket::INET;

# Build an mDNS query.
sub build_query {
  my $domain = shift;
  my $msgid = int(rand(1 << 16)); # Start with a random message ID
  # No flags, one question, no answers of any kind
  my $query = pack('n*', $msgid, 0, 1, 0, 0, 0);

  # Pack parts of name, prefixed by len
  my @parts = split /\./, $domain;
  for my $part (@parts) {
    $query .= pack('C', length($part)) . $part;
  }

  # Null terminate, request A record for INET
  $query .= "\0" . pack('n*', 1, 1);
  return ($msgid, $query);
}

# Remove the first $len chars of a string, returning them unpacked via $templ
sub take {
  my (undef, $len, $templ) = (@_, '');
  my $r = substr($_[0], 0, $len, '');
  return unpack($templ, $r);
}

# Skip a DNS-formatted name
sub skip_name {
  while (1) {
    # Length of next segment, or zero if done
    my $n = take($_[0], 1, 'C') or return;
    # If we're big, this is a pointer segment. Take pointer and end
    return take($_[0], 1) if $n >= 192;
    take($_[0], $n);
  }
}

sub parse_response {
  my ($msgid, $r) = @_;

  # Header
  my ($rid, $flags, $qd, $an, $ns, $ar) = take($r, 12, 'n*');
  die "Bad message ID\n" unless $msgid == $rid;
  die "Not a response\n" unless vec($flags, 16, 1) == 1;

  # Skip any questions
  while ($qd--) {
    skip_name($r);
    take($r, 4);
  }

  # Parse answer segment
  skip_name($r);
  die "Not an A response\n" unless take($r, 2, 'n') == 1;
  die "Not an INET response\n" unless take($r, 2, 'n') == 1;
  take($r, 4); # TTL
  die "Bad length\n" unless take($r, 2, 'n') == 4;

  return join('.', take($r, 4, 'C*'));
}

sub ask {
  my $hostname = shift;

  # Create socket, bind with no restrictions
  my $sock = IO::Socket::INET->new(
    Timeout => 1,
    Proto => 'udp',
  ) or die $!;
  $sock->bind(scalar(sockaddr_in(0, INADDR_ANY))) or die $!;

  # Send query to mDNS host/port
  my $peer = sockaddr_in(5353, inet_aton('224.0.0.251'));
  my ($msgid, $query) = build_query($hostname);
  $sock->send($query, 0, $peer) or die $!;

  # Wait for a response
  my $select = IO::Select->new($sock);
  $select->can_read(1) or die "No response\n";

  # Read and parse
  my $response;
  $sock->recv($response, 1024) or die $!;
  return parse_response($msgid, $response);
}

# Take an hostname as the only argument, look it up via mDNS.
# On success, print the IP to stdout. Otherwise, print an error to stderr.
my $ip = ask(shift) or die $!;
printf "%s\n", $ip;