From 66e9aa2323c8ea2e6fcf338114c94786e2678e3d Mon Sep 17 00:00:00 2001 From: Dobrica Pavlinusic Date: Sun, 3 Jan 2010 23:32:46 +0100 Subject: [PATCH] import from Internet Archive --- VNC/Codec.pm | 221 +++++++++++++++ VNC/Server.pm | 149 ++++++++++ VNC/ServerConnection.pm | 610 ++++++++++++++++++++++++++++++++++++++++ life.pl | 171 +++++++++++ main.pl | 58 ++++ 5 files changed, 1209 insertions(+) create mode 100755 VNC/Codec.pm create mode 100755 VNC/Server.pm create mode 100755 VNC/ServerConnection.pm create mode 100755 life.pl create mode 100755 main.pl diff --git a/VNC/Codec.pm b/VNC/Codec.pm new file mode 100755 index 0000000..c3f5d9b --- /dev/null +++ b/VNC/Codec.pm @@ -0,0 +1,221 @@ +package VNC::Codec; + +require 5.002; # becase we use prototypes + +use Socket; +use warnings; +use strict; +use vars qw(@ISA @EXPORT_OK); +require Exporter; +@ISA = qw(Exporter); +@EXPORT_OK = qw(VNC_PIXELFORMAT_32BPP_RGB888 VNC_PIXELFORMAT_16BPP_RGB565 VNC_PIXELFORMAT_8BPP_RGB332); + + +sub buffer2hex($) { + my ($t) = @_ ; + + my $result = ''; + + my @b = split (//, $t) ; + + foreach (@b) { + $result .= sprintf("%02X ", ord($_)) ; + } + + return $result ; +} + +########## +# +# helper function to build the PIXELFORMAT binary struct (please see VNC documentation +# +sub BUILD_PIXEL_FORMAT { + my ($bits_per_pixel, + $depth , + $big_endian, + $true_color, + $red_max,$green_max,$blue_max, + $red_shift,$green_shift, $blue_shift) = @_ ; + + my $buffer = pack ("CCCCnnnCCCCn", $bits_per_pixel, + $depth , + $big_endian, + $true_color, + $red_max,$green_max,$blue_max, + $red_shift,$green_shift, $blue_shift ) ; + + return $buffer; +} + +sub VNC_PIXELFORMAT_32BPP_RGB888 { + return BUILD_PIXEL_FORMAT(32,24,1,1,255,255,255,16,8,0); +} + +sub VNC_PIXELFORMAT_16BPP_RGB565 { + return BUILD_PIXEL_FORMAT(16,16,1,1,31,63,31,11,5,0); +} + +sub VNC_PIXELFORMAT_8BPP_RGB332 { + return BUILD_PIXEL_FORMAT(8,8,1,1,7,7,3,0,3,6); +} + +####### +# Constructs a new VNC Codec object +# +sub new { + my $proto = shift; + my $class = $proto; + + my $self = {}; + bless ($self, $class); + + #use default PIXELFORMAT of 32bpp, RGB888 + $self->{RED_MAX} = 255 ; + $self->{GREEN_MAX} = 255 ; + $self->{BLUE_MAX} = 255 ; + $self->{RED_SHIFT} = 16; + $self->{GREEN_SHIFT} = 8 ; + $self->{BLUE_SHIFT} = 0 ; + $self->{BITS_PER_PIXEL} = 32; + $self->{DEPTH} = 24 ; + $self->{TRUE_COLOR} = 1 ; + $self->{BIG_ENDIAN} = 1 ; + + + #This is used for the internal representation o RGB data + $self->{INTERNAL_RED_MAX} = 255 ; + $self->{INTERNAL_GREEN_MAX} = 255 ; + $self->{INTERNAL_BLUE_MAX} = 255 ; + + return $self; +} + +sub set_pixel_format { + my ($self, $bits_per_pixel, + $depth , + $big_endian, + $true_color, + $red_max,$green_max,$blue_max, + $red_shift,$green_shift, $blue_shift) = @_ ; + + $self->{RED_MAX} = $red_max ; + $self->{GREEN_MAX} = $green_max ; + $self->{BLUE_MAX} = $blue_max ; + $self->{RED_SHIFT} = $red_shift; + $self->{GREEN_SHIFT} = $green_shift ; + $self->{BLUE_SHIFT} = $blue_shift ; + $self->{BITS_PER_PIXEL} = $bits_per_pixel; + $self->{DEPTH} = $depth ; + $self->{TRUE_COLOR} = $true_color ; + $self->{BIG_ENDIAN} = $big_endian ; + + return 1; +} + + +############################# +# +# This function builds a raw pixel, according to the specified format (bits/pixel,and max/shift values) +# It returns a raw (binary) scalar with the encoded pixel +# +sub encode_pixel { + my ($self,$r,$g,$b) = @_ ; + + warn "VNC::Codec::encode_pixel called with self=undef" unless (defined $self); + warn "VNC::Codec::encode_pixel called with r/g/b=undef" unless (defined $r and defined $g and defined $b); + + my $red_max = $self->{RED_MAX}; + my $green_max = $self->{GREEN_MAX}; + my $blue_max = $self->{BLUE_MAX}; + + my $red_shift = $self->{RED_SHIFT}; + my $green_shift = $self->{GREEN_SHIFT}; + my $blue_shift = $self->{BLUE_SHIFT}; + + my $bits_per_pixel = $self->{BITS_PER_PIXEL}; + + my $z = ($r * ($red_max))/$self->{INTERNAL_RED_MAX} << $red_shift ; + $z += ($g * ($green_max))/$self->{INTERNAL_GREEN_MAX} << $green_shift; + $z += ($b * ($blue_max))/$self->{INTERNAL_BLUE_MAX} << $blue_shift; + + my $raw; + + if ($bits_per_pixel==8) { + $raw .= pack("C",$z) ; + } elsif ($bits_per_pixel==16) { + $raw .= pack("S",$z) ; + } elsif ($bits_per_pixel==32) { + $raw .= pack("i",$z) ; + } + +# print "encode_pixel($r,$g,$b) = ",buffer2hex($raw),"\n"; + + return $raw; +} + +############################# +# +# This function builds a RAW encoded rectangle, with a singe RGB color +# It returns a raw (binary) scalar with the encoded rect data +# +sub encode_raw_rect { + my ($self,$raw_pixel,$x,$y,$w,$h) = @_ ; + + my $i; + my $j; + my $raw ; + + for ($i=0;$i<$h;$i++) { + for ($j=0;$j<$w;$j++) { + $raw .= $raw_pixel; + } + } + + my $buffer = pack("nnnnN", $x,$y,$w,$h,0 ) . $raw ; + +# print "encode_raw_rect = ",buffer2hex($buffer),"\n"; + return $buffer; +} + +############################# +# +# This function builds an RRE sub-rect +# It returns a raw (binary) scalar with the encoded subrect data +# +sub encode_rre_subrect { + my ($self,$raw_pixel,$x,$y,$w,$h) = @_ ; + + warn "VNC::Codec::encode_rre_subrect called with self=undef" unless (defined $self); + warn "VNC::Codec::encode_rre_subrect called with raw_pixel=undef" unless (defined $raw_pixel); + warn "VNC::Codec::encode_rre_subrect called with x/y/w/h=undef" unless (defined $x and defined $y and defined $w and defined $h); + + return $raw_pixel . pack("nnnn",$x,$y,$w,$h); +} + +############################# +# +# This function builds an RRE sub-rect +# It returns a raw (binary) scalar with the encoded subrect data +# +sub encode_rre { + my ($self,$raw_background_pixel,$x,$y,$w,$h,@subrects) = @_ ; + + warn "VNC::Codec::encode_rre called with self=undef" unless (defined $self); + warn "VNC::Codec::encode_rre called with x/y/w/h=undef" unless (defined $x and defined $y and defined $w and defined $h); + warn "VNC::Codec::encode_rre called with raw_background_pixel=undef" unless (defined $raw_background_pixel); + + my $count = scalar @subrects; + + return pack("nnnnNN",$x,$y,$w,$h,2,$count) . $raw_background_pixel . join('',@subrects); # 2 = RRE encoding +} + +sub encode_framebuffer_update { + my ($self,@rectangles) = @_ ; + + my $count = scalar @rectangles; + my $buffer = pack("CCn",0,0,$count) . join('',@rectangles) ; + + return $buffer; +} + +1; \ No newline at end of file diff --git a/VNC/Server.pm b/VNC/Server.pm new file mode 100755 index 0000000..34b39a8 --- /dev/null +++ b/VNC/Server.pm @@ -0,0 +1,149 @@ +package VNC::Server; + +require 5.002; # becase we use prototypes + +use IO::Select; +use IO::Socket; +use IO::Socket::INET; +use Socket; +use warnings; +use strict; +use VNC::ServerConnection; +use vars qw(@ISA @EXPORT_OK); +require Exporter; +@ISA = qw(Exporter); +@EXPORT_OK = qw(); + +sub new { + my $proto = shift; + my $class = $proto; + + my %args = @_ ; + + my $self = {}; + bless ($self, $class); + + # Get the port number + my $port = $args{Port} ||= 0 ; + # Port number less than 100 is treated as display number + if ($port < 100 ) {$port += 5900;} + $self->{PORT} = $port ; + + # Get the idle Interval + $self->{IDLE_INTERVAL} = $args{Idle} || 1 ; + $self->{IdleHandler} = $args{IdleHandler}; + $self->{KeyEventHandler} = $args{KeyEventHandler}; + $self->{PointerEventHandler} = $args{PointerEventHandler}; + $self->{CutTextHandler} = $args{CutTextHandler}; + $self->{UpdateDisplayHandler} = $args{UpdateDisplayHandler}; + $self->{PixelFormat} = $args{PixelFormat}; + $self->{Caption} = $args{Caption}; + $self->{Width} = $args{Width}; + $self->{Height} = $args{Height}; + $self->{ClientConnectHandler} = $args{ClientConnectHandler}; + $self->{ClientDisconnectHandler} = $args{ClientDisconnectHandler}; + $self->{Password} = $args{Password}; + + return $self; +} + +sub update_all_displays { + my ($self) = @_ ; + + my $vncref = $self->{VNC_CONNECTIONS} ; + my %vncs = %{$vncref} ; + + foreach (values %vncs) { + $_->update_display ; + } +} + +sub disconnect_client { + my ($self, $vnc, $sock_handle) = @_ ; + + my $vncref = $self->{VNC_CONNECTIONS} ; + my %vncs = %{$vncref} ; + + my $sel = $self->{SELECTOR}; + + shutdown($sock_handle,2); + + delete $vncs{$sock_handle}; + $sel->remove($sock_handle) ; + $vnc = undef ; + $sock_handle = undef ; + + print "Client Disconnectd\n"; +} + +sub vnc_server_loop { + my ($self) = @_ ; + + my $listen_sock = new IO::Socket::INET(Listen => 1, LocalPort => $self->{PORT} ); + my $sel = new IO::Select( $listen_sock ); + + my %vncs = () ; + + $self->{VNC_CONNECTIONS} = \%vncs; + $self->{SELECTOR} = $sel ; + + while (1) { + my @ready_handles; + if (@ready_handles = $sel->can_read( $self->{IDLE_INTERVAL} ) ) { + foreach my $fh (@ready_handles) { + if ($fh == $listen_sock) { + #accept new connection from client + + my $client_sock = $listen_sock->accept; + $client_sock->blocking(1); + + my $vnc = new VNC::ServerConnection( Server => $self, + Caption => $self->{Caption}, + Socket => $client_sock, + Width => $self->{Width}, + Height => $self->{Height}, + Password => $self->{Password}, + PixelFormat => $self->{PixelFormat}, + KeyEventHandler => $self->{KeyEventHandler}, + PointerEventHandler => $self->{PointerEventHandler}, + CutTextHandler => $self->{CutTextHandler}, + UpdateDisplayHandler => $self->{UpdateDisplayHandler} + + ); + print "Accepted new connection from ",$client_sock->sockhost(),"\n" ; + + my $ok = 1 ; + my $handler = $self->{ClientConnectHandler}; + if (defined $handler) { + $ok = &$handler($self, $client_sock, $vnc); + } + + if (defined $ok) { + $sel->add($client_sock); + $vnc->start_conversation(); + $vncs{$client_sock} = $vnc ; + } else { + $vnc = undef ; + shutdown($client_sock,2) ; + $client_sock = undef; + } + } else { + my $vnc = $vncs{$fh} ; + + die "Error! got data from un-connected socket" unless (defined $vnc); + + if (!defined $vnc->handle_client_data()) { + $vnc->disconnect; + } + } + } + } else { + my $sub = $self->{IdleHandler}; + if (defined $sub) { + &$sub($self) ; + } + } + } +} + +1; \ No newline at end of file diff --git a/VNC/ServerConnection.pm b/VNC/ServerConnection.pm new file mode 100755 index 0000000..574b75d --- /dev/null +++ b/VNC/ServerConnection.pm @@ -0,0 +1,610 @@ +package VNC::ServerConnection; + +require 5.002; # becase we use prototypes + +use Socket; +use warnings; +use strict; +use VNC::Codec; +use vars qw(@ISA @EXPORT_OK); +require Exporter; +@ISA = qw(Exporter); +@EXPORT_OK = qw(); + + +sub STATE_UNINITIALIZED {0}; +sub STATE_WAIT_FOR_PROTOCOL {1}; +sub STATE_WAIT_FOR_AUTHENTICATION {2}; +sub STATE_WAIT_FOR_CLIENT_INIT_MSG {3}; +sub STATE_WAIT_FOR_MSG_HEADER {4}; +sub STATE_WAIT_FOR_FIXED_LEN_MSG {5}; +sub STATE_WAIT_FOR_TEXT_CUT_LENGTH {6}; +sub STATE_WAIT_FOR_TEXT_CUT_CONTENT {7}; +sub STATE_WAIT_FOR_ENCODING_COUNT {8}; +sub STATE_WAIT_FOR_ENCODING_DATA {9}; + +sub MSG_SET_PIXEL_FORMAT {0}; +sub MSG_FIX_COLOR_MAP_ENTRIES {1}; +sub MSG_SET_ENCODING {2}; +sub MSG_FRAME_BUFFER_UPDATE_REQUEST {3}; +sub MSG_KEY_EVENT {4}; +sub MSG_POINTER_EVENT {5}; +sub MSG_CLIENT_CUT_TEXT {6}; + +my @rfb_message_handlers =( [\&do_set_pixel_format, 20], #SetPixelFormat + [\&do_fix_color_map_entries, 4], #FixColorMapEntries + [\&do_set_encoding, -1], #SetEncoding + [\&do_frame_buffer_update_request,10], #FramebufferUpdateRequest + [\&do_key_event, 8], #KeyEvent + [\&do_pointer_event,6], #Pointer Event + [\&do_client_cut_text,-1] + ); + +###################### +# +# Helper function to build the ServerInitMessage binary struct (please see the VNC documentation) +# +sub BUILD_SERVER_INIT_MSG { + my ($width, $height, $pixel_format, $name) = @_ ; + + my $buffer = pack ( "nn", $width, $height ) . $pixel_format . pack("N", length($name)) . $name; + + return $buffer ; +} + + +####### +# Constructs a new, VNC server object, connected to one client using socket handle +# +sub new { + my $proto = shift; + my $class = $proto; + + my %args = @_ ; + + my $sock_handle = $args{Socket}; + die "$proto->new called without any socket handle!" unless (defined $sock_handle ); + + my $self = {}; + bless ($self, $class); + + $self->{HANDLE} = $sock_handle; + + $self->{STATE} = STATE_UNINITIALIZED ; + $self->{RECV_BUFFER} = '' ; + $self->{EXPECTED_BUFFER_SIZE} = 0 ; + + $self->{CODEC} = new VNC::Codec(); + + #if this is defined, a response will be sent immediatly + #when a FrameBufferUpdateRequest is received + #if this is UNDEFINED, no response will be sent, and UPDATE_REQUEST_PENDING will be set + $self->{SEND_UPDATE_RESPONSE} = 1 ; + + #if this is defined, it means an update request was received, + #but a response was not sent. + #so the next time you call udpate_frame_buffer a response will be sent immediately + $self->{UPDATE_REQUEST_PENDING} = 1 ; + + $self->{Server} = $args{Server} ; + + #handlers + $self->{KeyEventHandler} = $args{KeyEventHandler}; + $self->{PointerEventHandler} = $args{PointerEventHandler}; + $self->{CutTextHandler} = $args{CutTextHandler}; + $self->{UpdateDisplayHandler} = $args{UpdateDisplayHandler}; + + #Get the pixel format + #if none specified, default to 32Bits/Pixel 24bit depth, RGB888 + my $pixel_format = $args{PixelFormat} || VNC::Codec::VNC_PIXELFORMAT_32BPP_RGB888; + $self->{PixelFormat} = $pixel_format; + + my (undef, $myaddr) = sockaddr_in(getsockname($sock_handle)); + $self->{Caption} = $args{Caption} || "PerlVNC Server at " . scalar gethostbyaddr($myaddr, AF_INET) . " [" . inet_ntoa($myaddr). "]" ; + + + $self->{Width} = $args{Width} || 200; + $self->{Height} = $args{Height} || 200; + + $self->{PENDING_UPDATE_REQUEST_BUFFER} = pack("CCnnnn",0,0,0,0,10,10); + + $self->{Password} = $args{Password}; + + return $self; +} + +##########################################3 +# +# Helper function to send data to the socket +# +sub send_buffer($$) { + my $self = shift ; + my $a = shift ; + die "send_buffer called, when self is undef" unless (defined $self); + return unless (defined $self->{HANDLE}); + + if (!defined $a) { + warn "send_buffer called, buffer is empty"; + return ; + } + + my $count = send($self->{HANDLE}, $a,0); + + die "Error sending buffer ($a) " unless ($count == length $a); + + return $count; +} + + +############################### +# Given a SET_PIXEL_FORMAT buffer (20 bytes long, see VNC documentation) +# Sets the pixel format of this session +sub do_set_pixel_format { + my $self = shift ; + my $buffer = shift ; + + die "do_set_pixel_format called, when self is undef" unless (defined $self); + die "do_set_pixel_format, buffer isn't 20 bytes long" unless (length $buffer==20); + + my (undef,undef,undef,undef,$bits_per_pixel, + $depth , + $big_endian, + $true_color, + $red_max,$green_max,$blue_max, + $red_shift,$green_shift, $blue_shift) = + unpack("CCCCCCCCnnnCCC", $buffer) ; + + # + # TODO: Let's do some sanity checks + # + + $self->{CODEC}->set_pixel_format($bits_per_pixel, + $depth, $big_endian, $true_color, + $red_max,$green_max,$blue_max, + $red_shift,$green_shift, $blue_shift); + + return ; +} + +sub do_fix_color_map_entries() { + my $self = shift ; + die "do_fix_color_map_entries called, when self is undef" unless (defined $self); + + my $buffer = shift; + die "do_set_pixel_format, buffer isn't 6 bytes long" unless (length $buffer==6); + + die "Client Sent rfbFixColourMapEntriesMsg - UNSUPPORTED\n"; + + my (undef,$pad,$first_color,$n_colors) = unpack("CCnn", $buffer) ; + + print "color map, first color = $first_color, total colors = $n_colors\n" ; + return ; +} + +sub do_set_encoding() { + my $self = shift ; + die "do_set_encoding called, when self is undef" unless (defined $self); + + my $buffer = shift; + + my (undef,undef,$nEncoding,@encodings) = unpack("CCnN*", $buffer) ; + + # + # Debug Only + # + print "Client supports $nEncoding encodings: ",join(' ', @encodings),"\n"; + + return ; +} + +sub update_display { + my $self = shift ; + die "update_display called, when self is undef" unless (defined $self); + + #if we received an update request but did not send response, we'll send a response immediately + if (defined $self->{UPDATE_REQUEST_PENDING}) { + + my (undef,$incremental, $x,$y,$w,$h) = unpack("CCnnnn", $self->{PENDING_UPDATE_REQUEST_BUFFER}) ; + + my $handler = $self->{UpdateDisplayHandler}; + if (defined $handler) { + my $data = &$handler($self, $incremental, $x, $y, $w, $h); + + $self->send_buffer($data); + } + + $self->{UPDATE_REQUEST_PENDING} = undef; + $self->{SEND_UPDATE_RESPONSE} = undef; + } else { + + #if now update request is pending, + #we'll simply signal the next request to be answered immediately + $self->{SEND_UPDATE_RESPONSE} = 1 ; + } +} +sub disconnect { + my $self = shift; + + my $server = $self->{Server} ; + + die "server=undef" unless (defined $server); + + return unless $self->{HANDLE}; + + $server->disconnect_client($self,$self->{HANDLE}) ; + + $self->{HANDLE} = undef ; + $self = undef ; +} + +sub do_frame_buffer_update_request() { + my $self = shift ; + die "do_frame_buffer_update_request called, when self is undef" unless (defined $self); + + my $buffer = shift; + die "do_frame_buffer_update_request, buffer isn't 10 bytes long" unless (length $buffer==10); + + my (undef,$incremental, $x,$y,$w,$h) = unpack("CCnnnn", $buffer) ; + + +# print "UpdateRequest: Incremental=$incremental, X,Y=($x,$y) WxH = ($w x $h)\n"; + + if (defined $self->{SEND_UPDATE_RESPONSE}) { + my $codec = $self->{CODEC}; + + # my $data = $codec->encode_framebuffer_update($codec->encode_raw_rect($codec->encode_pixel(0,0,255), $x,$y,$w,$h) ) ; + +# my $data = $codec->encode_framebuffer_update( $codec->encode_rre($codec->encode_pixel(0,255,0), $x,$y,$w,$h, +# $codec->encode_rre_subrect( $codec->encode_pixel(255,255,255), 10,10,20,10), +# $codec->encode_rre_subrect( $codec->encode_pixel(0,128,128), 10,20,10,20) +# ) +# ) ; + + my $handler = $self->{UpdateDisplayHandler}; + if (defined $handler) { + my $data = &$handler($self, $incremental, $x, $y, $w, $h); + + $self->send_buffer($data); + } + + $self->{UPDATE_REQUEST_PENDING} = undef; + $self->{SEND_UPDATE_RESPONSE} = undef; + + } else { + + $self->{PENDING_UPDATE_REQUEST_BUFFER} = $buffer ; + + $self->{UPDATE_REQUEST_PENDING} = 1; + } + + return ; +} + +sub do_key_event() { + my $self = shift ; + die "do_key_event called, when self is undef" unless (defined $self); + + my $buffer = shift; + die "do_key_event, buffer isn't 8 bytes long" unless (length $buffer==8); + + my (undef,$down,$pad,$key) = unpack("CCnN", $buffer) ; + + my $handler = $self->{KeyEventHandler}; + if (defined $handler) { + &$handler($self, $down, $key); + } + return ; +} + +sub do_pointer_event() { + my $self = shift ; + die "do_pointer_event called, when self is undef" unless (defined $self); + + my $buffer = shift; + die "do_pointer_event, buffer isn't 6 bytes long" unless (length $buffer==6); + + my (undef,$mask,$x,$y) = unpack("CCnn", $buffer) ; + + my $handler = $self->{PointerEventHandler}; + if (defined $handler) { + &$handler($self, $mask, $x,$y); + } + return ; +} + +sub do_client_cut_text() { + my $self = shift ; + die "do_client_cut_text called, when self is undef" unless (defined $self); + + my $buffer = shift; + print "Client Sent client cut text\n"; + + my (undef,undef,$length,$text) = unpack("CnNA*", $buffer) ; + + my $handler = $self->{CutTextHandler}; + if (defined $handler) { + &$handler($self, $text); + } + return ; +} + +sub start_conversation() { + my $self = shift ; + die "handle_client_data called, when self is undef" unless (defined $self); + + my $fh = $self->{HANDLE}; + die "start_convertsion, handle is undef" unless (defined $fh); + + $self->send_buffer("RFB 003.003\n"); + $self->{STATE} = STATE_WAIT_FOR_PROTOCOL ; + $self->{EXPECTED_BUFFER_SIZE} = 12 ; +} + +sub handle_client_data() { + my $self = shift ; + die "handle_client_data called, when self is undef" unless (defined $self); + + my $fh = $self->{HANDLE}; + die "start_convertsion, handle is undef" unless (defined $fh); + + #Read data from the socket + my $data ; + my $read_rc = $fh->sysread($data, 32786) ; + + if (defined $read_rc) { + if ($read_rc > 0) { + + #data read OK + #add it to our buffer, check if we got enough data for the current state + $self->{RECV_BUFFER} .= $data ; + + while ( length $self->{RECV_BUFFER} >= $self->{EXPECTED_BUFFER_SIZE} ) { + #got enough data from current state, so handle the state + + #debug +# print "Handle Buffer: expected size = ",$self->{EXPECTED_BUFFER_SIZE}," recv_buffer size = ", length($self->{RECV_BUFFER}),"\n"; + + #take just the needed number of byte + my $buffer = substr $self->{RECV_BUFFER},0,$self->{EXPECTED_BUFFER_SIZE}; + + #leave the remaining bytes in the buffe + $self->{RECV_BUFFER} = substr ($self->{RECV_BUFFER}, $self->{EXPECTED_BUFFER_SIZE}, length($self->{RECV_BUFFER})-$self->{EXPECTED_BUFFER_SIZE} ); + + #debug +# print "After Buffer Split: buffer size = ", length($buffer), " recv_buffer size = ",length($self->{RECV_BUFFER}),"\n" ; + + $self->handle_state($buffer); + } + } else { + #read_rc == 0 + #it means the socket was closed by the client + + + return undef; + } + } else { +# die "Errro while reading socket"; + + return undef; + } + + return 1; +} + +sub handle_state { + my $self = shift ; + die "handle_state called, when self is undef" unless (defined $self); + + my $buffer = shift ; + die "handle_state called, when buffer is undef" unless (defined $buffer); + + my $current_state = $self->{STATE}; + + # + # Got protocol version string from the cilent + # + if ($current_state==STATE_WAIT_FOR_PROTOCOL) { + if (length($buffer) != 12) { + warn "Error: WAIT_FOR_PROTOCOL state, buffer != 12 bytes" ; + return undef; + }; + + my ($major, $minor) = $buffer =~ m/^RFB (\d{3})\.(\d{3})$/ ; + die "unknown protocol version ($buffer)" unless (defined $major && defined $minor); + if ($major != 3) { + $self->send_buffer("Uknown version. i need major protocol version = 3\nBye Bye\n"); + return undef; + } + print "Client requested protocol version $major.$minor\n"; + + # + # Next step: + # Ask for password, if needed + # + + if (defined $self->{Password}) { + $self->{STATE} = STATE_WAIT_FOR_AUTHENTICATION ; + $self->{EXPECTED_BUFFER_SIZE} = 16 ; + + $self->send_buffer(pack("N",2)); + + # TODO: + # send a challange and check the resonse using DES + $self->send_buffer("0123456789abcdef"); + } + else { + # no password needed + $self->{STATE} = STATE_WAIT_FOR_CLIENT_INIT_MSG ; + $self->{EXPECTED_BUFFER_SIZE} = 1 ; + + $self->send_buffer(pack("N",1)); + } + } + elsif + # + # Got Authentication response from the client + # + ($current_state==STATE_WAIT_FOR_AUTHENTICATION) { + if (length($buffer) != 16) { + warn "Error: WAIT_FOR_AUTHENTICATION state, buffer != 16 bytes" ; + return undef; + }; + + #for now, accept any password + $self->send_buffer(pack("N",0)); + + # + # Next Stap: + # Client Init Msg + $self->{STATE} = STATE_WAIT_FOR_CLIENT_INIT_MSG; + $self->{EXPECTED_BUFFER_SIZE} = 1 ; + } + elsif + # + # Got client Init Message from the client + # + ($current_state==STATE_WAIT_FOR_CLIENT_INIT_MSG) { + if (length($buffer) != 1) { + warn "Error: WAIT_FOR_CLIENT_INIT_MSG state, buffer != 1 bytes" ; + return undef; + }; + my $srvr_init_msg = BUILD_SERVER_INIT_MSG( $self->{Width}, + $self->{Height}, + $self->{PixelFormat}, + $self->{Caption} ); + $self->send_buffer($srvr_init_msg); + + # + # Next Step + # client normal messages + $self->{STATE} = STATE_WAIT_FOR_MSG_HEADER; + $self->{EXPECTED_BUFFER_SIZE} = 1 ; + } + elsif + # + # Got Message header from the client + # + ($current_state==STATE_WAIT_FOR_MSG_HEADER) { + if (length($buffer) != 1) { + warn "Error: STATE_WAIT_FOR_MSG_HEADER state, buffer != 1 bytes" ; + return undef; + }; + + my $msg = ord($buffer) ; + + my ($subroutine, $byte_count) = @{$rfb_message_handlers[$msg]}; + + die "Error: unknown message $msg" unless (defined $subroutine && defined $byte_count); + + # These are FixedLength messages, we can handle them all in the same way + if ( $msg==MSG_SET_PIXEL_FORMAT + or + $msg==MSG_FRAME_BUFFER_UPDATE_REQUEST + or + $msg==MSG_KEY_EVENT + or + $msg==MSG_POINTER_EVENT ) + { + # + # Next Step + # client normal messages + $self->{STATE} = STATE_WAIT_FOR_FIXED_LEN_MSG; + $self->{EXPECTED_BUFFER_SIZE} = $byte_count ; + + #re-insert this byte into the buffer + $self->{RECV_BUFFER} = pack("C",$msg) . $self->{RECV_BUFFER} ; + $self->{CURRENT_MSG} = $msg ; + + } elsif + ($msg==MSG_SET_ENCODING) { + $self->{STATE} = STATE_WAIT_FOR_ENCODING_COUNT; + $self->{EXPECTED_BUFFER_SIZE} = 3 ; + + $self->{ENCODING_BUFFER} = $buffer; + } elsif + ($msg==MSG_CLIENT_CUT_TEXT) { + $self->{STATE} = STATE_WAIT_FOR_TEXT_CUT_LENGTH; + $self->{EXPECTED_BUFFER_SIZE} = 7 ; + $self->{CUT_TEXT_BUFFER} = $buffer; + } + } + elsif + # + # Got Message header from the client + # + ($current_state==STATE_WAIT_FOR_FIXED_LEN_MSG) { + my $msg = $self->{CURRENT_MSG}; + my ($subroutine, $byte_count) = @{$rfb_message_handlers[ $msg ]}; + die "Error: unknown message $msg" unless (defined $subroutine && defined $byte_count); + + if (length($buffer) != $byte_count) { + warn "Error: STATE_WAIT_FOR_FIXED_LEN_MSG state (msg=$msg), buffer != $byte_count bytes" ; + return undef; + }; + + # + # Next Step + # Execute the client's request + &$subroutine($self,$buffer); + + $self->{STATE} = STATE_WAIT_FOR_MSG_HEADER; + $self->{EXPECTED_BUFFER_SIZE} = 1 ; + } elsif + # + # Got Encoding Count + # + ($current_state==STATE_WAIT_FOR_ENCODING_COUNT) { + if (length($buffer) != 3) { + warn "Error: STATE_WAIT_FOR_ENCODING_COUNT state, buffer != 3 bytes" ; + return undef; + }; + + my (undef,$nEncoding) = unpack("Cn", $buffer) ; + print "Client supports $nEncoding encodings\n" ; + + $self->{STATE} = STATE_WAIT_FOR_ENCODING_DATA; + $self->{EXPECTED_BUFFER_SIZE} = $nEncoding*4 ; + $self->{ENCODING_BUFFER} .= $buffer; + } elsif + # + # Got Encoding Data + # + ($current_state==STATE_WAIT_FOR_ENCODING_DATA) { + $self->{ENCODING_BUFFER} .= $buffer; + + $self->do_set_encoding($self->{ENCODING_BUFFER}); + + $self->{STATE} = STATE_WAIT_FOR_MSG_HEADER; + $self->{EXPECTED_BUFFER_SIZE} = 1 ; + } elsif + # + # Got Client Cut Text Length + # + ($current_state==STATE_WAIT_FOR_TEXT_CUT_LENGTH) { + if (length($buffer) != 7) { + warn "Error: STATE_WAIT_FOR_TEXT_CUT_LENGTH state, buffer != 7 bytes" ; + return undef; + }; + + my (undef,undef,$length) = unpack("CnN", $buffer) ; + print "Client Cut Text: $length characters \n" ; + + $self->{STATE} = STATE_WAIT_FOR_TEXT_CUT_CONTENT; + $self->{EXPECTED_BUFFER_SIZE} = $length ; + $self->{TEXT_CUT_BUFFER} .= $buffer; + } elsif + # + # Got Client Cut text content + # + ($current_state==STATE_WAIT_FOR_TEXT_CUT_CONTENT) { + $self->{TEXT_CUT_BUFFER} .= $buffer; + + $self->do_client_cut_text($self->{TEXT_CUT_BUFFER}); + $self->{TEXT_CUT_BUFFER} = undef; + + $self->{STATE} = STATE_WAIT_FOR_MSG_HEADER; + $self->{EXPECTED_BUFFER_SIZE} = 1 ; + } ; +} + +1; \ No newline at end of file diff --git a/life.pl b/life.pl new file mode 100755 index 0000000..f0c51bb --- /dev/null +++ b/life.pl @@ -0,0 +1,171 @@ +use strict; +use warnings; +use VNC::Server; + + +my $life_cell_pixel_size = 5 ; +my $life_cells_per_col = 20 ; +my $life_cells_per_row = 20; + +my $running = 0; + +# +# Init the life data +# +my @life_data; + +foreach my $i (0..$life_cells_per_row-1) { + foreach my $j (0..$life_cells_per_col-1) { + $life_data[$i][$j] = int(rand(2)); + } +} + +sub count_neighbors { + my ($i,$j) = @_ ; + + my $count =0 ; + + foreach my $q ( ($i-1)..($i+1)) { + foreach my $w ( ($j-1)..($j+1)) { + if ( ($q>=0) && ($q<$life_cells_per_row) && + ($w>=0) && ($w<$life_cells_per_col) && + (($q!=$i) || ($w!=$j)) + ) { + if ($life_data[$q][$w]==1) { + $count++ ; + } + } + } + } + return $count; +} + + +my $s = new VNC::Server( Port=>2, + Idle=>1, + Caption=>'Game of VNCLife', + Width => $life_cell_pixel_size * $life_cells_per_row, + Height => $life_cell_pixel_size * $life_cells_per_col, + IdleHandler => \&next_turn, + KeyEventHandler => \&keyboard, + PointerEventHandler => \&pointer, + UpdateDisplayHandler => \&updater + ); + +$s->vnc_server_loop; + +sub keyboard { + my ($vnc, $down, $key) = @_ ; + + #act only on key released + if ($down==0) { + + # R = randomize + if ($key==ord('R') || $key==ord('r')) { + foreach my $i (0..$life_cells_per_row-1) { + foreach my $j (0..$life_cells_per_col-1) { + $life_data[$i][$j] = int(rand(2)); + } + } + $s->update_all_displays; + } + + # C = clear + if ($key==ord('C') || $key==ord('c')) { + foreach my $i (0..$life_cells_per_row-1) { + foreach my $j (0..$life_cells_per_col-1) { + $life_data[$i][$j] = 0; + } + } + $s->update_all_displays; + } + + # Q = Quit + if ($key==ord('Q') || $key==ord('q')) { + $vnc->disconnect(); + } + + # S = Start/Stop + if ($key==ord('S') || $key==ord('s')) { + if ($running) { + print "Stoping!\n"; + $running = undef ; + } else { + print "Starting!\n"; + $running = 1; + } + } + } +} + +sub pointer { + my ($vnc,$mask,$x,$y) = @_ ; + + if ($mask!=0) { + my $i = $x / $life_cell_pixel_size ; + my $j = $y / $life_cell_pixel_size ; + + $life_data[$i][$j] = ($mask==1) ? 1 : 0 ; + + $s->update_all_displays; + } +} + + +sub updater { + my ($vnc, $inc, $x,$y,$w,$h) = @_ ; + my $codec = $vnc->{CODEC}; + + my @rects ; + my $red_pixel = $codec->encode_pixel(255,0,0); + my $white_pixel = $codec->encode_pixel(255,255,255); + + foreach my $i (0..$life_cells_per_row-1) { + foreach my $j (0..$life_cells_per_col-1) { + if ($life_data[$i][$j]==1) { + push @rects, $codec->encode_rre_subrect( $red_pixel ,$i*$life_cell_pixel_size, $j*$life_cell_pixel_size,$life_cell_pixel_size,$life_cell_pixel_size); + } + } + } + my $data = $codec->encode_framebuffer_update( $codec->encode_rre($white_pixel, $x,$y,$w,$h, @rects)); + + return $data ; +} + +sub next_turn { + #not running, exit immediately + return unless ($running); + + #calculate the next life phase + my @new_life_data; + + foreach my $i (0..$life_cells_per_row-1) { + foreach my $j (0..$life_cells_per_col-1) { + $new_life_data[$i][$j] = 0; + } + } + + foreach my $i (0..$life_cells_per_row-1) { + foreach my $j (0..$life_cells_per_col-1) { + my $current = $life_data[$i][$j]; + my $count = count_neighbors($i,$j); + + if ($current==1){ + if ($count<2 || $count>3) { + $new_life_data[$i][$j] = 0 ; + } else { + $new_life_data[$i][$j] = 1 ; + } + }else{ + if ($count==3) { + $new_life_data[$i][$j] = 1 ; + } else { + $new_life_data[$i][$j] = 0 ; + } + } + } + } + @life_data = @new_life_data; + + $s->update_all_displays; +} diff --git a/main.pl b/main.pl new file mode 100755 index 0000000..5c44e5b --- /dev/null +++ b/main.pl @@ -0,0 +1,58 @@ +use strict; +use warnings; +use VNC::Server; + + +my $type = 1; + + + +sub updater { + my ($vnc, $inc, $x,$y,$w,$h) = @_ ; + + my $codec = $vnc->{CODEC}; + + + my $data ; + + if ($type==1) { + $data= $codec->encode_framebuffer_update($codec->encode_raw_rect($codec->encode_pixel(0,0,255), $x,$y,$w,$h) ) ; + } else { + $data = $codec->encode_framebuffer_update( $codec->encode_rre($codec->encode_pixel(0,255,0), $x,$y,$w,$h, + $codec->encode_rre_subrect( $codec->encode_pixel(255,255,255), 10,10,20,10), + $codec->encode_rre_subrect( $codec->encode_pixel(0,128,128), 10,20,10,20) + )) ; + } + + return $data ; +} + +my $s = new VNC::Server( Port=>2, + Idle=>1, + Caption=>'Hello From perlVNC', + Width => 50, Height => 50, + Password => 'dummy', + IdleHandler => sub {print "Nothing happened for 1 second...\n"}, + KeyEventHandler => sub { my ($vnc,$d,$k) = @_; print "down = $d, key = $k\n";}, + PointerEventHandler => \&pointer, + UpdateDisplayHandler => \&updater + ); + +$s->vnc_server_loop; + +sub pointer { + my ($vnc,$mask,$x,$y) = @_ ; + + if ($mask==1) { + $type=1 ; + }; + if ($mask==4) { + $type=2; + } + if ($mask==2) { + $vnc->disconnect ; + return ; + } + + $s->update_all_displays; +} -- 2.20.1