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