8 # Connect to DRAC video redirection port
10 # 2010-01-06 Dobrica Pavlinusic <dpavlin@rot13.org> GPLv3+
17 use Data::Dump qw(dump);
19 my $to = shift @ARGV || die "$0 root:password\@10.0.0.1\n";
21 my ( $user, $password, $ip ) = split(/[:\@]/, $to);
23 warn "# connect $user:$password\@$ip\n";
25 my $ua = LWP::UserAgent->new;
26 $ua->cookie_jar( {} );
28 warn "# logout $ip\n";
29 $ua->get( "https://$ip/cgi-bin/webcgi/logout" );
32 my $response = $ua->get( @_ );
33 if ( $response->header('Content-Type') =~ m{xml} ) {
34 my $xml = XMLin( $response->content );
38 warn $response->content;
39 return $response->content;
45 $ua->post( "https://$ip/cgi-bin/webcgi/login", [
47 password => $password,
50 my $state = get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=1" );
52 my $vKvmSessionId = $state->{object}->{property}->{vKvmSessionId} || die "no vKvmSessionId";
53 $vKvmSessionId = $vKvmSessionId->{value} || die "no vKvmSessionId.value";
55 warn "# vKvmSessionId $vKvmSessionId";
58 our $input = IO::Socket::SSL->new(
61 'SSL_version' => 'SSLv3',
62 'SSL_cipher_list' => 'RC4-MD5'
65 if ( !defined $input ) {
66 die "I encountered a problem: ", IO::Socket::SSL::errstr();
69 print STDERR "# input redirection $ip:5900\n";
72 print "SSL cipher: " . $input->get_cipher() . "\n";
73 print "Cert: " . $input->dump_peer_certificate() . "\n";
75 my $sel = IO::Select->new( $input );
78 my $hex = join(' ', @_);
85 my $hex = unpack('H*', $bytes);
86 $hex =~ s/(.{8})/$1 /g;
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
109 my $new = substr($auth,0,8) . $vKvmSessionId;
110 $new .= substr($auth,length($new), -3);
111 $new .= xx( $v_hash . '00' );
113 warn ">> ", $input->peerport, " | ", hexdump($new);
121 read($sock, my $header, 8);
123 warn "# no header from ", $sock->peerport, " $!" unless $once->{$sock}++;
129 my ($beef,$cmd,$len) = unpack('A4nn', $header);
131 warn "ASSERT: not BEEF but ",hexdump($beef) unless $beef eq 'BEEF';
132 warn "ASSERT: not response 0x8000" unless $cmd & 0x8000;
134 read($sock, my $packet, $len);
135 warn "<< ", $sock->peerport, " | ", hexdump( $header . $packet ), $/;
137 my $desc = unpack('H*', $cmd);
139 if ( $cmd == 0x8305 ) {
140 warn "# window title:", substr( $packet, 11 );
142 } elsif ( $cmd == 0x8420 ) {
143 warn " # connect to video $ip:5901\n";
145 my $video = IO::Socket::INET->new(
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;
154 # read($video, my $response, 16);
155 # warn "<< ", $video->peerport, " | ", hexdump( $response ), $/;
164 foreach my $sock ( $sel->can_read(1) ) {
169 #read_beef $input => '83';
170 #read_beef $input => '81';
171 #read_beef $input => '84';
180 my $input = IO::Socket::SSL->new("$ip:5900",
181 SSL_key => unpack("H*", $vKvmSessionId),
182 ) || die IO::Socket::SSL::errstr();
186 print $input unpack('H*', "00 00 00 00 01 01 00 10 00 00 00 ae 00 00 00 00") || die $!;
188 #print $input unpack("H*", $vKvmSessionId);
192 read($input, my $in, 16) || die $!;
193 warn "<< ",dump($in);
199 #get_response( "https://$ip/cgi-bin/webcgi/vkvmplugin?os=win&uglocale=en&version=3,1,1,116" );
201 get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=3" );
203 get_response( "https://$ip/cgi-bin/webcgi/winvkvm?state=0" );
205 $ua->get( "https://$ip/cgi-bin/webcgi/logout" );