pxelator/bin/drac-vkvm.pl

#!/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 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 "Connected to video redirection port $ip:5900!\n";
}

print "SSL cipher: " . $input->get_cipher() . "\n";
print "Cert: " . $input->dump_peer_certificate() . "\n";

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 $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 .= "\x3e\x8f\x00";

warn ">> auth ", hexdump($new);
print $input $new;

sub read_beef {
        my ($sock,$desc) = @_;

        read($sock, my $header, 8);
        warn "<< header $desc ", hexdump $header;
        my ($beef,$cmd,$block,$len) = unpack('A4CCn', $header);

        warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF';
        warn "not response 0x8000" unless $cmd & 0x8000;

        read($sock, my $packet, $len);
        warn "<< $desc $len ", hexdump( $header . $packet );

        if ( $cmd == 0x83 ) {
                warn "S>C session response";
        } elsif ( $cmd == 0x82 ) {
                warn "S>V video update";
        }
}

read_beef $input => 'title';

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


=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" );
1	dpavlin	475	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6	dpavlin	476	use autodie;
7
8	dpavlin	475	# Connect to DRAC video redirection port
9			#
10			# 2010-01-06 Dobrica Pavlinusic <dpavlin@rot13.org> GPLv3+
11
12			use LWP::UserAgent;
13			use XML::Simple;
14			use IO::Socket::SSL;
15	dpavlin	476	use IO::Socket::INET;
16	dpavlin	475	use Data::Dump qw(dump);
17
18			my $to = shift @ARGV \|\| die "$0 root:password\@10.0.0.1\n";
19
20			my ( $user, $password, $ip ) = split(/[:\@]/, $to);
21
22			warn "# connect $user:$password\@$ip\n";
23
24			my $ua = LWP::UserAgent->new;
25			$ua->cookie_jar( {} );
26
27			warn "# logout $ip\n";
28			$ua->get( "https://$ip/cgi-bin/webcgi/logout" );
29
30			sub get_response {
31			my $response = $ua->get( @_ );
32			if ( $response->header('Content-Type') =~ m{xml} ) {
33			my $xml = XMLin( $response->content );
34			warn dump $xml;
35			return $xml;
36			} else {
37			warn $response->content;
38			return $response->content;
39			}
40			}
41
42			warn "# login $ip\n";
43
44			$ua->post( "https://$ip/cgi-bin/webcgi/login", [
45			user => $user,
46			password => $password,
47			] );
48
49			my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" );
50
51	dpavlin	476	my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId} \|\| die "no vKvmSessionId";
52			$vKvmSessionId = $vKvmSessionId->{value} \|\| die "no vKvmSessionId.value";
53	dpavlin	475
54			warn "# vKvmSessionId $vKvmSessionId";
55
56
57	dpavlin	476	our $input = IO::Socket::SSL->new(
58	dpavlin	475	PeerAddr => $ip,
59			PeerPort => 5900,
60			'SSL_version' => 'SSLv3',
61			'SSL_cipher_list' => 'RC4-MD5'
62	dpavlin	476	) \|\| die $!;
63	dpavlin	475
64	dpavlin	476	if ( !defined $input ) {
65	dpavlin	475	die "I encountered a problem: ", IO::Socket::SSL::errstr();
66			}
67			else {
68			print STDERR "Connected to video redirection port $ip:5900!\n";
69			}
70
71	dpavlin	476	print "SSL cipher: " . $input->get_cipher() . "\n";
72			print "Cert: " . $input->dump_peer_certificate() . "\n";
73	dpavlin	475
74	dpavlin	476	sub xx {
75			my $hex = join(' ', @_);
76			$hex =~ s/\s+//gs;
77			pack('H*', $hex);
78			}
79	dpavlin	475
80	dpavlin	476	sub hexdump {
81			my $bytes = shift;
82			my $hex = unpack('H*', $bytes);
83			$hex =~ s/(.{8})/$1 /g;
84			return $hex;
85			}
86
87			my $auth = xx qq{
88			42 45 45 46 01 02 00 d9 20 35 33 65 36 61 31 32
89			34 34 32 30 61 39 65 66 64 37 35 64 62 33 36 34
90			63 33 64 61 32 62 65 63 34 00 00 00 00 00 00 00
91	dpavlin	475	00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
92			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
93			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
94			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
95			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
96			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
97			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
98			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
99			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
100			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
101	dpavlin	476	00 00 01 00 00 00 3e 8f 00
102	dpavlin	475	};
103
104	dpavlin	476	my $new = substr($auth,0,8) . $vKvmSessionId;
105			$new .= substr($auth,length($new), -3);
106			$new .= "\x3e\x8f\x00";
107	dpavlin	475
108	dpavlin	476	warn ">> auth ", hexdump($new);
109			print $input $new;
110	dpavlin	475
111	dpavlin	476	sub read_beef {
112			my ($sock,$desc) = @_;
113	dpavlin	475
114	dpavlin	476	read($sock, my $header, 8);
115			warn "<< header $desc ", hexdump $header;
116			my ($beef,$cmd,$block,$len) = unpack('A4CCn', $header);
117	dpavlin	475
118	dpavlin	476	warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF';
119			warn "not response 0x8000" unless $cmd & 0x8000;
120	dpavlin	475
121	dpavlin	476	read($sock, my $packet, $len);
122			warn "<< $desc $len ", hexdump( $header . $packet );
123	dpavlin	475
124	dpavlin	476	if ( $cmd == 0x83 ) {
125			warn "S>C session response";
126			} elsif ( $cmd == 0x82 ) {
127			warn "S>V video update";
128			}
129			}
130
131			read_beef $input => 'title';
132
133			#read_beef $input => '83';
134			#read_beef $input => '81';
135			#read_beef $input => '84';
136
137			my $video = IO::Socket::INET->new(
138			PeerAddr => $ip,
139			PeerPort => 5901,
140			) \|\| die $!;
141
142			print $video unpack('H*',"00000000010100100000424200000000");
143			read($video, my $response, 16);
144			warn "<< video ",hexdump( $response );
145
146			read_beef $video => 'video';
147
148	dpavlin	475	<STDIN>;
149
150	dpavlin	476	close $input;
151	dpavlin	475
152
153			=for later
154
155	dpavlin	476	my $input = IO::Socket::SSL->new("$ip:5900",
156	dpavlin	475	SSL_key => unpack("H*", $vKvmSessionId),
157			) \|\| die IO::Socket::SSL::errstr();
158
159			warn ">>";
160
161	dpavlin	476	print $input unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") \|\| die $!;
162	dpavlin	475
163	dpavlin	476	#print $input unpack("H*", $vKvmSessionId);
164	dpavlin	475
165			warn "<<";
166
167	dpavlin	476	read($input, my $in, 16) \|\| die $!;
168	dpavlin	475	warn "<< ",dump($in);
169
170	dpavlin	476	close($input);
171	dpavlin	475
172			=cut
173
174			#get_response( "https://$ip/cgi-bin/webcgi/vkvmplugin?os=win&uglocale=en&version=3,1,1,116" );
175
176			get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=3" );
177
178			get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=0" );
179
180			$ua->get( "https://$ip/cgi-bin/webcgi/logout" );