/[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 476 by dpavlin, Thu Jan 7 15:00:52 2010 UTC revision 477 by dpavlin, Sun Jan 10 21:34:02 2010 UTC
# Line 13  use LWP::UserAgent; Line 13  use LWP::UserAgent;
13  use XML::Simple;  use XML::Simple;
14  use IO::Socket::SSL;  use IO::Socket::SSL;
15  use IO::Socket::INET;  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 65  if ( !defined $input ) { Line 66  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";  print "SSL cipher: " . $input->get_cipher() . "\n";
73  print "Cert: " . $input->dump_peer_certificate() . "\n";  print "Cert: " . $input->dump_peer_certificate() . "\n";
74    
75    my $sel = IO::Select->new( $input );
76    
77  sub xx {  sub xx {
78          my $hex = join(' ', @_);          my $hex = join(' ', @_);
79          $hex =~ s/\s+//gs;          $hex =~ s/\s+//gs;
# Line 84  sub hexdump { Line 87  sub hexdump {
87          return $hex;          return $hex;
88  }  }
89    
90    my $v_hash = "3e 8f";
91    
92  my $auth = xx qq{  my $auth = xx qq{
93  42 45 45 46 01 02 00 d9  20 35 33 65 36 61 31 32  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  34 34 32 30 61 39 65 66  64 37 35 64 62 33 36 34
# Line 103  my $auth = xx qq{ Line 108  my $auth = xx qq{
108    
109  my $new = substr($auth,0,8) . $vKvmSessionId;  my $new = substr($auth,0,8) . $vKvmSessionId;
110  $new .= substr($auth,length($new), -3);  $new .= substr($auth,length($new), -3);
111  $new .= "\x3e\x8f\x00";  $new .= xx( $v_hash . '00' );
112    
113  warn ">> auth ", hexdump($new);  warn ">> ", $input->peerport, " | ", hexdump($new);
114  print $input $new;  print $input $new;
115    
116    our $once;
117    
118  sub read_beef {  sub read_beef {
119          my ($sock,$desc) = @_;          my ($sock) = @_;
120    
121          read($sock, my $header, 8);          read($sock, my $header, 8);
122          warn "<< header $desc ", hexdump $header;          if ( ! $header ) {
123          my ($beef,$cmd,$block,$len) = unpack('A4CCn', $header);                  warn "# no header from ", $sock->peerport, " $!" unless $once->{$sock}++;
124                    return;
125            }
126    
127            $once->{$sock} = 0;
128    
129          warn "not BEEF but ",dump($beef) unless $beef eq 'BEEF';          my ($beef,$cmd,$len) = unpack('A4nn', $header);
130          warn "not response 0x8000" unless $cmd & 0x8000;  
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);          read($sock, my $packet, $len);
135          warn "<< $desc $len ", hexdump( $header . $packet );          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    
         if ( $cmd == 0x83 ) {  
                 warn "S>C session response";  
         } elsif ( $cmd == 0x82 ) {  
                 warn "S>V video update";  
159          }          }
160    
161  }  }
162    
163  read_beef $input => 'title';  while (1) {
164            foreach my $sock ( $sel->can_read(1) ) {
165                    read_beef $sock;
166            }
167    }
168    
169  #read_beef $input => '83';  #read_beef $input => '83';
170  #read_beef $input => '81';  #read_beef $input => '81';
171  #read_beef $input => '84';  #read_beef $input => '84';
172    
 my $video = IO::Socket::INET->new(  
         PeerAddr => $ip,  
         PeerPort => 5901,  
 ) || die $!;  
   
 print $video unpack('H*',"00000000010100100000424200000000");  
 read($video, my $response, 16);  
 warn "<< video ",hexdump( $response );  
   
 read_beef $video => 'video';  
   
173  <STDIN>;  <STDIN>;
174    
175  close $input;  close $input;
Legend:
Removed from v.476  
changed lines
  Added in v.477
  ViewVC Help
Powered by ViewVC 1.1.26