6 use Data::Dump qw(dump);
8 my $sock = IO::Socket::INET->new(
10 # LocalAddr => 'localhost',
16 warn "listen on ", dump $sock->sockaddr, $sock->sockport;
20 read $client, my $len, 2;
21 $len = unpack( 'n', $len );
22 read $client, my $utf, $len;
23 warn "## readUTF $len [$utf]";
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;
39 open(my $xdo, '|-', 'xdotool -') || die $!;
47 while ( my $client = $sock->accept() ) {
49 warn "connect from ", dump $client->peeraddr, $client->peerport;
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
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;
77 if ( defined $keysyms->{$key} ) {
78 $key = $keysyms->{$key};
82 $command = 'key' if $key =~ m/^\w$/;
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";
94 my $x = $1 if $location =~ m/x:(\d+)/;
95 my $y = $1 if $location =~ m/y:(\d+)/;
97 $x -= $width / 2; $x = 0 if $x < 0;
98 $y -= $height / 2; $y = 0 if $y < 0;
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
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";
118 warn "client disconnected\n";