| 1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
use warnings; |
| 4 |
use strict; |
| 5 |
|
| 6 |
use autodie; |
| 7 |
|
| 8 |
# 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 |
use IO::Socket::INET; |
| 16 |
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 |
my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId} || die "no vKvmSessionId"; |
| 52 |
$vKvmSessionId = $vKvmSessionId->{value} || die "no vKvmSessionId.value"; |
| 53 |
|
| 54 |
warn "# vKvmSessionId $vKvmSessionId"; |
| 55 |
|
| 56 |
|
| 57 |
our $input = IO::Socket::SSL->new( |
| 58 |
PeerAddr => $ip, |
| 59 |
PeerPort => 5900, |
| 60 |
'SSL_version' => 'SSLv3', |
| 61 |
'SSL_cipher_list' => 'RC4-MD5' |
| 62 |
) || die $!; |
| 63 |
|
| 64 |
if ( !defined $input ) { |
| 65 |
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 |
print "SSL cipher: " . $input->get_cipher() . "\n"; |
| 72 |
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 $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 |
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 |
00 00 01 00 00 00 3e 8f 00 |
| 102 |
}; |
| 103 |
|
| 104 |
my $new = substr($auth,0,8) . $vKvmSessionId; |
| 105 |
$new .= substr($auth,length($new), -3); |
| 106 |
$new .= "\x3e\x8f\x00"; |
| 107 |
|
| 108 |
warn ">> auth ", hexdump($new); |
| 109 |
print $input $new; |
| 110 |
|
| 111 |
sub read_beef { |
| 112 |
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_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 |
<STDIN>; |
| 149 |
|
| 150 |
close $input; |
| 151 |
|
| 152 |
|
| 153 |
=for later |
| 154 |
|
| 155 |
my $input = IO::Socket::SSL->new("$ip:5900", |
| 156 |
SSL_key => unpack("H*", $vKvmSessionId), |
| 157 |
) || die IO::Socket::SSL::errstr(); |
| 158 |
|
| 159 |
warn ">>"; |
| 160 |
|
| 161 |
print $input unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") || die $!; |
| 162 |
|
| 163 |
#print $input unpack("H*", $vKvmSessionId); |
| 164 |
|
| 165 |
warn "<<"; |
| 166 |
|
| 167 |
read($input, my $in, 16) || die $!; |
| 168 |
warn "<< ",dump($in); |
| 169 |
|
| 170 |
close($input); |
| 171 |
|
| 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" ); |
Parent Directory
| 
Revision Log