/[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

Contents of /bin/drac-vkvm.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 477 - (show annotations)
Sun Jan 10 21:34:02 2010 UTC (11 years, 4 months ago) by dpavlin
File MIME type: text/plain
File size: 4674 byte(s)
use IO::Select to create async client

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" );

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26