VNC/ServerConnection.pm

   1 package VNC::ServerConnection;\r
   2 \r
   3 require 5.002;   # becase we use prototypes\r
   4 \r
   5 use Socket;\r
   6 use warnings;\r
   7 use strict;\r
   8 use VNC::Codec;\r
   9 use vars qw(@ISA @EXPORT_OK);\r
  10 require Exporter;\r
  11 @ISA = qw(Exporter);\r
  12 @EXPORT_OK = qw();\r
  13 \r
  14 \r
  15 sub STATE_UNINITIALIZED                         {0};\r
  16 sub STATE_WAIT_FOR_PROTOCOL                     {1};\r
  17 sub STATE_WAIT_FOR_AUTHENTICATION       {2};\r
  18 sub STATE_WAIT_FOR_CLIENT_INIT_MSG      {3};\r
  19 sub STATE_WAIT_FOR_MSG_HEADER           {4};\r
  20 sub STATE_WAIT_FOR_FIXED_LEN_MSG        {5};\r
  21 sub STATE_WAIT_FOR_TEXT_CUT_LENGTH      {6};\r
  22 sub STATE_WAIT_FOR_TEXT_CUT_CONTENT {7};\r
  23 sub STATE_WAIT_FOR_ENCODING_COUNT       {8};\r
  24 sub STATE_WAIT_FOR_ENCODING_DATA        {9};\r
  25 \r
  26 sub MSG_SET_PIXEL_FORMAT                        {0};\r
  27 sub MSG_FIX_COLOR_MAP_ENTRIES           {1};\r
  28 sub MSG_SET_ENCODING                            {2};\r
  29 sub MSG_FRAME_BUFFER_UPDATE_REQUEST {3};\r
  30 sub MSG_KEY_EVENT                                       {4};\r
  31 sub MSG_POINTER_EVENT                           {5};\r
  32 sub MSG_CLIENT_CUT_TEXT                         {6};\r
  33 \r
  34 my @rfb_message_handlers =( [\&do_set_pixel_format,     20],                    #SetPixelFormat \r
  35                                                         [\&do_fix_color_map_entries, 4],                #FixColorMapEntries\r
  36                                                         [\&do_set_encoding, -1],                                #SetEncoding\r
  37                                                         [\&do_frame_buffer_update_request,10],  #FramebufferUpdateRequest \r
  38                                                         [\&do_key_event, 8],                                    #KeyEvent\r
  39                                                         [\&do_pointer_event,6],                                 #Pointer Event\r
  40                                                         [\&do_client_cut_text,-1]\r
  41                                                         );\r
  42 \r
  43 ######################\r
  44 #\r
  45 # Helper function to build the ServerInitMessage binary struct (please see the VNC documentation)\r
  46 #\r
  47 sub BUILD_SERVER_INIT_MSG {\r
  48         my ($width, $height, $pixel_format, $name) = @_ ;\r
  49 \r
  50         my $buffer = pack ( "nn", $width, $height ) . $pixel_format . pack("N", length($name)) . $name; \r
  51 \r
  52         return $buffer ;\r
  53 }\r
  54 \r
  55 \r
  56 #######\r
  57 # Constructs a new, VNC server object, connected to one client using socket handle\r
  58 #\r
  59 sub new {\r
  60         my $proto = shift;\r
  61         my $class = $proto;\r
  62 \r
  63         my %args = @_ ;\r
  64 \r
  65         my $sock_handle = $args{Socket}; \r
  66         die "$proto->new called without any socket handle!" unless (defined $sock_handle );\r
  67 \r
  68         my $self  = {};\r
  69         bless ($self, $class);\r
  70 \r
  71         $self->{HANDLE} = $sock_handle;\r
  72 \r
  73         $self->{STATE}          = STATE_UNINITIALIZED ;\r
  74         $self->{RECV_BUFFER} = '' ;\r
  75         $self->{EXPECTED_BUFFER_SIZE} = 0 ;\r
  76 \r
  77         $self->{CODEC} = new VNC::Codec();\r
  78 \r
  79         #if this is defined, a response will be sent immediatly\r
  80         #when a FrameBufferUpdateRequest is received\r
  81         #if this is UNDEFINED, no response will be sent, and UPDATE_REQUEST_PENDING will be set\r
  82         $self->{SEND_UPDATE_RESPONSE} = 1 ;\r
  83 \r
  84         #if this is defined, it means an update request was received, \r
  85         #but a response was not sent.\r
  86         #so the next time you call udpate_frame_buffer a response will be sent immediately\r
  87         $self->{UPDATE_REQUEST_PENDING} = 1 ;\r
  88 \r
  89         $self->{Server} = $args{Server} ;\r
  90 \r
  91         #handlers\r
  92         $self->{KeyEventHandler} = $args{KeyEventHandler};\r
  93         $self->{PointerEventHandler} = $args{PointerEventHandler};\r
  94         $self->{CutTextHandler} = $args{CutTextHandler};\r
  95         $self->{UpdateDisplayHandler} = $args{UpdateDisplayHandler};\r
  96 \r
  97         #Get the pixel format\r
  98         #if none specified, default to 32Bits/Pixel 24bit depth, RGB888\r
  99         my $pixel_format =  $args{PixelFormat} || VNC::Codec::VNC_PIXELFORMAT_32BPP_RGB888;\r
 100         $self->{PixelFormat} = $pixel_format;\r
 101         \r
 102     my (undef, $myaddr) = sockaddr_in(getsockname($sock_handle));\r
 103         $self->{Caption} = $args{Caption} || "PerlVNC Server at " . scalar gethostbyaddr($myaddr, AF_INET) . " [" . inet_ntoa($myaddr). "]" ;\r
 104 \r
 105 \r
 106         $self->{Width} = $args{Width} || 200;\r
 107         $self->{Height} = $args{Height} || 200;\r
 108 \r
 109         $self->{PENDING_UPDATE_REQUEST_BUFFER} = pack("CCnnnn",0,0,0,0,10,10);\r
 110 \r
 111         $self->{Password} = $args{Password};\r
 112 \r
 113         return $self;\r
 114 }\r
 115 \r
 116 ##########################################3\r
 117 #\r
 118 # Helper function to send data to the socket\r
 119 #\r
 120 sub send_buffer($$) {\r
 121         my $self = shift ;\r
 122         my $a = shift ;\r
 123         die "send_buffer called, when self is undef"  unless (defined $self);\r
 124         return unless (defined $self->{HANDLE});\r
 125 \r
 126         if (!defined $a) {\r
 127                 warn "send_buffer called, buffer is empty";\r
 128                 return ;\r
 129         }\r
 130 \r
 131         my $count =     send($self->{HANDLE}, $a,0);\r
 132 \r
 133         die "Error sending buffer ($a) " unless ($count == length $a);\r
 134 \r
 135         return $count;\r
 136 }\r
 137 \r
 138 \r
 139 ###############################\r
 140 # Given a SET_PIXEL_FORMAT buffer (20 bytes long, see VNC documentation)\r
 141 # Sets the pixel format of this session\r
 142 sub do_set_pixel_format {\r
 143         my $self = shift ;\r
 144         my $buffer = shift ;\r
 145 \r
 146         die "do_set_pixel_format called, when self is undef"  unless (defined $self);\r
 147         die "do_set_pixel_format, buffer isn't 20 bytes long" unless (length $buffer==20);\r
 148 \r
 149         my (undef,undef,undef,undef,$bits_per_pixel, \r
 150                 $depth ,\r
 151                 $big_endian,\r
 152                 $true_color,\r
 153                 $red_max,$green_max,$blue_max,\r
 154                 $red_shift,$green_shift, $blue_shift) = \r
 155                 unpack("CCCCCCCCnnnCCC", $buffer) ;\r
 156 \r
 157         #\r
 158         # TODO: Let's do some sanity checks\r
 159         #\r
 160 \r
 161         $self->{CODEC}->set_pixel_format($bits_per_pixel, \r
 162                                                         $depth, $big_endian, $true_color,\r
 163                                                         $red_max,$green_max,$blue_max,\r
 164                                                         $red_shift,$green_shift, $blue_shift);\r
 165         \r
 166         return ;\r
 167 }\r
 168 \r
 169 sub do_fix_color_map_entries() {\r
 170         my $self = shift ;\r
 171         die "do_fix_color_map_entries called, when self is undef"  unless (defined $self);\r
 172 \r
 173         my $buffer = shift;\r
 174         die "do_set_pixel_format, buffer isn't 6 bytes long" unless (length $buffer==6);\r
 175 \r
 176         die "Client Sent rfbFixColourMapEntriesMsg - UNSUPPORTED\n";\r
 177 \r
 178         my (undef,$pad,$first_color,$n_colors) = unpack("CCnn", $buffer) ;\r
 179 \r
 180         print "color map, first color = $first_color, total colors = $n_colors\n" ;\r
 181         return ;\r
 182 }\r
 183 \r
 184 sub do_set_encoding() {\r
 185         my $self = shift ;\r
 186         die "do_set_encoding called, when self is undef"  unless (defined $self);\r
 187         \r
 188         my $buffer = shift;\r
 189 \r
 190         my (undef,undef,$nEncoding,@encodings) = unpack("CCnN*", $buffer) ;\r
 191 \r
 192         #\r
 193         # Debug Only\r
 194         #\r
 195         print "Client supports $nEncoding encodings: ",join(' ', @encodings),"\n";\r
 196 \r
 197         return ;\r
 198 }\r
 199 \r
 200 sub update_display {\r
 201         my $self = shift ;\r
 202         die "update_display called, when self is undef"  unless (defined $self);\r
 203 \r
 204         #if we received an update request but did not send  response, we'll send a response immediately\r
 205         if (defined $self->{UPDATE_REQUEST_PENDING}) {\r
 206 \r
 207                 my (undef,$incremental, $x,$y,$w,$h) = unpack("CCnnnn", $self->{PENDING_UPDATE_REQUEST_BUFFER}) ;\r
 208 \r
 209                 my $handler = $self->{UpdateDisplayHandler};\r
 210                 if (defined $handler) {\r
 211                         my $data = &$handler($self, $incremental, $x, $y, $w, $h);\r
 212 \r
 213                         $self->send_buffer($data);\r
 214                 }\r
 215 \r
 216                 $self->{UPDATE_REQUEST_PENDING} = undef;\r
 217                 $self->{SEND_UPDATE_RESPONSE} = undef;\r
 218         } else {\r
 219 \r
 220                 #if now update request is pending, \r
 221                 #we'll simply signal the next request to be answered immediately\r
 222                 $self->{SEND_UPDATE_RESPONSE} = 1 ;\r
 223         }\r
 224 }\r
 225 sub disconnect {\r
 226         my $self = shift;\r
 227         \r
 228         my $server = $self->{Server} ;\r
 229 \r
 230         die "server=undef" unless (defined $server);\r
 231 \r
 232         return unless $self->{HANDLE};\r
 233 \r
 234         $server->disconnect_client($self,$self->{HANDLE}) ;\r
 235 \r
 236         $self->{HANDLE} = undef ;\r
 237         $self = undef ;\r
 238 }\r
 239 \r
 240 sub do_frame_buffer_update_request() {\r
 241         my $self = shift ;\r
 242         die "do_frame_buffer_update_request called, when self is undef"  unless (defined $self);\r
 243 \r
 244         my $buffer = shift;\r
 245         die "do_frame_buffer_update_request, buffer isn't 10 bytes long" unless (length $buffer==10);\r
 246 \r
 247         my (undef,$incremental, $x,$y,$w,$h) = unpack("CCnnnn", $buffer) ;\r
 248 \r
 249 \r
 250 #       print "UpdateRequest: Incremental=$incremental, X,Y=($x,$y)  WxH = ($w x $h)\n";\r
 251 \r
 252         if (defined $self->{SEND_UPDATE_RESPONSE}) {\r
 253                 my $codec = $self->{CODEC};\r
 254 \r
 255         #       my $data = $codec->encode_framebuffer_update($codec->encode_raw_rect($codec->encode_pixel(0,0,255), $x,$y,$w,$h) ) ;\r
 256 \r
 257 #               my $data = $codec->encode_framebuffer_update(   $codec->encode_rre($codec->encode_pixel(0,255,0), $x,$y,$w,$h,\r
 258 #                                                                                                               $codec->encode_rre_subrect( $codec->encode_pixel(255,255,255), 10,10,20,10),\r
 259 #                                                                                                               $codec->encode_rre_subrect( $codec->encode_pixel(0,128,128), 10,20,10,20)\r
 260 #                                                                                                       )\r
 261 #                                                                                               ) ;     \r
 262 \r
 263                 my $handler = $self->{UpdateDisplayHandler};\r
 264                 if (defined $handler) {\r
 265                         my $data = &$handler($self, $incremental, $x, $y, $w, $h);\r
 266 \r
 267                         $self->send_buffer($data);\r
 268                 }\r
 269 \r
 270                 $self->{UPDATE_REQUEST_PENDING} = undef;\r
 271                 $self->{SEND_UPDATE_RESPONSE} = undef;\r
 272 \r
 273         } else {\r
 274 \r
 275                 $self->{PENDING_UPDATE_REQUEST_BUFFER} = $buffer ;\r
 276 \r
 277                 $self->{UPDATE_REQUEST_PENDING} = 1;\r
 278         }\r
 279 \r
 280         return ;\r
 281 }\r
 282 \r
 283 sub do_key_event() {\r
 284         my $self = shift ;\r
 285         die "do_key_event called, when self is undef"  unless (defined $self);\r
 286 \r
 287         my $buffer = shift;\r
 288         die "do_key_event, buffer isn't 8 bytes long" unless (length $buffer==8);\r
 289 \r
 290         my (undef,$down,$pad,$key) = unpack("CCnN", $buffer) ;\r
 291 \r
 292         my $handler = $self->{KeyEventHandler};\r
 293         if (defined $handler) {\r
 294                 &$handler($self, $down, $key);\r
 295         }\r
 296         return ;\r
 297 }\r
 298 \r
 299 sub do_pointer_event() {\r
 300         my $self = shift ;\r
 301         die "do_pointer_event called, when self is undef"  unless (defined $self);\r
 302 \r
 303         my $buffer = shift;\r
 304         die "do_pointer_event, buffer isn't 6 bytes long" unless (length $buffer==6);\r
 305 \r
 306         my (undef,$mask,$x,$y) = unpack("CCnn", $buffer) ;\r
 307 \r
 308         my $handler = $self->{PointerEventHandler};\r
 309         if (defined $handler) {\r
 310                 &$handler($self, $mask, $x,$y);\r
 311         }\r
 312         return ;\r
 313 }\r
 314 \r
 315 sub do_client_cut_text() {\r
 316         my $self = shift ;\r
 317         die "do_client_cut_text called, when self is undef"  unless (defined $self);\r
 318 \r
 319         my $buffer = shift;\r
 320         print "Client Sent client cut text\n";\r
 321 \r
 322         my (undef,undef,$length,$text) = unpack("CnNA*", $buffer) ;\r
 323 \r
 324         my $handler = $self->{CutTextHandler};\r
 325         if (defined $handler) {\r
 326                 &$handler($self, $text);\r
 327         }\r
 328         return ;\r
 329 }\r
 330 \r
 331 sub start_conversation() {\r
 332         my $self = shift ;\r
 333         die "handle_client_data called, when self is undef"  unless (defined $self);\r
 334 \r
 335         my $fh = $self->{HANDLE};\r
 336         die "start_convertsion, handle is undef" unless (defined $fh);\r
 337 \r
 338         $self->send_buffer("RFB 003.003\n");\r
 339         $self->{STATE} = STATE_WAIT_FOR_PROTOCOL ;\r
 340         $self->{EXPECTED_BUFFER_SIZE} = 12 ;\r
 341 }\r
 342 \r
 343 sub handle_client_data() {\r
 344         my $self = shift ;\r
 345         die "handle_client_data called, when self is undef"  unless (defined $self);\r
 346 \r
 347         my $fh = $self->{HANDLE};\r
 348         die "start_convertsion, handle is undef" unless (defined $fh);\r
 349 \r
 350         #Read data from the socket\r
 351         my $data ;\r
 352         my $read_rc = $fh->sysread($data, 32786) ;\r
 353         \r
 354         if (defined $read_rc) {\r
 355                 if ($read_rc > 0) {\r
 356 \r
 357                         #data read OK\r
 358                         #add it to our buffer, check if we got enough data for the current state\r
 359                         $self->{RECV_BUFFER} .= $data ;\r
 360 \r
 361                         while ( length $self->{RECV_BUFFER} >= $self->{EXPECTED_BUFFER_SIZE} ) {\r
 362                                 #got enough data from current state, so handle the state\r
 363                                         \r
 364                                 #debug\r
 365 #                               print "Handle Buffer: expected size = ",$self->{EXPECTED_BUFFER_SIZE}," recv_buffer size = ", length($self->{RECV_BUFFER}),"\n";\r
 366                                         \r
 367                                 #take just the needed number of byte\r
 368                                 my $buffer = substr $self->{RECV_BUFFER},0,$self->{EXPECTED_BUFFER_SIZE};\r
 369 \r
 370                                 #leave the remaining bytes in the buffe\r
 371                                 $self->{RECV_BUFFER} = substr ($self->{RECV_BUFFER}, $self->{EXPECTED_BUFFER_SIZE}, length($self->{RECV_BUFFER})-$self->{EXPECTED_BUFFER_SIZE} ); \r
 372                                 \r
 373                                 #debug\r
 374 #                               print "After Buffer Split: buffer size = ", length($buffer), " recv_buffer size = ",length($self->{RECV_BUFFER}),"\n" ;\r
 375                                 \r
 376                                 $self->handle_state($buffer);\r
 377                         }\r
 378                 } else {\r
 379                         #read_rc == 0\r
 380                         #it means the socket was closed by the client\r
 381                                 \r
 382                                 \r
 383                         return undef;\r
 384                 }\r
 385         } else { \r
 386 #               die "Errro while reading socket";\r
 387                 \r
 388                 return undef;   \r
 389         }\r
 390         \r
 391         return 1;\r
 392 }\r
 393 \r
 394 sub handle_state {\r
 395         my $self = shift ;\r
 396         die "handle_state called, when self is undef"  unless (defined $self);\r
 397         \r
 398         my $buffer = shift ;\r
 399         die "handle_state called, when buffer is undef"  unless (defined $buffer);\r
 400         \r
 401         my $current_state = $self->{STATE};\r
 402 \r
 403         #\r
 404         # Got protocol version string from the cilent\r
 405         #       \r
 406         if ($current_state==STATE_WAIT_FOR_PROTOCOL) {\r
 407                 if (length($buffer) != 12) {\r
 408                         warn "Error: WAIT_FOR_PROTOCOL state, buffer != 12 bytes" ;\r
 409                         return undef;\r
 410                 };\r
 411                 \r
 412                 my ($major, $minor) = $buffer =~ m/^RFB (\d{3})\.(\d{3})$/ ;\r
 413                 die "unknown protocol version ($buffer)" unless (defined $major && defined $minor);\r
 414                 if ($major != 3) {\r
 415                         $self->send_buffer("Uknown version. i need major protocol version = 3\nBye Bye\n");\r
 416                         return undef;\r
 417                 }\r
 418                 print "Client requested protocol version $major.$minor\n";\r
 419                 \r
 420                 #\r
 421                 # Next step:\r
 422                 # Ask for password, if needed\r
 423                 #\r
 424 \r
 425                 if (defined $self->{Password}) {\r
 426                         $self->{STATE} = STATE_WAIT_FOR_AUTHENTICATION ;\r
 427                         $self->{EXPECTED_BUFFER_SIZE} = 16 ;\r
 428                         \r
 429                         $self->send_buffer(pack("N",2));\r
 430 \r
 431                         # TODO:\r
 432                         # send a challange and check the resonse using DES\r
 433                         $self->send_buffer("0123456789abcdef");\r
 434                 }\r
 435                 else {\r
 436                         # no password needed\r
 437                         $self->{STATE} = STATE_WAIT_FOR_CLIENT_INIT_MSG ;\r
 438                         $self->{EXPECTED_BUFFER_SIZE} = 1 ;\r
 439                         \r
 440                         $self->send_buffer(pack("N",1));\r
 441                 }\r
 442         } \r
 443         elsif\r
 444         #\r
 445         # Got Authentication response from the client\r
 446         #\r
 447         ($current_state==STATE_WAIT_FOR_AUTHENTICATION) {\r
 448                 if (length($buffer) != 16) {\r
 449                         warn "Error: WAIT_FOR_AUTHENTICATION state, buffer != 16 bytes" ;\r
 450                         return undef;\r
 451                 };\r
 452                 \r
 453                 #for now, accept any password\r
 454                 $self->send_buffer(pack("N",0));\r
 455 \r
 456                 #\r
 457                 # Next Stap:\r
 458                 # Client Init Msg\r
 459                 $self->{STATE} = STATE_WAIT_FOR_CLIENT_INIT_MSG;\r
 460                 $self->{EXPECTED_BUFFER_SIZE} = 1 ;\r
 461         }\r
 462         elsif\r
 463         #\r
 464         # Got client Init Message from the client\r
 465         #\r
 466         ($current_state==STATE_WAIT_FOR_CLIENT_INIT_MSG) {\r
 467                 if (length($buffer) != 1) {\r
 468                         warn "Error: WAIT_FOR_CLIENT_INIT_MSG state, buffer != 1 bytes" ;\r
 469                         return undef;\r
 470                 };\r
 471                 my $srvr_init_msg = BUILD_SERVER_INIT_MSG( $self->{Width}, \r
 472                                                                                                    $self->{Height},\r
 473                                                                                                    $self->{PixelFormat},\r
 474                                                                                                    $self->{Caption} );\r
 475                 $self->send_buffer($srvr_init_msg);\r
 476                 \r
 477                 #\r
 478                 # Next Step\r
 479                 # client normal messages\r
 480                 $self->{STATE} = STATE_WAIT_FOR_MSG_HEADER;\r
 481                 $self->{EXPECTED_BUFFER_SIZE} = 1 ;\r
 482         }\r
 483         elsif\r
 484         #\r
 485         # Got Message header from the client\r
 486         #\r
 487         ($current_state==STATE_WAIT_FOR_MSG_HEADER) {\r
 488                 if (length($buffer) != 1) {\r
 489                         warn "Error: STATE_WAIT_FOR_MSG_HEADER state, buffer != 1 bytes" ;\r
 490                         return undef;\r
 491                 };\r
 492                 \r
 493                 my $msg = ord($buffer) ;\r
 494                 \r
 495                 my ($subroutine, $byte_count) = @{$rfb_message_handlers[$msg]};\r
 496                 \r
 497                 die "Error: unknown message $msg" unless (defined $subroutine && defined $byte_count);          \r
 498 \r
 499                 # These are FixedLength messages, we can handle them all in the same way\r
 500                 if ( $msg==MSG_SET_PIXEL_FORMAT\r
 501                          or \r
 502                          $msg==MSG_FRAME_BUFFER_UPDATE_REQUEST\r
 503                          or\r
 504                          $msg==MSG_KEY_EVENT\r
 505                          or \r
 506                          $msg==MSG_POINTER_EVENT ) \r
 507                 {\r
 508                         #\r
 509                         # Next Step\r
 510                         # client normal messages\r
 511                         $self->{STATE} = STATE_WAIT_FOR_FIXED_LEN_MSG;\r
 512                         $self->{EXPECTED_BUFFER_SIZE} = $byte_count ;\r
 513                         \r
 514                         #re-insert this byte into the buffer\r
 515                         $self->{RECV_BUFFER} = pack("C",$msg) . $self->{RECV_BUFFER} ;\r
 516                         $self->{CURRENT_MSG} = $msg ;\r
 517                         \r
 518                 } elsif \r
 519                 ($msg==MSG_SET_ENCODING) {\r
 520                         $self->{STATE} = STATE_WAIT_FOR_ENCODING_COUNT;\r
 521                         $self->{EXPECTED_BUFFER_SIZE} = 3 ;\r
 522                         \r
 523                         $self->{ENCODING_BUFFER} = $buffer;\r
 524                 } elsif\r
 525                 ($msg==MSG_CLIENT_CUT_TEXT) {\r
 526                         $self->{STATE} = STATE_WAIT_FOR_TEXT_CUT_LENGTH;\r
 527                         $self->{EXPECTED_BUFFER_SIZE} = 7 ;\r
 528                         $self->{CUT_TEXT_BUFFER} = $buffer;\r
 529                 }\r
 530         }\r
 531         elsif\r
 532         #\r
 533         # Got Message header from the client\r
 534         #\r
 535         ($current_state==STATE_WAIT_FOR_FIXED_LEN_MSG) {\r
 536                 my $msg = $self->{CURRENT_MSG};\r
 537                 my ($subroutine, $byte_count) = @{$rfb_message_handlers[ $msg ]};\r
 538                 die "Error: unknown message $msg" unless (defined $subroutine && defined $byte_count);          \r
 539 \r
 540                 if (length($buffer) != $byte_count) {\r
 541                         warn "Error: STATE_WAIT_FOR_FIXED_LEN_MSG state (msg=$msg), buffer != $byte_count bytes" ;\r
 542                         return undef;\r
 543                 };\r
 544 \r
 545                 #\r
 546                 # Next Step\r
 547                 # Execute the client's request\r
 548                 &$subroutine($self,$buffer);\r
 549 \r
 550                 $self->{STATE} = STATE_WAIT_FOR_MSG_HEADER;\r
 551                 $self->{EXPECTED_BUFFER_SIZE} = 1 ;\r
 552         } elsif\r
 553         #\r
 554         # Got Encoding Count\r
 555         #\r
 556         ($current_state==STATE_WAIT_FOR_ENCODING_COUNT) {\r
 557                 if (length($buffer) != 3) {\r
 558                         warn "Error: STATE_WAIT_FOR_ENCODING_COUNT state, buffer != 3 bytes" ;\r
 559                         return undef;\r
 560                 };\r
 561         \r
 562                 my (undef,$nEncoding) = unpack("Cn", $buffer) ;\r
 563                 print "Client supports $nEncoding encodings\n" ;\r
 564                 \r
 565                 $self->{STATE} = STATE_WAIT_FOR_ENCODING_DATA;\r
 566                 $self->{EXPECTED_BUFFER_SIZE} = $nEncoding*4 ;\r
 567                 $self->{ENCODING_BUFFER} .= $buffer;\r
 568         } elsif\r
 569         #\r
 570         # Got Encoding Data\r
 571         #\r
 572         ($current_state==STATE_WAIT_FOR_ENCODING_DATA) {\r
 573                 $self->{ENCODING_BUFFER} .= $buffer;\r
 574                 \r
 575                 $self->do_set_encoding($self->{ENCODING_BUFFER});\r
 576 \r
 577                 $self->{STATE} = STATE_WAIT_FOR_MSG_HEADER;\r
 578                 $self->{EXPECTED_BUFFER_SIZE} = 1 ;\r
 579         } elsif\r
 580         #\r
 581         # Got Client Cut Text Length\r
 582         #\r
 583         ($current_state==STATE_WAIT_FOR_TEXT_CUT_LENGTH) {\r
 584                 if (length($buffer) != 7) {\r
 585                         warn "Error: STATE_WAIT_FOR_TEXT_CUT_LENGTH state, buffer != 7 bytes" ;\r
 586                         return undef;\r
 587                 };\r
 588         \r
 589                 my (undef,undef,$length) = unpack("CnN", $buffer) ;\r
 590                 print "Client Cut Text: $length characters \n" ;\r
 591                 \r
 592                 $self->{STATE} = STATE_WAIT_FOR_TEXT_CUT_CONTENT;\r
 593                 $self->{EXPECTED_BUFFER_SIZE} = $length ;\r
 594                 $self->{TEXT_CUT_BUFFER} .= $buffer;\r
 595         } elsif\r
 596         #\r
 597         # Got Client Cut text content\r
 598         #\r
 599         ($current_state==STATE_WAIT_FOR_TEXT_CUT_CONTENT) {\r
 600                 $self->{TEXT_CUT_BUFFER} .= $buffer;\r
 601                 \r
 602                 $self->do_client_cut_text($self->{TEXT_CUT_BUFFER});\r
 603                 $self->{TEXT_CUT_BUFFER} = undef;\r
 604 \r
 605                 $self->{STATE} = STATE_WAIT_FOR_MSG_HEADER;\r
 606                 $self->{EXPECTED_BUFFER_SIZE} = 1 ;\r
 607         } ;\r
 608 }\r
 609 \r
 610 1;