itunes-remote-publish.pl

#!/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 $devicename = "Fake Remote";
my $devicetype = "iPod";

my $txt = join "\x01", (
    "DvNm=" . $devicename,
    "RemV=10000",
    "DvTy=" . $devicetype,
    "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 => $devicetype };
    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-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", 
            headers => { 'Viewer-Only-Client' => 1 }, 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", 
            headers => {'Viewer-Only-Client' => 1}, sub {
            my($body, $header) = @_;
            my $data = dmap_to_hash_ref($body);
            use YAML();
            warn YAML::Dump $data;
        };
    },
);

AnyEvent->condvar->recv;

sub hexbytes {
    my $code = shift;
    $code =~ s/(..)/chr($1)/eg;
    return $code;
}