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).$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; }
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)); }
Oh, in the above code,#!/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; }
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!writen ($socket,substr($buf,0,1)); writen ($socket,substr($buf,1,$RW_BUF_LEN-1));
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
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |