view release on metacpan or  search on metacpan

lib/AnyEvent/mDNS.pm  view on Meta::CPAN

package AnyEvent::mDNS;

use strict;
use 5.008_001;
our $VERSION = '0.06';

use AnyEvent 4.84;
use AnyEvent::DNS;
use AnyEvent::Handle::UDP;
use AnyEvent::Socket ();
use Socket;

sub discover($%) { ## no critic
    my $cb = sub {};
    $cb = pop if @_ % 2 == 0;

    my($proto, %args) = @_;

    my $fqdn = "$proto.local";
    my $data = AnyEvent::DNS::dns_pack { rd => 1, qd => [[$fqdn, "ptr"]] };

    my($name, $alias, $udp_proto) = AnyEvent::Socket::getprotobyname('udp');
    socket my($sock), PF_INET, SOCK_DGRAM, $udp_proto;
    AnyEvent::Util::fh_nonblocking $sock, 1;
    bind $sock, sockaddr_in(0, Socket::inet_aton('0.0.0.0'))
        or ($args{on_error} || sub { die @_ })->($!);

    my %found;
    my $callback = $args{on_found} || sub {};

    my $t; $t = AnyEvent::Handle::UDP->new(
        fh => $sock,
        timeout => $args{timeout} || 3,
        on_timeout => sub {
            undef $t;
            $cb->(values %found);
        },
        on_recv => sub {
            my $buf = shift;
            my $res = AnyEvent::DNS::dns_unpack $buf;

            my @rr  = grep { lc $_->[0] eq $fqdn && $_->[1] eq 'ptr' } @{ $res->{an} };
            my @srv = grep { $_->[1] eq 'srv' } @{$res->{ar}};

            if (@rr == 1 && @srv == 1) {
                my $name = $rr[0]->[4];
                $name =~ s/\.$fqdn$//;

                my $service = {
                    name => $name,
                    host => $srv[0]->[7],
                    port => $srv[0]->[6],
                    proto => $proto,
                };

                $found{$rr[0]->[4]} ||= do {
                    $callback->($service) if $callback;
                    $service;
                };
            }
        },
    );

    send $sock, $data, 0, sockaddr_in(5353, Socket::inet_aton('224.0.0.251'));
    defined wantarray && AnyEvent::Util::guard { undef $t };
}

1;
__END__

=encoding utf-8

=for stopwords
AnyEvent multicast DNS UDP mDNS

=head1 NAME

AnyEvent::mDNS - Multicast DNS in AnyEvent style

=head1 SYNOPSIS

  use AnyEvent::mDNS;

  my $cv = AnyEvent->condvar;