/[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 477 by dpavlin, Sun Jan 10 21:34:02 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 IO::Select;
17  use Data::Dump qw(dump);  use Data::Dump qw(dump);
18    
19  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 49  $ua->post( "https://$ip/cgi-bin/webcgi/l
49    
50  my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" );  my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" );
51    
52  my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId}->{value} || die "no vKvmSessionId";  my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId} || die "no vKvmSessionId";
53    $vKvmSessionId = $vKvmSessionId->{value} || die "no vKvmSessionId.value";
54    
55  warn "# vKvmSessionId $vKvmSessionId";  warn "# vKvmSessionId $vKvmSessionId";
56    
57    
58  my $client = IO::Socket::SSL->new(  our $input = IO::Socket::SSL->new(
59          PeerAddr          => $ip,          PeerAddr          => $ip,
60          PeerPort          => 5900,          PeerPort          => 5900,
61          'SSL_version'     => 'SSLv3',          'SSL_version'     => 'SSLv3',
62          'SSL_cipher_list' => 'RC4-MD5'          'SSL_cipher_list' => 'RC4-MD5'
63  );  ) || die $!;
64    
65  if ( !defined $client ) {  if ( !defined $input ) {
66          die "I encountered a problem: ", IO::Socket::SSL::errstr();          die "I encountered a problem: ", IO::Socket::SSL::errstr();
67  }  }
68  else {  else {
69          print STDERR "Connected to video redirection port $ip:5900!\n";          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  print "SSL cipher: " . $client->get_cipher() . "\n";  sub hexdump {
84  print "Cert: " . $client->dump_peer_certificate() . "\n";          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 $dump = qq{  my $auth = xx qq{
93  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
94  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
95  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
96  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
97  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
# Line 82  my $dump = qq{ Line 103  my $dump = qq{
103  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
104  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
105  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
106  00 00 01 00 00 00 4a 98  00  00 00 01 00 00 00 3e 8f  00
107  };  };
108    
109  $dump =~ s/\s+//gs;  my $new = substr($auth,0,8) . $vKvmSessionId;
110  warn "# dump $dump";  $new .= substr($auth,length($new), -3);
111  my $out = pack('H*', $dump);  $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 $new = substr($out,0,8) . $vKvmSessionId;          my $desc = unpack('H*', $cmd);
 $new .= substr($out,length($new));  
138    
139  warn dump($out,$new);          if ( $cmd == 0x8305 ) {
140  print $client $new;                  warn "# window title:", substr( $packet, 11 );
141    
142  read($client, my $header, 8);          } elsif ( $cmd == 0x8420 ) {
143  warn dump $header;                  warn " # connect to video $ip:5901\n";
 my ($beef,$cmd,$len,$w,$h) = unpack('C4nnnn', $header);  
144    
145  warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF';                  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($client, my $packet, $len);  #read_beef $input => '83';
170  warn "# $w $h $len = ", dump( $header, $packet );  #read_beef $input => '81';
171    #read_beef $input => '84';
172    
173  <STDIN>;  <STDIN>;
174    
175  close $client;  close $input;
176    
177    
178  =for later  =for later
179    
180  my $client = IO::Socket::SSL->new("$ip:5900",  my $input = IO::Socket::SSL->new("$ip:5900",
181          SSL_key => unpack("H*", $vKvmSessionId),          SSL_key => unpack("H*", $vKvmSessionId),
182  ) || die IO::Socket::SSL::errstr();  ) || die IO::Socket::SSL::errstr();
183    
184  warn ">>";  warn ">>";
185    
186  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 $!;
187    
188  #print $client unpack("H*", $vKvmSessionId);  #print $input unpack("H*", $vKvmSessionId);
189    
190  warn "<<";  warn "<<";
191    
192  read($client, my $in, 16) || die $!;  read($input, my $in, 16) || die $!;
193  warn "<< ",dump($in);  warn "<< ",dump($in);
194    
195  close($client);  close($input);
196    
197  =cut  =cut
198    
Legend:
Removed from v.475  
changed lines
  Added in v.477
  ViewVC Help
Powered by ViewVC 1.1.26