git.rot13.org Git - pxelator/blob - bin/drac-vkvm.pl

   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 IO::Select;
  17 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 my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId} || die "no vKvmSessionId";
  53 $vKvmSessionId = $vKvmSessionId->{value} || die "no vKvmSessionId.value";
  54
  55 warn "# vKvmSessionId $vKvmSessionId";
  56
  57
  58 our $input = IO::Socket::SSL->new(
  59         PeerAddr          => $ip,
  60         PeerPort          => 5900,
  61         'SSL_version'     => 'SSLv3',
  62         'SSL_cipher_list' => 'RC4-MD5'
  63 ) || die $!;
  64
  65 if ( !defined $input ) {
  66         die "I encountered a problem: ", IO::Socket::SSL::errstr();
  67 }
  68 else {
  69         print STDERR "# input redirection $ip:5900\n";
  70 }
  71
  72 print "SSL cipher: " . $input->get_cipher() . "\n";
  73 print "Cert: " . $input->dump_peer_certificate() . "\n";
  74
  75 my $sel = IO::Select->new( $input );
  76
  77 sub xx {
  78         my $hex = join(' ', @_);
  79         $hex =~ s/\s+//gs;
  80         pack('H*', $hex);
  81 }
  82
  83 sub hexdump {
  84         my $bytes = shift;
  85         my $hex = unpack('H*', $bytes);
  86         $hex =~ s/(.{8})/$1 /g;
  87         return $hex;
  88 }
  89
  90 my $v_hash = "3e 8f";
  91
  92 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 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 00 00 01 00 00 00 3e 8f  00
 107 };
 108
 109 my $new = substr($auth,0,8) . $vKvmSessionId;
 110 $new .= substr($auth,length($new), -3);
 111 $new .= xx( $v_hash . '00' );
 112
 113 warn ">> ", $input->peerport, " | ", hexdump($new);
 114 print $input $new;
 115
 116 our $once;
 117
 118 sub read_beef {
 119         my ($sock) = @_;
 120
 121         read($sock, my $header, 8);
 122         if ( ! $header ) {
 123                 warn "# no header from ", $sock->peerport, " $!" unless $once->{$sock}++;
 124                 return;
 125         }
 126
 127         $once->{$sock} = 0;
 128
 129         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         read($sock, my $packet, $len);
 135         warn "<< ", $sock->peerport, " | ", hexdump( $header . $packet ), $/;
 136
 137         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         }
 160
 161 }
 162
 163 while (1) {
 164         foreach my $sock ( $sel->can_read(1) ) {
 165                 read_beef $sock;
 166         }
 167 }
 168
 169 #read_beef $input => '83';
 170 #read_beef $input => '81';
 171 #read_beef $input => '84';
 172
 173 <STDIN>;
 174
 175 close $input;
 176
 177
 178 =for later
 179
 180 my $input = IO::Socket::SSL->new("$ip:5900",
 181         SSL_key => unpack("H*", $vKvmSessionId),
 182 ) || die IO::Socket::SSL::errstr();
 183
 184 warn ">>";
 185
 186 print $input unpack('H*', "00 00 00 00 01 01 00 10  00 00 00 ae 00 00 00 00") || die $!;
 187
 188 #print $input unpack("H*", $vKvmSessionId);
 189
 190 warn "<<";
 191
 192 read($input, my $in, 16) || die $!;
 193 warn "<< ",dump($in);
 194
 195 close($input);
 196
 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" );