perlとchromecast その1 - 隠居日録の続き。
fetchがNet::DNS::Resolverでqueryしているのだが、mDSNでqueryしないと、応答が帰ってくるはずがない。そこが問題なのだが、fetchの中で普通のDNSとmDNSの両方を扱うのは面倒なので、mfetchを新たに追加して、状況に応じて呼び出す先を変えることにした。
sub discover { my $self = shift; my @list; my $ptrs = []; my $multi; if ( $self->domain(@_) eq 'local' ) { $multi = 1; @list = $self->mdns_refresh; } else { $multi = 0; @list = $self->dns_refresh; } foreach my $x ( 0..$#list ) { my $host = Net::Bonjour::Entry->new($list[$x]); $host->dns_server($self->{'_dns_server'}); $host->dns_port($self->{'_dns_port'}); if ($multi) { $host->mfetch (); } else { $host->fetch ();
でmfetchは元ものとfetchをほぼコピーした。SRV、A、TXTと連続してもqueryしているけれど、chromecastの応答のadditionalに既に情報が入っているので、やみくもにqueryするのは無駄たと思うのだが、とりあえずそのままにしている。
sub mfetch { my $self = shift; my ($name, $protocol, $ipType) = split(/(?<!\\)\./, $self->fqdn,3); $self->{'_name'} = $name; $self->type($protocol, $ipType); my $srv = $self->mcast_query ($self->fqdn, 'SRV') || return; my $srvrr = ($srv->answer)[0]; $self->priority($srvrr->priority); $self->weight($srvrr->weight); $self->port($srvrr->port); $self->hostname($srvrr->target); if ($srv->additional) { foreach my $additional ($srv->additional) { $self->{'_' . uc($additional->type)} = $additional->address; } } else { my $aquery = $self->mcast_query($srvrr->target, 'A'); my $arr = ($aquery->answer)[0]; if ( $arr->type eq 'A' ) { $self->{'_' . uc($arr->type)} = $arr->address; } } my $txt = $self->mcast_query($self->fqdn, 'TXT'); # Text::Parsewords, which is called by Net::DNS::RR::TXT can spew if ( $txt ) { local $^W = 0; my $txti = 0; foreach my $txtrr ( $txt->answer ) { $self->txtdata([$txtrr->char_str_list ]); $self->index($txti++); foreach my $txtln ( $txtrr->char_str_list ) { my ($key,$val) = split(/=/,$txtln,2); $self->attribute($key, $val); } $txti++; } } $self->text($txt); return; } sub mcast_query { my ($self, $name, $type) = @_; my $query = Net::DNS::Packet->new ($name, $type); my $dist = $self->{'_dns_server'}[0] . ":" . $self->{'_dns_port'}; my $dns = IO::Socket::Multicast->new(Proto => 'udp', LocalPort => $self->{'_dns_port'}) or die "Can't create socket: $!\n"; $dns->mcast_add ($self->{'_dns_server'}[0]) or die "Can't mcast_add: $!\n"; $dns->mcast_loopback (0) or die "Can't disable loopback: $!\n"; $dns->sockopt (SO_RCVTIMEO, pack ("qq", 1, 0)) or die "Can't set timeout: $!\n"; $dns->mcast_send ($query->data, $dist); my $data; my $ans = undef; $dns->recv ($data, 1024); if (length ($data) > 0) { $ans = Net::DNS::Packet->new(\$data, $self->{'_debug'}); } return $ans; }
この修正でchromecastの検出はできるようになった。でも、検出できるようになっただけで、何もできないので、この先は、以下のページでもう少し勉強する必要がある。