use IO::Select to create async client

diff --git a/bin/drac-vkvm.pl b/bin/drac-vkvm.pl
index 8ed5e1a..7df0318 100755 (executable)
--- a/bin/drac-vkvm.pl
+++ b/bin/drac-vkvm.pl
@@ -13,6 +13,7 @@ use LWP::UserAgent;
 use XML::Simple;
 use IO::Socket::SSL;
 use IO::Socket::INET;
+use IO::Select;
 use Data::Dump qw(dump);
 
 my $to = shift @ARGV || die "$0 root:password\@10.0.0.1\n";
@@ -65,12 +66,14 @@ if ( !defined $input ) {
        die "I encountered a problem: ", IO::Socket::SSL::errstr();
 }
 else {
-       print STDERR "Connected to video redirection port $ip:5900!\n";
+       print STDERR "# input redirection $ip:5900\n";
 }
 
 print "SSL cipher: " . $input->get_cipher() . "\n";
 print "Cert: " . $input->dump_peer_certificate() . "\n";
 
+my $sel = IO::Select->new( $input );
+
 sub xx {
        my $hex = join(' ', @_);
        $hex =~ s/\s+//gs;
@@ -84,6 +87,8 @@ sub hexdump {
         return $hex;
 }
 
+my $v_hash = "3e 8f";
+
 my $auth = xx qq{
 42 45 45 46 01 02 00 d9  20 35 33 65 36 61 31 32
 34 34 32 30 61 39 65 66  64 37 35 64 62 33 36 34
@@ -103,48 +108,68 @@ my $auth = xx qq{
 
 my $new = substr($auth,0,8) . $vKvmSessionId;
 $new .= substr($auth,length($new), -3);
-$new .= "\x3e\x8f\x00";
+$new .= xx( $v_hash . '00' );
 
-warn ">> auth ", hexdump($new);
+warn ">> ", $input->peerport, " | ", hexdump($new);
 print $input $new;
 
+our $once;
+
 sub read_beef {
-       my ($sock,$desc) = @_;
+       my ($sock) = @_;
 
        read($sock, my $header, 8);
-       warn "<< header $desc ", hexdump $header;
-       my ($beef,$cmd,$block,$len) = unpack('A4CCn', $header);
+       if ( ! $header ) {
+               warn "# no header from ", $sock->peerport, " $!" unless $once->{$sock}++;
+               return;
+       }
+
+       $once->{$sock} = 0;
 
-       warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF';
-       warn "not response 0x8000" unless $cmd & 0x8000;
+       my ($beef,$cmd,$len) = unpack('A4nn', $header);
+
+       warn "ASSERT: not BEEF but ",hexdump($beef) unless $beef eq 'BEEF';
+       warn "ASSERT: not response 0x8000" unless $cmd & 0x8000;
 
        read($sock, my $packet, $len);
-       warn "<< $desc $len ", hexdump( $header . $packet );
+       warn "<< ", $sock->peerport, " | ", hexdump( $header . $packet ), $/;
+
+       my $desc = unpack('H*', $cmd);
+
+       if ( $cmd == 0x8305 ) {
+               warn "# window title:", substr( $packet, 11 );
+
+       } elsif ( $cmd == 0x8420 ) {
+               warn " # connect to video $ip:5901\n";
+
+               my $video = IO::Socket::INET->new(
+                       PeerAddr => $ip,
+                       PeerPort => 5901,
+               ) || die $!;
+
+               my $v_auth = xx "0000 0000 0101 0010 0000 $v_hash 0000 0000";
+               warn ">> ", $video->peerport, " | ", hexdump($v_auth), $/;
+               print $video $v_auth;
+
+#              read($video, my $response, 16);
+#              warn "<< ", $video->peerport, " | ", hexdump( $response ), $/;
+
+               $sel->add( $video );
 
-       if ( $cmd == 0x83 ) {
-               warn "S>C session response";
-       } elsif ( $cmd == 0x82 ) {
-               warn "S>V video update";
        }
+
 }
 
-read_beef $input => 'title';
+while (1) {
+       foreach my $sock ( $sel->can_read(1) ) {
+               read_beef $sock;
+       }
+}
 
 #read_beef $input => '83';
 #read_beef $input => '81';
 #read_beef $input => '84';
 
-my $video = IO::Socket::INET->new(
-       PeerAddr => $ip,
-       PeerPort => 5901,
-) || die $!;
-
-print $video unpack('H*',"00000000010100100000424200000000");
-read($video, my $response, 16);
-warn "<< video ",hexdump( $response );
-
-read_beef $video => 'video';
-
 <STDIN>;
 
 close $input;