3 |
use warnings; |
use warnings; |
4 |
use strict; |
use strict; |
5 |
|
|
6 |
|
use autodie; |
7 |
|
|
8 |
# Connect to DRAC video redirection port |
# Connect to DRAC video redirection port |
9 |
# |
# |
10 |
# 2010-01-06 Dobrica Pavlinusic <dpavlin@rot13.org> GPLv3+ |
# 2010-01-06 Dobrica Pavlinusic <dpavlin@rot13.org> GPLv3+ |
12 |
use LWP::UserAgent; |
use LWP::UserAgent; |
13 |
use XML::Simple; |
use XML::Simple; |
14 |
use IO::Socket::SSL; |
use IO::Socket::SSL; |
15 |
|
use IO::Socket::INET; |
16 |
use Data::Dump qw(dump); |
use Data::Dump qw(dump); |
17 |
|
|
18 |
my $to = shift @ARGV || die "$0 root:password\@10.0.0.1\n"; |
my $to = shift @ARGV || die "$0 root:password\@10.0.0.1\n"; |
48 |
|
|
49 |
my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" ); |
my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" ); |
50 |
|
|
51 |
my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId}->{value} || die "no vKvmSessionId"; |
my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId} || die "no vKvmSessionId"; |
52 |
|
$vKvmSessionId = $vKvmSessionId->{value} || die "no vKvmSessionId.value"; |
53 |
|
|
54 |
warn "# vKvmSessionId $vKvmSessionId"; |
warn "# vKvmSessionId $vKvmSessionId"; |
55 |
|
|
56 |
|
|
57 |
my $client = IO::Socket::SSL->new( |
our $input = IO::Socket::SSL->new( |
58 |
PeerAddr => $ip, |
PeerAddr => $ip, |
59 |
PeerPort => 5900, |
PeerPort => 5900, |
60 |
'SSL_version' => 'SSLv3', |
'SSL_version' => 'SSLv3', |
61 |
'SSL_cipher_list' => 'RC4-MD5' |
'SSL_cipher_list' => 'RC4-MD5' |
62 |
); |
) || die $!; |
63 |
|
|
64 |
if ( !defined $client ) { |
if ( !defined $input ) { |
65 |
die "I encountered a problem: ", IO::Socket::SSL::errstr(); |
die "I encountered a problem: ", IO::Socket::SSL::errstr(); |
66 |
} |
} |
67 |
else { |
else { |
68 |
print STDERR "Connected to video redirection port $ip:5900!\n"; |
print STDERR "Connected to video redirection port $ip:5900!\n"; |
69 |
} |
} |
70 |
|
|
71 |
print "SSL cipher: " . $client->get_cipher() . "\n"; |
print "SSL cipher: " . $input->get_cipher() . "\n"; |
72 |
print "Cert: " . $client->dump_peer_certificate() . "\n"; |
print "Cert: " . $input->dump_peer_certificate() . "\n"; |
73 |
|
|
74 |
|
sub xx { |
75 |
|
my $hex = join(' ', @_); |
76 |
|
$hex =~ s/\s+//gs; |
77 |
|
pack('H*', $hex); |
78 |
|
} |
79 |
|
|
80 |
|
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 $dump = qq{ |
my $auth = xx qq{ |
88 |
42 45 45 46 01 02 00 d9 20 30 37 31 35 31 62 37 |
42 45 45 46 01 02 00 d9 20 35 33 65 36 61 31 32 |
89 |
62 38 62 64 64 66 32 61 32 64 61 64 37 63 36 30 |
34 34 32 30 61 39 65 66 64 37 35 64 62 33 36 34 |
90 |
64 62 63 64 37 34 33 32 66 00 00 00 00 00 00 00 |
63 33 64 61 32 62 65 63 34 00 00 00 00 00 00 00 |
91 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
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 |
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 |
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 |
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 |
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 |
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 |
101 |
00 00 01 00 00 00 4a 98 00 |
00 00 01 00 00 00 3e 8f 00 |
102 |
}; |
}; |
103 |
|
|
104 |
$dump =~ s/\s+//gs; |
my $new = substr($auth,0,8) . $vKvmSessionId; |
105 |
warn "# dump $dump"; |
$new .= substr($auth,length($new), -3); |
106 |
my $out = pack('H*', $dump); |
$new .= "\x3e\x8f\x00"; |
107 |
|
|
108 |
my $new = substr($out,0,8) . $vKvmSessionId; |
warn ">> auth ", hexdump($new); |
109 |
$new .= substr($out,length($new)); |
print $input $new; |
110 |
|
|
111 |
warn dump($out,$new); |
sub read_beef { |
112 |
print $client $new; |
my ($sock,$desc) = @_; |
113 |
|
|
114 |
|
read($sock, my $header, 8); |
115 |
|
warn "<< header $desc ", hexdump $header; |
116 |
|
my ($beef,$cmd,$block,$len) = unpack('A4CCn', $header); |
117 |
|
|
118 |
|
warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF'; |
119 |
|
warn "not response 0x8000" unless $cmd & 0x8000; |
120 |
|
|
121 |
|
read($sock, my $packet, $len); |
122 |
|
warn "<< $desc $len ", hexdump( $header . $packet ); |
123 |
|
|
124 |
|
if ( $cmd == 0x83 ) { |
125 |
|
warn "S>C session response"; |
126 |
|
} elsif ( $cmd == 0x82 ) { |
127 |
|
warn "S>V video update"; |
128 |
|
} |
129 |
|
} |
130 |
|
|
131 |
read($client, my $header, 8); |
read_beef $input => 'title'; |
|
warn dump $header; |
|
|
my ($beef,$cmd,$len,$w,$h) = unpack('C4nnnn', $header); |
|
132 |
|
|
133 |
warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF'; |
#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($client, my $packet, $len); |
read_beef $video => 'video'; |
|
warn "# $w $h $len = ", dump( $header, $packet ); |
|
147 |
|
|
148 |
<STDIN>; |
<STDIN>; |
149 |
|
|
150 |
close $client; |
close $input; |
151 |
|
|
152 |
|
|
153 |
=for later |
=for later |
154 |
|
|
155 |
my $client = IO::Socket::SSL->new("$ip:5900", |
my $input = IO::Socket::SSL->new("$ip:5900", |
156 |
SSL_key => unpack("H*", $vKvmSessionId), |
SSL_key => unpack("H*", $vKvmSessionId), |
157 |
) || die IO::Socket::SSL::errstr(); |
) || die IO::Socket::SSL::errstr(); |
158 |
|
|
159 |
warn ">>"; |
warn ">>"; |
160 |
|
|
161 |
print $client unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") || die $!; |
print $input unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") || die $!; |
162 |
|
|
163 |
#print $client unpack("H*", $vKvmSessionId); |
#print $input unpack("H*", $vKvmSessionId); |
164 |
|
|
165 |
warn "<<"; |
warn "<<"; |
166 |
|
|
167 |
read($client, my $in, 16) || die $!; |
read($input, my $in, 16) || die $!; |
168 |
warn "<< ",dump($in); |
warn "<< ",dump($in); |
169 |
|
|
170 |
close($client); |
close($input); |
171 |
|
|
172 |
=cut |
=cut |
173 |
|
|