in reply to Socket descriptor passed across fork -- hanging

I looked back at some Perl code that I wrote to emulate one of my fork based C servers. This server used fixed length packets (256 bytes) but I hope that this will be useful for you to extend to the idea of an arbitrary length "\r\n" terminated packet. First the child's read and write subs, then some comments. 
$SIG{PIPE} = sub {close $active; exit (3)};
sub readn
{
   my ($socket, $bytes ) = @_;
   my $offset = 0;
   
   my $buf = "";
   while ($offset < $bytes)
   {
      my $nread;
      my $nleft = $bytes-$offset;
      
      $nread = sysread($socket,$buf,$nleft,$offset);
      kill 'PIPE',$$ unless (defined $nread);  ## undef is like -1 uni
+x return
      last if ($nread ==0);                    ## EOF
      
      $offset += $nread;
   }
   
   return ($buf,$offset);
}

sub writen
{
   my ($socket, $buf) = @_;
   my $bytes = length $buf;
   my $offset =0;
     
   while ($offset < $bytes)
   {
       my $nwritten;
       my $nleft = $bytes-$offset;
       
       $nwritten = syswrite($socket,$buf,$nleft,$offset);
       kill 'PIPE',$$ unless (defined $nwritten);  # undef is like -1 
+unix return
       
       $offset += $nwritten;
   }
   
   return $offset;
}

[download]
First off, there are some imperfections in the translation from the C way to the Perl way! Probably returning \$buf instead of $buf would be better, etc. But this code covers the three cases of a)EOF b)end of packet c)SIGPIPE (client died).

When the client sends 256 bytes, often the readn() will see 2 128 byte receptions even if both client and server are on the same machine. In practice, you will see "hunks of data" even if client sends "huge thing" or "byte at a time". A couple of "trips" through sysread is no big deal.

Note when I see undef from sysread(), I send SIGPIPE to myself! This is so "client went away" is handled consistently and "by normal method".

There is no need to read one byte at a time even if you want to read "lines". Just check for network line termination at the end of the received bytes to see if you need to continue to loop for more bytes.

Note: network line termination is: carriage return, line feed NOT \n. In Perl, if you write a string to a socket, Perl will send the right thing. But if you are receiving bytes or sending raw bytes, it is up to you to do the "right thing".

The above is not "finished code" for your specific app, but I hope it gives you a starting place. Your line oriented code that "does not hang" will be similar and about the same length.

Update:

I found a complete client/server application pair written in a)Perl and b)C for you. This is a demo forking server. The client is able to query "who" is on the server. What the client/server does is not that impressive. How it does it and the use of the normal signals is much more to the point.

Perl Server:

#!/usr/bin/perl -w 
use strict;  

use IO::Socket;
use POSIX ":sys_wait_h";

my $RW_BUF_LEN = 256;
my $SERVER_TIMEOUT_SECS = 20;
my $active;

#note SOMAXCONN is system max of queue for incoming clients
#Listen=>1 would have also have been just fine

$SIG{PIPE} = sub {close $active; exit (3)};
$SIG{ALRM} = sub {close $active; exit (7)};
$SIG{CHLD} = sub {local ($!, $?); while (waitpid(-1, WNOHANG) > 0){} }
+;

my $passive = IO::Socket::INET->new( Proto     => 'tcp',
                                     LocalPort => 12455,
                                     Listen    => SOMAXCONN,
                                     Reuse     => 1,
                                     Type      => SOCK_STREAM
                                   )
     or die "Server is unable to start: $!\n";

while(1)
{
    $active = $passive->accept() or next; # next not really necessary
                                          # Perl > 5.8 has deferred si
+gnals by default on
                                          # so a signal cannot occur w
+ithin accept()!
                                          

    die "Bad Fork! $!\n" if ( !defined(my $pid = fork()) );
    
    if ($pid != 0)     #Parent  note: Windows has a negative $pid (for
+k emulation)
    {
       close $active;  #parents do not talk to anybody
       next;
    }
    
    ####### we are the child #########
    close $passive;  #Client's don't listen for connections!
    
    my %whoData;
    open (WHO, "who|") or die "can't open pipe from who command $!\n";
    while ( my $line = <WHO>)
    {
       my ($user) = $line =~ m/^(\w+)/;
       push @{$whoData{$user}}, $line; 
    }
    close WHO; 
    
    my $buf;
    while(alarm($SERVER_TIMEOUT_SECS), ($buf) = readn($active, $RW_BUF
+_LEN), 
          $buf !~ m/^\*quit/ )
    {  
        alarm(0);
        if ($buf =~ m/^\*all/)
        {
           DumpAllWhoData($active,\%whoData);
           next;
        }
        
        my ($username) = $buf =~ m/^(\w+)/;
        if (exists $whoData{$username})
        {
            foreach my $line ( @{$whoData{$username}} )
            {                    
                SendStringToClient($active,$line);
            }
            SendStringToClient($active,"\01");
        }
        else
        {
            SendStringToClient ($active, "username not found!\n");
            SendStringToClient ($active, "\01");
        }  
    }
    
    close $active;
    exit(0);  #prevent grandchildren!  #### Very important!!!    
}

sub readn
{
   my ($socket, $bytes ) = @_;
   my $offset = 0;
   
   my $buf = "";
   while ($offset < $bytes)
   {
      my $nread;
      my $nleft = $bytes-$offset;
      
      $nread = sysread($socket,$buf,$nleft,$offset);
      kill 'PIPE',$$ unless (defined $nread);  ## undef is like -1 uni
+x return
      last if ($nread ==0);                    ## EOF
      
      $offset += $nread;
   }
   
   return ($buf,$offset);;
}

sub writen
{
   my ($socket, $buf) = @_;
   my $bytes = length $buf;
   my $offset =0;
     
   while ($offset < $bytes)
   {
       my $nwritten;
       my $nleft = $bytes-$offset;
       
       $nwritten = syswrite($socket,$buf,$nleft,$offset);
       kill 'PIPE',$$ unless (defined $nwritten);  # undef is like -1 
+unix return
       
       $offset += $nwritten;
   }
   
   return $offset;
}

sub DumpAllWhoData
{
   my ($socket, $href) = @_;
   
   foreach my $user (keys %$href)
   {
      foreach my $line ( @{$href->{$user}} )
      {         
         SendStringToClient($socket,$line);
      }
   }
   
   SendStringToClient($socket,"\01");
}

sub SendStringToClient
{
   my ($socket, $string) = @_;

   my $pad = $RW_BUF_LEN - length $string;
   my $buf = $string.pack("x$pad");
   writen ($socket,substr($buf,0,1));
   writen ($socket,substr($buf,1,$RW_BUF_LEN-1));
}

[download]
Perl Client: 
#!/usr/bin/perl -w
use strict;

use IO::Socket;

my $RW_BUF_LEN = 256;
my $TERMINATOR = 01;   #CTRL-A

$SIG{'PIPE'} = sub{print "Server Disconnected! Write to server failed!
+\n"; exit(1);};
$SIG{'INT'}  = \&terminal_handler;
$SIG{'QUIT'} = \&terminal_handler;
$SIG{'USR1'} = sub{print "Communications Error - read from server fail
+ed!\n"; exit(3);};

my ($socket) = IO::Socket::INET->new(
                                       PeerAddr => 'voyager.deanza.edu
+',
                                       PeerPort => 12455,
                                       Proto    => 'tcp',
                                       Type     => SOCK_STREAM
                                     )
   || die "Cannot connect to server! $!\n";
  
my $input;
while ( (print "Enter username (or *quit): "),
        ($input = <STDIN>) !~ m/^\s*\*quit\s*$/)
{
   next if $input =~ /^\s*$/;  # blank line, re-prompt
   my ($username, $kruft) = split /\s+/, $input;
   
   if ($kruft)
   {
      print "Only one username per line allowed!\n";
      next;
   }
   
   my $pad = $RW_BUF_LEN - length ($username);
   my $buf = $username.pack("x$pad");    # pads $buf with null \000 ch
+ars 
   #print "length of username packet=",length $buf,"\n";  # for debug
   
   writen ($socket,substr($buf,0,1));             
   writen ($socket,substr($buf,1,$RW_BUF_LEN-1));
   
   open (my $more, "|more") || die "cannot open pipe to more! $!\n";
   
   while (($buf) = readn($socket, $RW_BUF_LEN),
          $TERMINATOR != ord(unpack("a1",$buf)) )
   {     
       my ($temp) = $buf =~ m/^(.*?\n)/; #needed for "more"
                                         #regular "print $buf;" is fin
+e
                                         #but trailing nulls drive "mo
+re" crazy!
       print $more $temp;
   }
   close $more;
}

send_quit_packet();  #tell server we are "hanging up"
close $socket;
exit(0);

##################
sub terminal_handler
{
   my $signame = shift;
   print "\nClient: received signal: $signame\n";   #debugging stateme
+nt
   print "Client: Disconnecting from server!\n";    #debugging stateme
+nt

   send_quit_packet();  #say, "bye, bye"
   close $socket;
   exit(2);
}

sub send_quit_packet
{   
   my $pad = $RW_BUF_LEN - length ('*quit');
   my $buf = '*quit'.pack("x$pad");
   #print "length of quit packet buffer = ",length $buf,"\n"; #debug
   
   writen ($socket,substr($buf,0,1));             
   writen ($socket,substr($buf,1,$RW_BUF_LEN-1));
}

sub readn
{
   my ($socket, $bytes ) = @_;
   my $offset = 0;
   
   my $buf = "";
   while ($offset < $bytes)
   {
      my $nread;
      my $nleft = $bytes-$offset;
      
      $nread = sysread($socket,$buf,$nleft,$offset);
      kill 'USR1',$$ unless (defined $nread);  ## undef is like -1 uni
+x return
      last if ($nread ==0);                    ## EOF
      
      $offset += $nread;
   }
   
  # print "length of received buff=",length $buf,"\n";
  # print $buf;
   return $buf;
}

sub writen
{
   my ($socket, $buf) = @_;
   my $bytes  = length $buf;
   my $offset = 0;
     
   while ($offset < $bytes)
   {
       my $nwritten;
       my $nleft = $bytes-$offset;
       
       $nwritten = syswrite($socket,$buf,$nleft,$offset);
       kill 'PIPE',$$ unless (defined $nwritten);  # undef is like -1 
+unix return
       
       $offset += $nwritten;
   }
   
   #print "num bytes written to server: $offset\n";
   return $offset;
}

[download]
Oh, in the above code, 
writen ($socket,substr($buf,0,1));             
writen ($socket,substr($buf,1,$RW_BUF_LEN-1));

[download]
This is an ancient artifact and it still exists under some OS's. To cause a SIGPIPE when the "other end" goes away sometimes requires 2 writes. Lunix will figure this out on the first write, but this is not universally true and that is the reason for this strange looking code!

C Client/Server: The C code of the above is longer, much longer. Since this is a Perl forum, I am not sure that it would add value, but if requested, I will do it.

Replies are listed 'Best First'.
Re^2: Socket descriptor passed across fork -- hanging
by dd-b (Pilgrim) on Oct 13, 2011 at 13:50 UTC

    Yeah, I know the line terminators are "wrong" in my server; it's for an existing local protocol with existing clients and servers, so I can't mess with that. So "\n" is "right" for this case, though non-standard.

    I see you're going down to the sysread level. That's probably the cleanest solution. I started out using line-mode reads, which was working fine until we uncovered the clients that didn't terminate their last line. Since the value proposition for this server is increasing our flexibility in deploying multiple copies of servers, bundling commands into servers dynamically, and so forth, without having to change and redeploy all the clients, that was kind of a quandry, so I've had to give up line-oriented IO. But because you're using fixed-length packets, you avoid the actual problem that trapped me.

    You say in the code that the "next" if accept returns undef isn't necessary any more, but I've seen my $listen->accept() call return EINTR (perl 5.8.8, Linux 2.6.18), so it seems to be necessary still here.

    I really appreciate a more sophisticated running example. I've been wondering about things like closing the handles not used after the fork, for example; you seem to think that's worth bothering with.

[reply]
      I would like for you to explain what this means:

      until we uncovered the clients that didn't terminate their last line What?

      They closed the socket before sending \r\n?

      My code deals with that.

      because you're using fixed-length packets, you avoid the actual problem that trapped me
      No, not at all.

      I thought that I explained clearly how to deal with an indeterminate length \r\n terminated packet.
      What was not clear?
      Obviously something was not.
      It would help if you could ask the question in a different way.

      Please look at: sysread. sysread() will return with a number of bytes read.
      If the other side sends: "1234\r\n", just look at the end of the buffer to see if there is a line termination (last 2 bytes).
      What's the problem?
      I think that you can easily adapt my code to deal with your requirements.

[reply]

        They closed their socket without sending \n, yes. Shit happens in the real world; possibly encouraged by servers being generous in what they accept.

        I guess I misread the code or your description of the protocol, sorry.

        What are the tradeoffs of using sysread/syswrite vs. read/print? The obvious one is I have to implement my own line-oriented read for the first line of the protocol, which I have to read and parse. Is dropping down a level going to be of significant benefit, and if so in what?

        I've been finding various strange returns from $sock->read(), including undef with $! empty. However, by taking a desperate leap and treating all errors except EINTR and EAGAIN as end-of-file, my proxy is now successfully passing data back and forth between test clients and real servers (next step will be to more aggressive test clients, and then real clients). For the proxy, treating a read error as EOF isn't really too bad a choice, clearly it's time to close that connection and terminate the proxy child!

[reply]

In Section Seekers of Perl Wisdom