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 while ( my $client = $sock->accept() ) {
  19
  20         warn "connect from ", dump $client->peeraddr, $client->peerport;
  21
  22         while ( read $client, my $command, 1 ) {
  23                 $command = ord $command;
  24                 warn "# command: $command\n";
  25                 if ( $command == 4 ) {
  26                         read $client, my $len, 2;
  27                         read $client, my $auth, unpack( 'n', $len );
  28                         warn "AUTHENTIFICATION $len $auth\n";
  29                 } else {
  30                         die "UNSUPPORTED";
  31                 }
  32         }
  33
  34         warn "client disconnected\n";
  35
  36 }