1 |
#!/usr/bin/perl |
2 |
|
3 |
use warnings; |
4 |
use strict; |
5 |
|
6 |
# Connect to DRAC video redirection port |
7 |
# |
8 |
# 2010-01-06 Dobrica Pavlinusic <dpavlin@rot13.org> GPLv3+ |
9 |
|
10 |
use LWP::UserAgent; |
11 |
use XML::Simple; |
12 |
use IO::Socket::SSL; |
13 |
use Data::Dump qw(dump); |
14 |
|
15 |
my $to = shift @ARGV || die "$0 root:password\@10.0.0.1\n"; |
16 |
|
17 |
my ( $user, $password, $ip ) = split(/[:\@]/, $to); |
18 |
|
19 |
warn "# connect $user:$password\@$ip\n"; |
20 |
|
21 |
my $ua = LWP::UserAgent->new; |
22 |
$ua->cookie_jar( {} ); |
23 |
|
24 |
warn "# logout $ip\n"; |
25 |
$ua->get( "https://$ip/cgi-bin/webcgi/logout" ); |
26 |
|
27 |
sub get_response { |
28 |
my $response = $ua->get( @_ ); |
29 |
if ( $response->header('Content-Type') =~ m{xml} ) { |
30 |
my $xml = XMLin( $response->content ); |
31 |
warn dump $xml; |
32 |
return $xml; |
33 |
} else { |
34 |
warn $response->content; |
35 |
return $response->content; |
36 |
} |
37 |
} |
38 |
|
39 |
warn "# login $ip\n"; |
40 |
|
41 |
$ua->post( "https://$ip/cgi-bin/webcgi/login", [ |
42 |
user => $user, |
43 |
password => $password, |
44 |
] ); |
45 |
|
46 |
my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" ); |
47 |
|
48 |
my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId}->{value} || die "no vKvmSessionId"; |
49 |
|
50 |
warn "# vKvmSessionId $vKvmSessionId"; |
51 |
|
52 |
|
53 |
my $client = IO::Socket::SSL->new( |
54 |
PeerAddr => $ip, |
55 |
PeerPort => 5900, |
56 |
'SSL_version' => 'SSLv3', |
57 |
'SSL_cipher_list' => 'RC4-MD5' |
58 |
); |
59 |
|
60 |
if ( !defined $client ) { |
61 |
die "I encountered a problem: ", IO::Socket::SSL::errstr(); |
62 |
} |
63 |
else { |
64 |
print STDERR "Connected to video redirection port $ip:5900!\n"; |
65 |
} |
66 |
|
67 |
print "SSL cipher: " . $client->get_cipher() . "\n"; |
68 |
print "Cert: " . $client->dump_peer_certificate() . "\n"; |
69 |
|
70 |
|
71 |
my $dump = qq{ |
72 |
42 45 45 46 01 02 00 d9 20 30 37 31 35 31 62 37 |
73 |
62 38 62 64 64 66 32 61 32 64 61 64 37 63 36 30 |
74 |
64 62 63 64 37 34 33 32 66 00 00 00 00 00 00 00 |
75 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
76 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
77 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
78 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
79 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
80 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
81 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
82 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
83 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
84 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
85 |
00 00 01 00 00 00 4a 98 00 |
86 |
}; |
87 |
|
88 |
$dump =~ s/\s+//gs; |
89 |
warn "# dump $dump"; |
90 |
my $out = pack('H*', $dump); |
91 |
|
92 |
my $new = substr($out,0,8) . $vKvmSessionId; |
93 |
$new .= substr($out,length($new)); |
94 |
|
95 |
warn dump($out,$new); |
96 |
print $client $new; |
97 |
|
98 |
read($client, my $header, 8); |
99 |
warn dump $header; |
100 |
my ($beef,$cmd,$len,$w,$h) = unpack('C4nnnn', $header); |
101 |
|
102 |
warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF'; |
103 |
|
104 |
read($client, my $packet, $len); |
105 |
warn "# $w $h $len = ", dump( $header, $packet ); |
106 |
|
107 |
<STDIN>; |
108 |
|
109 |
close $client; |
110 |
|
111 |
|
112 |
=for later |
113 |
|
114 |
my $client = IO::Socket::SSL->new("$ip:5900", |
115 |
SSL_key => unpack("H*", $vKvmSessionId), |
116 |
) || die IO::Socket::SSL::errstr(); |
117 |
|
118 |
warn ">>"; |
119 |
|
120 |
print $client unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") || die $!; |
121 |
|
122 |
#print $client unpack("H*", $vKvmSessionId); |
123 |
|
124 |
warn "<<"; |
125 |
|
126 |
read($client, my $in, 16) || die $!; |
127 |
warn "<< ",dump($in); |
128 |
|
129 |
close($client); |
130 |
|
131 |
=cut |
132 |
|
133 |
#get_response( "https://$ip/cgi-bin/webcgi/vkvmplugin?os=win&uglocale=en&version=3,1,1,116" ); |
134 |
|
135 |
get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=3" ); |
136 |
|
137 |
get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=0" ); |
138 |
|
139 |
$ua->get( "https://$ip/cgi-bin/webcgi/logout" ); |