/[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 476 - (show annotations)
Thu Jan 7 15:00:52 2010 UTC (9 years, 8 months ago) by dpavlin
File MIME type: text/plain
File size: 4224 byte(s)
cleanup code, try to connect to video port

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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26