line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package AnyEvent::mDNS; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
22270
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
32
|
|
4
|
1
|
|
|
1
|
|
22
|
use 5.008_001; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
41
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
1633
|
use AnyEvent 4.84; |
|
1
|
|
|
|
|
5917
|
|
|
1
|
|
|
|
|
30
|
|
8
|
1
|
|
|
1
|
|
1177
|
use AnyEvent::DNS; |
|
1
|
|
|
|
|
32592
|
|
|
1
|
|
|
|
|
46
|
|
9
|
1
|
|
|
1
|
|
1086
|
use AnyEvent::Handle::UDP; |
|
1
|
|
|
|
|
85927
|
|
|
1
|
|
|
|
|
48
|
|
10
|
1
|
|
|
1
|
|
11
|
use AnyEvent::Socket (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
16
|
|
11
|
1
|
|
|
1
|
|
5
|
use Socket; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1250
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub discover($%) { ## no critic |
14
|
0
|
|
|
0
|
1
|
|
my $cb = sub {}; |
|
0
|
|
|
0
|
|
|
|
15
|
0
|
0
|
|
|
|
|
$cb = pop if @_ % 2 == 0; |
16
|
|
|
|
|
|
|
|
17
|
0
|
|
|
|
|
|
my($proto, %args) = @_; |
18
|
|
|
|
|
|
|
|
19
|
0
|
|
|
|
|
|
my $fqdn = "$proto.local"; |
20
|
0
|
|
|
|
|
|
my $data = AnyEvent::DNS::dns_pack { rd => 1, qd => [[$fqdn, "ptr"]] }; |
21
|
|
|
|
|
|
|
|
22
|
0
|
|
|
|
|
|
my($name, $alias, $udp_proto) = AnyEvent::Socket::getprotobyname('udp'); |
23
|
0
|
|
|
|
|
|
socket my($sock), PF_INET, SOCK_DGRAM, $udp_proto; |
24
|
0
|
|
|
|
|
|
AnyEvent::Util::fh_nonblocking $sock, 1; |
25
|
|
|
|
|
|
|
bind $sock, sockaddr_in(0, Socket::inet_aton('0.0.0.0')) |
26
|
0
|
0
|
0
|
0
|
|
|
or ($args{on_error} || sub { die @_ })->($!); |
|
0
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
my %found; |
29
|
0
|
|
0
|
0
|
|
|
my $callback = $args{on_found} || sub {}; |
|
0
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
0
|
|
|
|
|
|
my $t; $t = AnyEvent::Handle::UDP->new( |
32
|
|
|
|
|
|
|
fh => $sock, |
33
|
|
|
|
|
|
|
timeout => $args{timeout} || 3, |
34
|
|
|
|
|
|
|
on_timeout => sub { |
35
|
0
|
|
|
0
|
|
|
undef $t; |
36
|
0
|
|
|
|
|
|
$cb->(values %found); |
37
|
|
|
|
|
|
|
}, |
38
|
|
|
|
|
|
|
on_recv => sub { |
39
|
0
|
|
|
0
|
|
|
my $buf = shift; |
40
|
0
|
|
|
|
|
|
my $res = AnyEvent::DNS::dns_unpack $buf; |
41
|
|
|
|
|
|
|
|
42
|
0
|
0
|
|
|
|
|
my @rr = grep { lc $_->[0] eq $fqdn && $_->[1] eq 'ptr' } @{ $res->{an} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
my @srv = grep { $_->[1] eq 'srv' } @{$res->{ar}}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
0
|
0
|
0
|
|
|
|
if (@rr == 1 && @srv == 1) { |
46
|
0
|
|
|
|
|
|
my $name = $rr[0]->[4]; |
47
|
0
|
|
|
|
|
|
$name =~ s/\.$fqdn$//; |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
|
my $service = { |
50
|
|
|
|
|
|
|
name => $name, |
51
|
|
|
|
|
|
|
host => $srv[0]->[7], |
52
|
|
|
|
|
|
|
port => $srv[0]->[6], |
53
|
|
|
|
|
|
|
proto => $proto, |
54
|
|
|
|
|
|
|
}; |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
0
|
|
|
|
$found{$rr[0]->[4]} ||= do { |
57
|
0
|
0
|
|
|
|
|
$callback->($service) if $callback; |
58
|
0
|
|
|
|
|
|
$service; |
59
|
|
|
|
|
|
|
}; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
}, |
62
|
0
|
|
0
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
send $sock, $data, 0, sockaddr_in(5353, Socket::inet_aton('224.0.0.251')); |
65
|
0
|
0
|
|
0
|
|
|
defined wantarray && AnyEvent::Util::guard { undef $t }; |
|
0
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
1; |
69
|
|
|
|
|
|
|
__END__ |