Lost data on socket - Can we start over politely?

From: Vorxion (vorxion_at_knockingshopofthemind.com)
Date: 03/29/04 

Date: 29 Mar 2004 10:46:04 -0500

In light of some uh...disagreements, I've bent a bit. Hopefully it's taken
as a token of goodwill. I could use the help, I'm willing to bend a bit to
do it. SO...

I've reworked this to both make it shorter, and so that my extra curly
brackets are not present. I also implemented strict and warnings.

In short, connect with anything and toss, say... 4000 thousand lines of
input at the server. It should give up the ghost far early--somewhere
around 1120-2200, depending on the phase of the moon. You'll note that if
you're still connected, you can even send more data. It's purely a
buffering issue.

I've switched to using only buffered reads and writes on the socket fd's,
so that's no longer the issue. I'm sure it was contributing, but nothing
I'm doing here should be affecting it, to the best of my knowledge.

Now that I've cleaned up my code (at least the majority) and am trying to
appease some people, could I please ask for assistance? (Yes, there are a
lot of variables in the our() statements that aren't used here...I trimmed
about 1000 lines of code out this time instead of ~800.)

If you just run it and toss input at it that's newline-separated, you'll
see what I mean. I'm tossing 3900+ lines at it. It gives up at 1123
somtimes, 2316 others, etc. Entirely arbitrary. It's not buffering
corretly, but I know not why at this point.

Any help would be -greatly- appreciated.

Bests,

Vorxion

*****

#!/usr/local/bin/perl5.8.0

########## Initialise.
##### Hot buffers.
$| = 1;

##### Strict.
use strict;
use warnings;
our($total_clients,$bin_dir,$short_bin_name,$version,$program,$local_host,$local_addr,$port,$max_conn,$psep,$timeout_seconds,$timeouts_per_second,$logopen,$waitedpid,$cli_log,$cli_background,$cli_working_dir,$cli_timeouts_per_second,$cli_logging,$cli_logfile,$cli_max_conn,$cli_port,$cli_timeout_seconds,$working_dir,$fltsv_config_dir,$fltsv_spool,$fltsv_host_access_file,$fltsv_nologin_file,$log,$cli_opt_return,$fltsv_query_type_file,$logfile,$oldhandle,$indiv_path,$user_pager,@all_paths,$user_path,$no_pager,$command_file,$env_file,$main_intake_buffer,$valid_type,$server,$line,$client);
our(%positions,%got_length,%got_packet,%timeouts,%child_pids,%child_done,%no_degrade,%packets,%lengths,%got_packets,%got_type,%got_user,%got_pass,%got_query_start,%got_query_lines,%got_query_end,%got_reply_start,%got_reply_end,%query_file,%response_file);
our(@active,@del_sels,@evars,@commands,@query_types,@inactives,@time_sels);

##### Need symbols for sysopen.
use Fcntl;
use Fcntl qw(:flock);

##### Need to get hostname and IP#.
use Socket;
use Sys::Hostname;
$local_host = hostname();
$local_addr = inet_ntoa(scalar(gethostbyname($local_host || 'localhost')));

##### Need IO::Socket.
use IO::Socket;
use IO::Select;
use Net::hostent;

##### Set default values.
$port = 4016;
$timeout_seconds = 30;
$timeouts_per_second = 4;
$log = '9';

########## Begin main processing.
##### Open log if set.
if (defined(${cli_logfile}) and $log ne 'off') {
     sysopen(LOGFILE,$logfile,O_CREAT|O_WRONLY|O_TRUNC,0600) or fl_die(1,"Could not open log file.");
     $oldhandle = select(LOGFILE);
     $|=1;
     select($oldhandle);
     $logopen = 1;
     fl_log("Server starting on $local_addr.");
     fl_log("Opened logfile '$logfile'.");
} elsif ($log ne 'off') {
     fl_log("Server starting on $local_addr.");
     fl_log("Opened logfile [STDOUT].");
}

##### Create socket.
my $sel = IO::Select->new;
$server = IO::Socket::INET->new(
     Proto => 'tcp',
     LocalPort => $port,
     Listen => SOMAXCONN,
     ReuseAddr => 1,
     Timeout => 0.25
);
fl_die(3,"Cannot create socket.") unless $server;
fl_log("Listening on port $port.") if $log ne 'off';
$server->autoflush(1);
$server->blocking(0);

##### Main server loop.
while (1) {
     ##### Clean up dead connections.
     while (scalar(@del_sels)) {
          my $single_conn = shift(@del_sels);
          clean_dead($single_conn);
     }

     ##### Resume timers for connections whose children have finished.
     foreach my $client ($sel->handles) {
          my $found = 0;
          my $fd = $client->fileno;
          foreach my $child (keys(%child_pids)) {
               $found++,last if $child_pids{$child} == $fd;
          }
          $no_degrade{$fd} = 0 unless $found;
     }

     ##### Update timers for connections that didn't get anything last time.
     ##### First, determine which processes were active and select the rest
     ##### for update.
     foreach my $inactive (keys(%timeouts)) {
          my $found = 0;
          foreach my $single_conn (@active) {
               $found++ if $single_conn == $inactive;
          }
          push(@inactives,$inactive) unless $found;
     }

     ##### Make sure to clear the active list for the next cycle.
     undef @active;

     ##### Actually decrement the timers for selected idle connections.
     while (scalar(@inactives)) {
          my $inactive = shift(@inactives);
          $timeouts{$inactive} -= (1 / $timeouts_per_second) * 2 unless $no_degrade{$inactive};
     }

     ##### Clean connections that have timed out entirely.
     undef @time_sels;
     @time_sels = keys(%timeouts);
     while (scalar(@time_sels)) {
          my $single_conn = shift(@time_sels);
          if ($timeouts{$single_conn} <= 0) {
               push(@del_sels,$single_conn);
          }
     }
     while (scalar(@del_sels)) {
          my $single_conn = shift(@del_sels);
          foreach my $one_sel (${sel}->handles) {
               $single_conn = $one_sel, last if $one_sel->fileno == $single_conn;
          }
          my $remote_hostinfo = gethostbyaddr($single_conn->peeraddr);
          my ($remote_hostname);
          if (defined($remote_hostinfo)) {
               $remote_hostname = $remote_hostinfo->name || $single_conn->peerhost;
          } else {
               $remote_hostname = inet_ntoa($single_conn->peeraddr);
          }
          $remote_hostname .= ' (' . $single_conn->fileno . ')';
          $single_conn->shutdown(2);
          $total_clients--;
          fl_log("Connection from $remote_hostname timed out. Disconnected.") if $log ne 'off';
          fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
          clean_dead($single_conn);
     }

     ##### Obtain new connections.
     undef $client;
     $client = $server->accept();
     if (defined($client)) {
          ##### Got one. Initialise everything.
          $client->autoflush(1);
          $client->blocking(0);
          $sel->add($client);
          $total_clients++;
          my $remote_hostinfo = gethostbyaddr($client->peeraddr);
          my ($remote_hostname);
          if (defined($remote_hostinfo)) {
               $remote_hostname = $remote_hostinfo->name || $client->peerhost;
          } else {
               $remote_hostname = inet_ntoa($client->peeraddr);
          }
          $remote_hostname .= ' (' . $client->fileno . ')';

          ##### Must have passed initial restrictions.
          fl_log("Host $remote_hostname connected.") if $log ne 'off';
          fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
     }

     ##### Handle connections with exceptions.
     foreach my $single_conn (${sel}->has_exception(1/${timeouts_per_second})) {
          ##### Handle non-polite connection drops.
          unless (defined($single_conn->peeraddr)) {
               fl_log("Remote peer abruptly disconnected.") if $log ne 'off';
               push(@del_sels,$single_conn);
               $single_conn->shutdown(2);
               $total_clients--;
               fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
               next;
          }
          ##### Handle rest of polite exceptions.
          my $remote_hostinfo = gethostbyaddr($single_conn->peeraddr);
          my ($remote_hostname);
          if (defined($remote_hostinfo)) {
               $remote_hostname = $remote_hostinfo->name || $single_conn->peerhost;
          } else {
               $remote_hostname = inet_ntoa($single_conn->peeraddr);
          }
          $remote_hostname .= ' (' . $single_conn->fileno . ')';
          fl_log("Remote peer $remote_hostname disconnected.") if $log ne 'off';
          push(@del_sels,$single_conn);
          $single_conn->shutdown(2);
          $total_clients--;
          fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
     }

     ##### Delete references to connections that had exceptions.
     while (scalar(@del_sels)) {
          my $single_conn = shift(@del_sels);
          clean_dead($single_conn);
     }

     ##### Handle reading from connections with data ready.
     foreach my $single_conn (${sel}->can_read(1/${timeouts_per_second})) {
fl_log("BUFFER: ".length(${main_intake_buffer})."\n");
          ##### Handle non-polite connection drops.
          unless (defined($single_conn->peeraddr)) {
               fl_log("Remote peer abruptly disconnected.") if $log ne 'off';
               push(@del_sels,$single_conn);
               $single_conn->shutdown(2);
               $total_clients--;
               fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
               next;
          }
          ##### Handle reading on connections that politely hung around.
          my $remote_hostinfo = gethostbyaddr($single_conn->peeraddr);
          my ($remote_hostname);
          if (defined($remote_hostinfo)) {
               $remote_hostname = $remote_hostinfo->name || $single_conn->peerhost;
          } else {
               $remote_hostname = inet_ntoa($single_conn->peeraddr);
          }
          $remote_hostname .= ' (' . $single_conn->fileno . ')';
          ##### Try to get packet length.
          my $line_number = 0;
          while ($single_conn->read($line,102400)) {
               foreach my $sub_line (split(/\n/,$line)) {
                    $line_number++;
                    fl_log("$line_number: $sub_line") unless $sub_line =~ /\n$/;
                    $line = $sub_line if $sub_line =~ /\n$/;
               }
          }

          ##### Retry for more packets if present.
          redo unless $single_conn->eof;
     }

     ##### Clean up any dead connections.
     while (scalar(@del_sels)) {
          my $single_conn = shift(@del_sels);
          clean_dead($single_conn);
     }
}

##### Close log if set.
if (defined(${cli_logfile}) and ${cli_logfile} ne '__FLTbogus') {
     fl_log("Closing logfile ${logfile}.") if $log ne 'off';
     close(LOGFILE) or fl_die(2,"Could not close log file.");
}

##### Done.
exit;

########## Miscellaneous functions.
##### Disassemble packets.
sub get_packet {
     my ($in_packet,$msg,$proto,@full,$one,$two);

     $in_packet = $_[0];

     ($one,$two) = split(/${psep}/,$in_packet);
     $two = pack("B*",pack("h*",unpack("u*",pack("h*",${two}))));
     push(@full,${one},${two});
     
     if (defined(wantarray) and wantarray) {
          return(@full);
     } else {
          return($full[1]);
     }
}

##### Custom die.
sub fl_die {
     my ($ecode,$emsg,$full_msg);

     $ecode = $_[0];
     $emsg = $_[1];
     if (defined($cli_logfile) and $cli_logfile ne '__FLTbogus' and $logopen) {
          syswrite(LOGFILE,"SERVER_ERROR_$ecode: $emsg\n");
          close(LOGFILE) if defined($cli_logging);
     } else {
          syswrite(STDOUT,"SERVER_ERROR_$ecode: $emsg\n");
     }
     exit($ecode);
}

sub fl_log {
     my ($log_str,$timestr);

     $log_str = $_[0];
     $timestr = localtime(time);
     if (defined(${cli_logfile}) and $log ne 'off') {
          syswrite(LOGFILE,"$0 [$$] $timestr: $log_str\n");
     } elsif ($log ne 'off') {
          syswrite(STDOUT,"$0 [$$] $timestr: $log_str\n");
     }
     return;
}

Relevant Pages

  • Re: Lost data on socket - Can we start over politely?
    ... I also implemented strict and warnings. ... > buffering issue. ... > I've switched to using only buffered reads and writes on the socket fd's, ... Instead please try this server (some quickly reduced code from a bigger ...
    (comp.lang.perl.misc)
  • Re: losing data on socket
    ... One side note--The server itself isn't a forking model, ... Create socket. ... sub REAPER { ...
    (comp.lang.perl.misc)
  • Sockets, Performance, Messaging, NetworkStream
    ... I have implemented async socket server & client, ... line of buffering and then actually write the data into the socket. ... Current performance is about 8 messages per second where server sends to ...
    (microsoft.public.dotnet.framework.performance)
  • IO::Socket Disconection Detection
    ... $sock->connectedno longer equals $server. ... If the socket is in a connected state the the peer ... sub logoff { ... Do you Yahoo!? ...
    (perl.beginners)
  • Re: Need Help with this Async code
    ... > I'm trying to use Async Socket calls to create a tcp server. ... > Dim ep As New IPEndPoint ... > Private Sub AcceptCallback ... Your trying to read off your server socket. ...
    (microsoft.public.dotnet.languages.vb)