creeble has asked for the wisdom of the Perl Monks concerning the following question:

Okay, let's rephrase my previous question with more code.

I'm successfully sending out an mDNS query with the following code, and I see mDNS replies over tcpdump. But the UDP watcher never fires, or at least the on_recv callback never gets called:

use strict;
use AnyEvent;
#use AnyEvent::DNS;
use AnyEvent::Handle::UDP;
use AnyEvent::Socket ();
use Socket;
# try this

my $cb = sub {};

my($proto) = shift;

my $fqdn = "$proto.local";
#my $data = AnyEvent::DNS::dns_pack { rd => 1, qd => [[$fqdn, "ptr"]] 
+};
my $d = Net::DNS::Packet->new($fqdn, "PTR");
my $data = $d->data;

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'));

my %found;
my $callback = sub {};

my $t; 
$t = AnyEvent::Handle::UDP->new(
    fh => $sock,
    #bind => ['0.0.0.0', 5353],
    timeout => 3,
    on_timeout => sub {
print STDERR "WTF? timeout...\n";
        #undef $t;
        #$cb->(values %found);
    },
    on_recv => sub {
print STDERR "callback!!\n";
        my $buf = shift;
        my $handle = shift;
        #my $res = AnyEvent::DNS::dns_unpack $buf;
        my ($res,$err) = Net::DNS::Packet->new(\$buf, 1);

        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]->[3];
            $name =~ s/\.$fqdn$//;

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

            $found{$rr[0]->[3]} ||= 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 };

AnyEvent->condvar->recv;

[download]

There are a couple of varieties of packing the message above, both seem to elicit replies, but neither reply gets caught by the AnyEvent::Handle::UDP watcher.

AnyEvent monks, come from your caves and help a lost soul!

Eric.

Replies are listed 'Best First'.
Re: AnyEvent::Handle::UDP -- can't get it to receive?
by Neighbour (Friar) on Apr 26, 2012 at 08:51 UTC
    The things you learn when you're bored at work... :)
    Never did anything with sockets or AnyEvent before, but here it goes.
    After getting the latest AnyEvent (v5.24 is incompatible with AnyEvent::Handle::UDP v0.033) and AnyEvent::Handle::UDP packages from CPAN, this code seems to work: 
    #!/usr/bin/perl

use strict;
use warnings;
use AnyEvent;
#use AnyEvent::DNS;
use AnyEvent::Handle::UDP;
use AnyEvent::Socket ();
use Socket;
use Net::DNS::Packet;
use Data::Dump;

my $cb = sub {};

my($proto) = shift;

my $fqdn = "$proto.local";
#my $data = AnyEvent::DNS::dns_pack { rd => 1, qd => [[$fqdn, "ptr"]] 
+};
my $d = Net::DNS::Packet->new($fqdn, "PTR");
my $data = $d->data;

my %found;
my $callback = sub {};

my $cv_recv = AnyEvent->condvar;

my $t;
$t = AnyEvent::Handle::UDP->new(
#    fh => $sock,
    #bind => ['0.0.0.0', 5353],
    timeout => 3,
    on_timeout => sub {
print STDERR "WTF? timeout...\n";
        #undef $t;
        #$cb->(values %found);
    },
    on_error => sub {
print STDERR "An error has occurred:";
        Data::Dump::dd(@_);
    },
    on_recv => sub {
print STDERR "callback!!\n";
        my $buf = shift;
        my $handle = shift;
        my ($res,$err) = Net::DNS::Packet->new(\$buf, 1);

        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]->[3];
            $name =~ s/\.$fqdn$//;

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

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

#$t->bind_to(pack_sockaddr_in(0, Socket::inet_aton('0.0.0.0'))); # Doe
+s not work for some reason
$t->bind_to(['0.0.0.0',0]);
my $cv_send = $t->push_send($data, pack_sockaddr_in(53, Socket::inet_a
+ton('IP_OF_DNS-SERVER_HERE')));
print("Waiting for data to be sent...");
$cv_send->recv;
print("[OK]\n");

print("Waiting for data to arrive...");
$cv_recv->recv;
print("[OK]\n");

    [download]
    Output: 
    me@server:~/testscripts$ ./monks17.pl localhost
Waiting for data to be sent...[OK]
callback!!
Waiting for data to arrive...;; HEADER SECTION
;; id = 32508
;; qr = 1    opcode = QUERY    aa = 0    tc = 0    rd = 1
;; ra = 1    ad = 0    cd = 0    rcode  = NXDOMAIN
;; qdcount = 1  ancount = 0  nscount = 1  arcount = 0

;; QUESTION SECTION (1 record)
;; localhost.local.     IN      PTR

;; ANSWER SECTION (0 records)

;; AUTHORITY SECTION (1 record)
.       900     IN      SOA     a.root-servers.net. nstld.verisign-grs
+.com. (
                                        2012042600      ; Serial
                                        1800    ; Refresh
                                        900     ; Retry
                                        604800  ; Expire
                                        86400 ) ; Minimum TTL

;; ADDITIONAL SECTION (0 records)

[OK]
me@server:~/testscripts$

    [download]
[reply]
[d/l]
[select]
      Dude! 
      $cv_send->recv;

      [download]

      I've actually got a fair amount of AnyEvent experience, and I totally missed this. You are my new best friend.

      Wait, you say you've never done anything with either sockets or AnyEvent before? Quick learner. Anyway, would you mind PM'ing me with your email; if you're bored at work again I might have some PayPal-able learning for you...

      Eric.

[reply]
[d/l]
        Ug, yeah, whoops, that was me (creeble). Forgot to log in.
[reply]

Back to Seekers of Perl Wisdom