Repository List / pxelator / bin / drac-vkvm.pl @ HEAD

#!/usr/bin/perl

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 ( $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} || die "no vKvmSessionId";
$vKvmSessionId = $vKvmSessionId->{value} || die "no vKvmSessionId.value";

warn "# vKvmSessionId $vKvmSessionId";


our $input = IO::Socket::SSL->new(
	PeerAddr          => $ip,
	PeerPort          => 5900,
	'SSL_version'     => 'SSLv3',
	'SSL_cipher_list' => 'RC4-MD5'
) || die $!;

if ( !defined $input ) {
	die "I encountered a problem: ", IO::Socket::SSL::errstr();
}
else {
	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;
	pack('H*', $hex);
}

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 00 00 00 00 00 00  00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00  00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00  00 00 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 3e 8f  00
};

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);

	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 "<< ", $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 );

	}

}

while (1) {
	foreach my $sock ( $sel->can_read(1) ) {
		read_beef $sock;
	}
}

#read_beef $input => '83';
#read_beef $input => '81';
#read_beef $input => '84';

<STDIN>;

close $input;


=for later

my $input = IO::Socket::SSL->new("$ip:5900",
	SSL_key => unpack("H*", $vKvmSessionId),
) || die IO::Socket::SSL::errstr();

warn ">>";

print $input unpack('H*', "00 00 00 00 01 01 00 10  00 00 00 ae 00 00 00 00") || die $!;

#print $input unpack("H*", $vKvmSessionId);

warn "<<";

read($input, my $in, 16) || die $!;
warn "<< ",dump($in);

close($input);

=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" );