use warnings;
use strict;
+use autodie;
+
# Connect to DRAC video redirection port
#
# 2010-01-06 Dobrica Pavlinusic <dpavlin@rot13.org> GPLv3+
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";
my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" );
-my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId}->{value} || die "no vKvmSessionId";
+my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId} || die "no vKvmSessionId";
+$vKvmSessionId = $vKvmSessionId->{value} || die "no vKvmSessionId.value";
warn "# vKvmSessionId $vKvmSessionId";
-my $client = IO::Socket::SSL->new(
+our $input = IO::Socket::SSL->new(
PeerAddr => $ip,
PeerPort => 5900,
'SSL_version' => 'SSLv3',
'SSL_cipher_list' => 'RC4-MD5'
-);
+) || die $!;
-if ( !defined $client ) {
+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: " . $client->get_cipher() . "\n";
-print "Cert: " . $client->dump_peer_certificate() . "\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;
+ pack('H*', $hex);
+}
-my $dump = qq{
-42 45 45 46 01 02 00 d9 20 30 37 31 35 31 62 37
-62 38 62 64 64 66 32 61 32 64 61 64 37 63 36 30
-64 62 63 64 37 34 33 32 66 00 00 00 00 00 00 00
+sub hexdump {
+ my $bytes = shift;
+ my $hex = unpack('H*', $bytes);
+ $hex =~ s/(.{8})/$1 /g;
+ 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
+63 33 64 61 32 62 65 63 34 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
-00 00 01 00 00 00 4a 98 00
+00 00 01 00 00 00 3e 8f 00
};
-$dump =~ s/\s+//gs;
-warn "# dump $dump";
-my $out = pack('H*', $dump);
+my $new = substr($auth,0,8) . $vKvmSessionId;
+$new .= substr($auth,length($new), -3);
+$new .= xx( $v_hash . '00' );
+
+warn ">> ", $input->peerport, " | ", hexdump($new);
+print $input $new;
+
+our $once;
+
+sub read_beef {
+ my ($sock) = @_;
+
+ read($sock, my $header, 8);
+ if ( ! $header ) {
+ warn "# no header from ", $sock->peerport, " $!" unless $once->{$sock}++;
+ return;
+ }
+
+ $once->{$sock} = 0;
+
+ my ($beef,$cmd,$len) = unpack('A4nn', $header);
-my $new = substr($out,0,8) . $vKvmSessionId;
-$new .= substr($out,length($new));
+ warn "ASSERT: not BEEF but ",hexdump($beef) unless $beef eq 'BEEF';
+ warn "ASSERT: not response 0x8000" unless $cmd & 0x8000;
-warn dump($out,$new);
-print $client $new;
+ read($sock, my $packet, $len);
+ warn "<< ", $sock->peerport, " | ", hexdump( $header . $packet ), $/;
-read($client, my $header, 8);
-warn dump $header;
-my ($beef,$cmd,$len,$w,$h) = unpack('C4nnnn', $header);
+ my $desc = unpack('H*', $cmd);
-warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF';
+ 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 );
+
+ }
+
+}
+
+while (1) {
+ foreach my $sock ( $sel->can_read(1) ) {
+ read_beef $sock;
+ }
+}
-read($client, my $packet, $len);
-warn "# $w $h $len = ", dump( $header, $packet );
+#read_beef $input => '83';
+#read_beef $input => '81';
+#read_beef $input => '84';
<STDIN>;
-close $client;
+close $input;
=for later
-my $client = IO::Socket::SSL->new("$ip:5900",
+my $input = IO::Socket::SSL->new("$ip:5900",
SSL_key => unpack("H*", $vKvmSessionId),
) || die IO::Socket::SSL::errstr();
warn ">>";
-print $client unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") || die $!;
+print $input unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") || die $!;
-#print $client unpack("H*", $vKvmSessionId);
+#print $input unpack("H*", $vKvmSessionId);
warn "<<";
-read($client, my $in, 16) || die $!;
+read($input, my $in, 16) || die $!;
warn "<< ",dump($in);
-close($client);
+close($input);
=cut