premotedroid-server.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use IO::Socket::INET;
   6 use Data::Dump qw(dump);
   7
   8 my $sock = IO::Socket::INET->new(
   9         Listen    => 5,
  10 #       LocalAddr => 'localhost',
  11         LocalPort => 64788,
  12         Proto     => 'tcp',
  13         Reuse     => 1,
  14 ) || die $!;
  15
  16 warn "listen on ", dump $sock->sockaddr, $sock->sockport;
  17
  18 sub readUTF {
  19         my $client = shift;
  20         read $client, my $len, 2;
  21         $len = unpack( 'n', $len );
  22         read $client, my $utf, $len;
  23         warn "## readUTF $len [$utf]";
  24         return $utf;
  25 }
  26
  27 # from PRemoteDroid Protocol/src/org/pierre/remotedroid/protocol/action/PRemoteDroidAction.java
  28 use constant MOUSE_MOVE => 0;
  29 use constant MOUSE_CLICK => 1;
  30 use constant MOUSE_WHEEL => 2;
  31 use constant KEYBOARD => 3;
  32 use constant AUTHENTIFICATION => 4;
  33 use constant AUTHENTIFICATION_RESPONSE => 5;
  34 use constant SCREEN_CAPTURE_REQUEST => 6;
  35 use constant SCREEN_CAPTURE_RESPONSE => 7;
  36 use constant FILE_EXPLORE_REQUEST => 8;
  37 use constant FILE_EXPLORE_RESPONSE => 9;
  38
  39 open(my $xdo, '|-', 'xdotool -') || die $!;
  40 select($xdo); $|=1;
  41
  42 my $keysyms = {
  43         -1 => 'BackSpace',
  44         10 => 'Return',
  45 };
  46
  47 while ( my $client = $sock->accept() ) {
  48
  49         warn "connect from ", dump $client->peeraddr, $client->peerport;
  50
  51         while ( read $client, my $command, 1 ) {
  52                 $command = ord $command;
  53                 warn "# command: $command\n";
  54                 if ( $command == MOUSE_MOVE ) {
  55                         read $client, my $move, 4;
  56                         my ( $x, $y ) = unpack 's>s>', $move; # big-endian 16 bit
  57                         warn "MOVE $x $y\n";
  58                         print $xdo "mousemove_relative -- $x $y\n";
  59                 } elsif ( $command == MOUSE_CLICK ) {
  60                         read $client, my $b, 2;
  61                         my ( $button, $state ) = unpack 'cc', $b;
  62                         warn "MOUSE_CLICK $button $state\n";
  63                         print $xdo 'mouse' . ( $state ? 'down' : 'up' ) . ' ' . $button . "\n";
  64                 } elsif ( $command == MOUSE_WHEEL ) {
  65                         read $client, my $amount, 1;
  66                         $amount = unpack 'c', $amount;
  67                         warn "MOUSE_WHEEL $amount\n";
  68                         print $xdo 'click ' . ( $amount > 0 ? 4 : 5 ) . "\n" foreach ( 1 .. abs($amount) );
  69                 } elsif ( $command == AUTHENTIFICATION ) {
  70                         my $auth = readUTF $client;
  71                         warn "AUTHENTIFICATION [$auth]\n";
  72                         print $client pack 'cc', AUTHENTIFICATION_RESPONSE, 1; # FIXME anything goes
  73                 } elsif ( $command == KEYBOARD ) {
  74                         read $client, my $unicode, 4;
  75                         my $key = unpack 'l>', $unicode;
  76                         my $command = 'type';
  77                         if ( defined $keysyms->{$key} ) {
  78                                 $key = $keysyms->{$key};
  79                                 $command = 'key';
  80                         } else {
  81                                 $key = chr($key);
  82                                 $command = 'key' if $key =~ m/^\w$/;
  83                         }
  84                         warn uc($command)," $key\n";
  85                         print $xdo "$command '$key'\n";
  86                 } elsif ( $command == SCREEN_CAPTURE_REQUEST ) {
  87                         read $client, my $capture_req, 7;
  88                         my ( $width, $height, $format ) = unpack 's>s>c', $capture_req;
  89                         my $fmt = $format ? 'jpg' : 'png';
  90                         warn "SCREEN_CAPTURE_REQUEST $width*$height $format $fmt\n";
  91                         my $location = `xdotool getmouselocation`;
  92                         warn "# mouse $location\n";
  93
  94                         my $x = $1 if $location =~ m/x:(\d+)/;
  95                         my $y = $1 if $location =~ m/y:(\d+)/;
  96
  97                         $x -= $width  / 2; $x = 0 if $x < 0;
  98                         $y -= $height / 2; $y = 0 if $y < 0;
  99
 100                         my $file = "/tmp/capture.$fmt";
 101                         my $capture = "xwd -root | convert -crop ${width}x${height}+$x+$y xwd:- $file";
 102                         # FIXME I wasn't able to persuade import to grab whole screen and disable click
 103
 104                         warn "# $capture\n";
 105                         system $capture;
 106
 107                         print $client pack('cl>', SCREEN_CAPTURE_RESPONSE, -s $file);
 108                         open(my $fh, '<', $file) || die "$file: $!";
 109                         while( read $fh, my $chunk, 8192 ) {
 110                                 print $client $chunk;
 111                                 warn ">> ",length($chunk), "\n";
 112                         }
 113                 } else {
 114                         die "UNSUPPORTED";
 115                 }
 116         }
 117
 118         warn "client disconnected\n";
 119
 120 }