/[pxelator]/bin/drac-vkvm.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /bin/drac-vkvm.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 475 by dpavlin, Wed Jan 6 19:40:21 2010 UTC revision 476 by dpavlin, Thu Jan 7 15:00:52 2010 UTC
# Line 3  Line 3 
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+
# Line 10  use strict; Line 12  use strict;
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";
# Line 45  $ua->post( "https://$ip/cgi-bin/webcgi/l Line 48  $ua->post( "https://$ip/cgi-bin/webcgi/l
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
# Line 82  my $dump = qq{ Line 98  my $dump = qq{
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    
Legend:
Removed from v.475  
changed lines
  Added in v.476
  ViewVC Help
Powered by ViewVC 1.1.26