Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/perl
- # Ported http://dacp.jsharkey.org/ to Perl
- use strict;
- use AnyEvent;
- use AnyEvent::Socket;
- use AnyEvent::HTTP;
- use Net::Rendezvous::Publish;
- use Net::DAAP::DMAP qw(:all);
- my $port = 10020;
- my $pair = "0000000000000001";
- my $txt = join "\x01", (
- "DvNm=Fake Remote",
- "RemV=10000",
- "DvTy=iPod",
- "RemN=Remote",
- "txtvers=1",
- "Pair=$pair",
- );
- # publish Bonjour for touch-remote
- my $w = AnyEvent->timer(
- after => 0,
- cb => sub {
- warn "Publishing touch-remote service\n";
- my $p = Net::Rendezvous::Publish->new;
- $p->publish(
- name => "0000000000000000000000000000000000000001",
- type => "_touch-remote._tcp",
- domain => "local",
- port => $port,
- txt => $txt,
- );
- },
- );
- my $pair_done = AnyEvent->condvar;
- # wait as an HTTP server
- tcp_server undef, $port, sub {
- my($fh, $host, $port) = @_;
- warn "Received pairing request from $host:$port\n";
- my $values = { cmpg => hexbytes($pair), cmnm => "devicename", cmty => "ipod" };
- my $encoded = '';
- while (my($k, $v) = each %$values) {
- $encoded .= $k . pack('N', length($v)) . $v;
- }
- $encoded = 'cmpa' . pack('N', length($encoded)) . $encoded;
- my $length = length($encoded);
- my $crlf = "\015\012";
- syswrite $fh, join($crlf,
- "HTTP/1.1 200 OK",
- "Content-Type: text/plain",
- "Content-Length: $length",
- "",
- $encoded);
- $pair_done->send($host);
- };
- # login to iTunes
- my $s = AnyEvent->timer(
- after => 0,
- cb => sub {
- # TODO: find iTunes via Bonjour ... but how?
- my $host = $pair_done->recv;
- warn "Pairing is done. Connecting to iTunes on $host:3689\n";
- my $login = AnyEvent->condvar;
- http_get "http://$host:3689/login?pairing-guid=0x$pair", sub {
- my($body, $header) = @_;
- my $data = dmap_to_hash_ref($body);
- my $session_id = unpack 'N', $data->{mlog}{mlid};
- warn "Logged in. New session-id is $session_id\n";
- $login->send($session_id);
- };
- # FIXME Sometimes session-id is empty. Needs to restart iTunes
- my $session_id = $login->recv;
- # FIXME this doesn't work. No clue why.
- http_get "http://$host:3689/ctrl-int/1/playstatusupdate?revision-number=1&session-id=$session_id", sub {
- my($body, $header) = @_;
- my $data = dmap_to_hash_ref($body);
- use XXX;
- WWW $data;
- };
- },
- );
- AnyEvent->condvar->recv;
- sub hexbytes {
- my $code = shift;
- $code =~ s/(..)/chr($1)/eg;
- return $code;
- }
Advertisement
Add Comment
Please, Sign In to add comment