#!/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" );
