今の所chromecastのメインの使い方はメディアサーバーにRygelを使い、SenderアプリとしてAndroidのタブレットでBubbleUPnPを使って、ファイルを再生している。しかし、chromecastを買った当初から、もっと簡単な方法はないのだろうかと探している。pythonとかnode.jsにはあるようなのだが、環境の設定が面倒なのと、pythonもjavascriptもよく判らないので、二の足を踏んでいる。perlで何かないかと思って探してみると、以下のようなものがあった
当然動かない。問題の一番の部分はNet::UPnPがもうメンテナンスされていなく、多数のバグが残っていることだ。それと、いつのまにかchromecastはUPnPでは検出できなくなっている。一応応答を返してくるのだが、frendlynameもdeviceTypeも返してこない。
調べてみるとchromecastのプロトコルはv1とv2があって、v1はUPnPで検出できるが、v2はmDNSということだ。どっかの時点で、v2しかサポートしなくなったのだろうか。以前はUPnPで検出できていた記憶がある。しかたがないので、mDNSで検出できないかと、perlモジュールを調べると、Net::Bonjourというのがあるのがわかった。さっそく、debianのパッケージを入れて、試そうと思ったのだが、どう検出してよいかわからない。newの引数に何を渡せばいいのか、さっぱり見当がつかない。
Net::Bonjour->new (<service>, <protocol>, <domain>);
考えていてもわからないので、検索していると、http://qiita.com/vanx2/items/3c20bf8e4111da9eb68dで、
と書いてあって、わかったようなわからないような感じだ。それで、イーサーパケットをキャプチャしながら、いろいろ試してみると、以下のコードで、それっぽいパケットが出て、応答が帰ってくることが分かった。
use strict; use Net::Bonjour; my @services = qw(googlecast); foreach my $service (@services) { print "Trying $service\n"; my $res = Net::Bonjour->new($service, 'tcp', 'local'); foreach my $entry ( $res->entries ) { printf "%s %s:%s\n", $entry->name, $entry->address, $entry->port; } }
ところがである。perlではパケットが受信できないのだ。Net::Bonjourも更新が止まっているので、涸れて安定しているか、放置されているかのどちらかだろう。どうやら、後者のようだ。検索しても、Net::Bonjourの関連ページがヒットしない。現状の動作としては、パケットは受信できないし、どこかで無限待ちになっているようだ。いろいろ調べてみると、mdns_refreshに問題がありそうなことが分かった。キャプチャしたパケットをよく見ると、chromecastからのパケットも224.0.0.251に送信されているので、普通に受信しようと思ってもできないはずだ。それに、タイムアウトも設定していないので、いつまでも待ち続けるわけだ。
sub mdns_refresh { my $self = shift; my $query = Net::DNS::Packet->new($self->fqdn, 'PTR'); socket DNS, PF_INET, SOCK_DGRAM, scalar(getprotobyname('udp')); bind DNS, sockaddr_in(0,inet_aton('0.0.0.0')); send DNS, $query->data, 0, sockaddr_in($self->{'_dns_port'}, inet_aton($ self->{'_dns_server'}[0])); my $rout = ''; my $rin = ''; my %list; vec($rin, fileno(DNS), 1) = 1; while ( select($rout = $rin, undef, undef, 1.0) ) { my $data; recv(DNS, $data, 1000, 0);
マルチキャストの受信にしなければ、受信できないだろうという想定のもと、インストールしたdebianのパッケージを削除して、cpanからNet::Bonjourをダウンロードして、以下のように修正してみた。
sub mdns_refresh { my $self = shift; my $query = Net::DNS::Packet->new($self->fqdn, 'PTR'); 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"; my $timeout = pack ("qq", 1, 0); $dns->sockopt (SO_RCVTIMEO, $timeout) or die "Can't set timeout: $!\n"; $dns->mcast_send ($query->data, $dist); my %list; my $data = ""; while (1) { $dns->recv ($data, 1024); last if (length ($data) <= 0);
これだと、受信はうまくいってmdns_refreshで検出できるところまではいったのだが、まだこれでも想定した通り動かない。別なところで、無限待ちになっているのだ。それは、Net::Bonjour::Entryのfetchの問題だというのまではわかったのだが、さてどのように修正するのがいいのか、考えてしまう。
