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; }
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)); }
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; }
Oh, in the above code,
writen ($socket,substr($buf,0,1)); writen ($socket,substr($buf,1,$RW_BUF_LEN-1));
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.


In reply to Re: Socket descriptor passed across fork -- hanging by Marshall
in thread Socket descriptor passed across fork -- hanging by dd-b

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.