Guest User

Untitled

a guest
Nov 9th, 2011
118
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.66 KB | None | 0 0
  1. #!/usr/bin/perl
  2. # Ported http://dacp.jsharkey.org/ to Perl
  3. use strict;
  4. use AnyEvent;
  5. use AnyEvent::Socket;
  6. use AnyEvent::HTTP;
  7. use Net::Rendezvous::Publish;
  8. use Net::DAAP::DMAP qw(:all);
  9.  
  10. my $port = 10020;
  11. my $pair = "0000000000000001";
  12.  
  13. my $txt = join "\x01", (
  14. "DvNm=Fake Remote",
  15. "RemV=10000",
  16. "DvTy=iPod",
  17. "RemN=Remote",
  18. "txtvers=1",
  19. "Pair=$pair",
  20. );
  21.  
  22. # publish Bonjour for touch-remote
  23. my $w = AnyEvent->timer(
  24. after => 0,
  25. cb => sub {
  26. warn "Publishing touch-remote service\n";
  27. my $p = Net::Rendezvous::Publish->new;
  28. $p->publish(
  29. name => "0000000000000000000000000000000000000001",
  30. type => "_touch-remote._tcp",
  31. domain => "local",
  32. port => $port,
  33. txt => $txt,
  34. );
  35. },
  36. );
  37.  
  38. my $pair_done = AnyEvent->condvar;
  39.  
  40. # wait as an HTTP server
  41. tcp_server undef, $port, sub {
  42. my($fh, $host, $port) = @_;
  43.  
  44. warn "Received pairing request from $host:$port\n";
  45. my $values = { cmpg => hexbytes($pair), cmnm => "devicename", cmty => "ipod" };
  46. my $encoded = '';
  47. while (my($k, $v) = each %$values) {
  48. $encoded .= $k . pack('N', length($v)) . $v;
  49. }
  50. $encoded = 'cmpa' . pack('N', length($encoded)) . $encoded;
  51.  
  52. my $length = length($encoded);
  53. my $crlf = "\015\012";
  54. syswrite $fh, join($crlf,
  55. "HTTP/1.1 200 OK",
  56. "Content-Type: text/plain",
  57. "Content-Length: $length",
  58. "",
  59. $encoded);
  60.  
  61. $pair_done->send($host);
  62. };
  63.  
  64. # login to iTunes
  65. my $s = AnyEvent->timer(
  66. after => 0,
  67. cb => sub {
  68. # TODO: find iTunes via Bonjour ... but how?
  69. my $host = $pair_done->recv;
  70. warn "Pairing is done. Connecting to iTunes on $host:3689\n";
  71.  
  72. my $login = AnyEvent->condvar;
  73. http_get "http://$host:3689/login?pairing-guid=0x$pair", sub {
  74. my($body, $header) = @_;
  75. my $data = dmap_to_hash_ref($body);
  76. my $session_id = unpack 'N', $data->{mlog}{mlid};
  77. warn "Logged in. New session-id is $session_id\n";
  78. $login->send($session_id);
  79. };
  80.  
  81. # FIXME Sometimes session-id is empty. Needs to restart iTunes
  82. my $session_id = $login->recv;
  83.  
  84. # FIXME this doesn't work. No clue why.
  85. http_get "http://$host:3689/ctrl-int/1/playstatusupdate?revision-number=1&session-id=$session_id", sub {
  86. my($body, $header) = @_;
  87. my $data = dmap_to_hash_ref($body);
  88. use XXX;
  89. WWW $data;
  90. };
  91. },
  92. );
  93.  
  94. AnyEvent->condvar->recv;
  95.  
  96. sub hexbytes {
  97. my $code = shift;
  98. $code =~ s/(..)/chr($1)/eg;
  99. return $code;
  100. }
Advertisement
Add Comment
Please, Sign In to add comment