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;