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 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" );
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	477	use IO::Select;
17	dpavlin	475	use Data::Dump qw(dump);
18
19			my $to = shift @ARGV \|\| die "$0 root:password\@10.0.0.1\n";
20
21			my ( $user, $password, $ip ) = split(/[:\@]/, $to);
22
23			warn "# connect $user:$password\@$ip\n";
24
25			my $ua = LWP::UserAgent->new;
26			$ua->cookie_jar( {} );
27
28			warn "# logout $ip\n";
29			$ua->get( "https://$ip/cgi-bin/webcgi/logout" );
30
31			sub get_response {
32			my $response = $ua->get( @_ );
33			if ( $response->header('Content-Type') =~ m{xml} ) {
34			my $xml = XMLin( $response->content );
35			warn dump $xml;
36			return $xml;
37			} else {
38			warn $response->content;
39			return $response->content;
40			}
41			}
42
43			warn "# login $ip\n";
44
45			$ua->post( "https://$ip/cgi-bin/webcgi/login", [
46			user => $user,
47			password => $password,
48			] );
49
50			my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" );
51
52	dpavlin	476	my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId} \|\| die "no vKvmSessionId";
53			$vKvmSessionId = $vKvmSessionId->{value} \|\| die "no vKvmSessionId.value";
54	dpavlin	475
55			warn "# vKvmSessionId $vKvmSessionId";
56
57
58	dpavlin	476	our $input = IO::Socket::SSL->new(
59	dpavlin	475	PeerAddr => $ip,
60			PeerPort => 5900,
61			'SSL_version' => 'SSLv3',
62			'SSL_cipher_list' => 'RC4-MD5'
63	dpavlin	476	) \|\| die $!;
64	dpavlin	475
65	dpavlin	476	if ( !defined $input ) {
66	dpavlin	475	die "I encountered a problem: ", IO::Socket::SSL::errstr();
67			}
68			else {
69	dpavlin	477	print STDERR "# input redirection $ip:5900\n";
70	dpavlin	475	}
71
72	dpavlin	476	print "SSL cipher: " . $input->get_cipher() . "\n";
73			print "Cert: " . $input->dump_peer_certificate() . "\n";
74	dpavlin	475
75	dpavlin	477	my $sel = IO::Select->new( $input );
76
77	dpavlin	476	sub xx {
78			my $hex = join(' ', @_);
79			$hex =~ s/\s+//gs;
80			pack('H*', $hex);
81			}
82	dpavlin	475
83	dpavlin	476	sub hexdump {
84			my $bytes = shift;
85			my $hex = unpack('H*', $bytes);
86			$hex =~ s/(.{8})/$1 /g;
87			return $hex;
88			}
89
90	dpavlin	477	my $v_hash = "3e 8f";
91
92	dpavlin	476	my $auth = xx qq{
93			42 45 45 46 01 02 00 d9 20 35 33 65 36 61 31 32
94			34 34 32 30 61 39 65 66 64 37 35 64 62 33 36 34
95			63 33 64 61 32 62 65 63 34 00 00 00 00 00 00 00
96	dpavlin	475	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			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
102			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
103			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
104			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
105			00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
106	dpavlin	476	00 00 01 00 00 00 3e 8f 00
107	dpavlin	475	};
108
109	dpavlin	476	my $new = substr($auth,0,8) . $vKvmSessionId;
110			$new .= substr($auth,length($new), -3);
111	dpavlin	477	$new .= xx( $v_hash . '00' );
112	dpavlin	475
113	dpavlin	477	warn ">> ", $input->peerport, " \| ", hexdump($new);
114	dpavlin	476	print $input $new;
115	dpavlin	475
116	dpavlin	477	our $once;
117
118	dpavlin	476	sub read_beef {
119	dpavlin	477	my ($sock) = @_;
120	dpavlin	475
121	dpavlin	476	read($sock, my $header, 8);
122	dpavlin	477	if ( ! $header ) {
123			warn "# no header from ", $sock->peerport, " $!" unless $once->{$sock}++;
124			return;
125			}
126	dpavlin	475
127	dpavlin	477	$once->{$sock} = 0;
128	dpavlin	475
129	dpavlin	477	my ($beef,$cmd,$len) = unpack('A4nn', $header);
130
131			warn "ASSERT: not BEEF but ",hexdump($beef) unless $beef eq 'BEEF';
132			warn "ASSERT: not response 0x8000" unless $cmd & 0x8000;
133
134	dpavlin	476	read($sock, my $packet, $len);
135	dpavlin	477	warn "<< ", $sock->peerport, " \| ", hexdump( $header . $packet ), $/;
136	dpavlin	475
137	dpavlin	477	my $desc = unpack('H*', $cmd);
138
139			if ( $cmd == 0x8305 ) {
140			warn "# window title:", substr( $packet, 11 );
141
142			} elsif ( $cmd == 0x8420 ) {
143			warn " # connect to video $ip:5901\n";
144
145			my $video = IO::Socket::INET->new(
146			PeerAddr => $ip,
147			PeerPort => 5901,
148			) \|\| die $!;
149
150			my $v_auth = xx "0000 0000 0101 0010 0000 $v_hash 0000 0000";
151			warn ">> ", $video->peerport, " \| ", hexdump($v_auth), $/;
152			print $video $v_auth;
153
154			# read($video, my $response, 16);
155			# warn "<< ", $video->peerport, " \| ", hexdump( $response ), $/;
156
157			$sel->add( $video );
158
159	dpavlin	476	}
160	dpavlin	477
161	dpavlin	476	}
162
163	dpavlin	477	while (1) {
164			foreach my $sock ( $sel->can_read(1) ) {
165			read_beef $sock;
166			}
167			}
168	dpavlin	476
169			#read_beef $input => '83';
170			#read_beef $input => '81';
171			#read_beef $input => '84';
172
173	dpavlin	475	<STDIN>;
174
175	dpavlin	476	close $input;
176	dpavlin	475
177
178			=for later
179
180	dpavlin	476	my $input = IO::Socket::SSL->new("$ip:5900",
181	dpavlin	475	SSL_key => unpack("H*", $vKvmSessionId),
182			) \|\| die IO::Socket::SSL::errstr();
183
184			warn ">>";
185
186	dpavlin	476	print $input unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") \|\| die $!;
187	dpavlin	475
188	dpavlin	476	#print $input unpack("H*", $vKvmSessionId);
189	dpavlin	475
190			warn "<<";
191
192	dpavlin	476	read($input, my $in, 16) \|\| die $!;
193	dpavlin	475	warn "<< ",dump($in);
194
195	dpavlin	476	close($input);
196	dpavlin	475
197			=cut
198
199			#get_response( "https://$ip/cgi-bin/webcgi/vkvmplugin?os=win&uglocale=en&version=3,1,1,116" );
200
201			get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=3" );
202
203			get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=0" );
204
205			$ua->get( "https://$ip/cgi-bin/webcgi/logout" );