Connect to DRAC video redirection port

diff --git a/bin/drac-vkvm.pl b/bin/drac-vkvm.pl
new file mode 100755 (executable)
index 0000000..9428e32
--- /dev/null
+++ b/bin/drac-vkvm.pl
@@ -0,0 +1,139 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+# 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 Data::Dump qw(dump);
+
+my $to = shift @ARGV || die "$0 root:password\@10.0.0.1\n";
+
+my ( $user, $password, $ip ) = split(/[:\@]/, $to);
+
+warn "# connect $user:$password\@$ip\n";
+
+my $ua = LWP::UserAgent->new;
+$ua->cookie_jar( {} );
+
+warn "# logout $ip\n";
+$ua->get( "https://$ip/cgi-bin/webcgi/logout" );
+
+sub get_response {
+       my $response = $ua->get( @_ );
+       if ( $response->header('Content-Type') =~ m{xml} ) {
+               my $xml = XMLin( $response->content );
+               warn dump $xml;
+               return $xml;
+       } else {
+               warn $response->content;
+               return $response->content;
+       }
+}
+
+warn "# login $ip\n";
+
+$ua->post( "https://$ip/cgi-bin/webcgi/login", [
+       user => $user,
+       password => $password,
+] );
+
+my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" );
+
+my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId}->{value} || die "no vKvmSessionId";
+
+warn "# vKvmSessionId $vKvmSessionId";
+
+
+my $client = IO::Socket::SSL->new(
+       PeerAddr          => $ip,
+       PeerPort          => 5900,
+       'SSL_version'     => 'SSLv3',
+       'SSL_cipher_list' => 'RC4-MD5'
+);
+
+if ( !defined $client ) {
+       die "I encountered a problem: ", IO::Socket::SSL::errstr();
+}
+else {
+       print STDERR "Connected to video redirection port $ip:5900!\n";
+}
+
+print "SSL cipher: " . $client->get_cipher() . "\n";
+print "Cert: " . $client->dump_peer_certificate() . "\n";
+
+
+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
+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 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 
+};
+
+$dump =~ s/\s+//gs;
+warn "# dump $dump";
+my $out = pack('H*', $dump);
+
+my $new = substr($out,0,8) . $vKvmSessionId;
+$new .= substr($out,length($new));
+
+warn dump($out,$new);
+print $client $new;
+
+read($client, my $header, 8);
+warn dump $header;
+my ($beef,$cmd,$len,$w,$h) = unpack('C4nnnn', $header);
+
+warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF';
+
+read($client, my $packet, $len);
+warn "# $w $h $len = ", dump( $header, $packet );
+
+<STDIN>;
+
+close $client;
+
+
+=for later
+
+my $client = 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 $client unpack("H*", $vKvmSessionId);
+
+warn "<<";
+
+read($client, my $in, 16) || die $!;
+warn "<< ",dump($in);
+
+close($client);
+
+=cut
+
+#get_response( "https://$ip/cgi-bin/webcgi/vkvmplugin?os=win&uglocale=en&version=3,1,1,116" );
+
+get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=3" );
+
+get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=0" );
+
+$ua->get( "https://$ip/cgi-bin/webcgi/logout" );