This seems to reproduce it about 90% of the time. Create a 2961 byte
file as /tmp/xx (works for me, you may need it larger or smaller
for your system). Oh, I'm running the server and client on the
same system so that's no problem.
% ./server &
% ./client localhost:9999
connection on S, fd: 3
inside fork: pid=2740
sigpipe
I'm getting a SIGPIPE instead of ENOTCONN, but it may be that
I'm seeing another side of the same problem. Anyway, this is
something for others to play around with in the meantime.
I'll dig some more (maybe some packet traces will tell more).
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: client server
# Wrapped by [email protected] on Wed Sep 8 20:04:00 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'client' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'client'\"
else
echo shar: Extracting \"'client'\" \(1842 characters\)
sed "s/^X//" >'client' <<'END_OF_FILE'
X#!/usr/bin/perl
X$usage = "usage: client host[:port] [local-file]\n";
X
Xsub pipe { print "sigpipe\n"; exit 0; }
X# $SIG{PIPE} = 'IGNORE';
X$SIG{PIPE} = 'pipe';
X
Xdo 'sys/socket.ph';
X$sockaddr = 'S n a4 x8'; # socket structure format
X
X$url = shift || die $usage;
X$file = shift;
X
X$url =~ m#^([^:/]+):*(\d*)(.*)#;
X$host = $1 || die $usage;
X$port = $2 || 80;
X$path = $3 || "/";
X
Xchop($hostname = `hostname`);
X$thisaddr = (gethostbyname($hostname))[4];
X$thataddr = (gethostbyname($host))[4];
X&bind_port(S, $port, 'tcp', $thisaddr, $thataddr);
X
Xprint S "foobar\r\n";
Xsleep(1);
Xfor $i (1..10) { print S "x-foobar: abcdefghijklmnopqrstuvwxyz\r\n"; }
Xif (defined $file) {
X &safeopen(STDOUT, ">", $file) || die "open: $!";
X}
X&raw_fd(S, STDOUT);
Xclose(STDOUT); close(S);
Xexit 0;
X
Xsub bind_port {
X local($fd, $port, $proto, $thisaddr, $thataddr) = @_;
X $proto = (getprotobyname($proto))[2] || die "getproto: $proto: $!";
X socket($fd, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
X setsockopt($fd, &SOL_SOCKET, &SO_REUSEADDR, pack("l", 1));
X local($this) = pack($sockaddr, &AF_INET, 0, $thisaddr);
X bind($fd, $this) || die "bind: $!";
X local($that) = pack($sockaddr, &AF_INET, $port, $thataddr);
X connect($fd, $that) || die "connect: $!";
X select((select($fd), $| = 1)[0]);
X}
X
X# handles partial writes
Xsub raw_fd {
X local($FROM, $TO) = @_;
X local($_, $len, $written, $offset);
X
X while (($len = sysread($FROM, $_, 8192)) != 0) {
X if (!defined $len) {
X next if $! =~ /^Interrupted/;
X die "sysread: $!";
X }
X $offset = 0;
X while ($len) {
X $written = syswrite($TO, $_, $len, $offset);
X die "syswrite: $!" unless defined $written;
X $len -= $written;
X $offset += $written;
X }
X }
X}
X
Xsub safeopen {
X local($fh, $rw, $_) = @_;
X s#^\s#./$&#;
X open($fh, "$rw $_\0");
X}
END_OF_FILE
if test 1842 -ne `wc -c <'client'`; then
echo shar: \"'client'\" unpacked with wrong size!
fi
chmod +x 'client'
# end of 'client'
fi
if test -f 'server' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'server'\"
else
echo shar: Extracting \"'server'\" \(3470 characters\)
sed "s/^X//" >'server' <<'END_OF_FILE'
X#!/usr/bin/perl
Xrequire 'errno.ph';
Xrequire 'sys/socket.ph';
Xrequire 'sys/unistd.ph';
Xrequire 'sys/file.ph';
Xrequire 'fcntl.ph';
Xrequire 'sys/stat.ph';
Xrequire 'sys/wait.ph';
X
X$sockaddr = 'S n a4 x8'; # socket structure format
X$s_flock = "sslll"; # struct flock {type, whence, start, len, pid}
X$port = 9999;
X
Xchop($hostname = `hostname`);
X$thisaddr = (gethostbyname($hostname))[4];
X&bind_port(S, $port, 'tcp');
X&daemon(S);
Xdie "byebye";
X
Xsub daemon {
X local(@fds) = @_;
X local($rin, $rout) = &fhbits(@fds);
X $restart_daemon = 0;
XCONNECTION:
X until ($restart_daemon) {
X if (($nfound = select($rout=$rin, undef, undef, undef)) < 0) {
X next CONNECTION if $! == &EINTR;
X die "select: $!";
X }
X foreach (@fds) {
X if (vec($rout, fileno($_), 1)) {
X &debug("connection on $_, fd: ", fileno($_));
X $peeraddr = accept(NS, $_);
X if (fork == 0) { # fork immediately to prevent delays
X &debug("inside fork: pid=$$");
X open(STDIN, '<& NS');
X open(STDOUT, '>& NS');
X select(STDOUT); $| = 1;
X close(NS); close($_);
X &client_connect($_, $peeraddr);
X exit 0;
X }
X close(NS); # continue in parent thread
X }
X }
X }
X # dropped out of loop, so we restart ourselves
X die "goodbye";
X}
X# deal with the client connection and returning errors properly
Xsub client_connect {
X local($from, $peeraddr) = @_;
X eval 'open(XX,"< /tmp/xx"); &raw_fd(XX, STDOUT)';
X if ($@) {
X (($exception, $__error_msg) = ('internal_error', $@))
X unless ($exception = &thrown);
X &client_error($exception, $__error_msg);
X $@ = undef; # never mind
X }
X}
X
Xsub reaper {
X while(waitpid(-1,&WNOHANG) > 0) { ; }
X $SIG{'CHLD'} = "reaper";
X}
X
Xsub timeout_error { die "Server timed out after 30 seconds." }
X
Xsub fhbits {
X local($bits, $_);
X for (@_) { vec($bits, fileno($_), 1) = 1; }
X $bits;
X}
X
Xsub restart_daemon { $restart_daemon++; }
X
Xsub cleanup { exit 0; }
X
Xsub thrown { $@ =~ /^(EXCEPTION: )+(.+)/ && $2; }
X
Xsub getserv { ($_[0] =~ m/^\d+$/) ? $_[0] : (getservbyname($_[0], $_[1]))[2]; }
X
Xsub set_timeout { $SIG{'ALRM'} = "timeout_error"; alarm(30); }
Xsub clear_timeout { $SIG{'ALRM'} = ''; alarm(0); }
Xsub debug { print STDERR @_, "\n"; }
X
Xsub bind_port {
X local($fd, $port, $proto, $this) = @_;
X &debug("binding $port to $fd\n");
X $proto = (getprotobyname($proto))[2] || die "getproto: $!";
X socket($fd, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
X setsockopt($fd, &SOL_SOCKET, &SO_REUSEADDR, pack("l", 1));
X $this = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");
X bind($fd, $this) || die "bind: $!";
X listen($fd, &SOMAXCONN) || die "listen: $!";
X select((select($fd), $| = 1)[0]);
X &setfd(0, fileno($fd)); # keep alive
X}
X
X# handles partial writes
Xsub raw_fd {
X local($FROM, $TO) = @_;
X local($_, $len, $written, $offset);
X
X while (($len = sysread($FROM, $_, 8192)) != 0) {
X if (!defined $len) {
X next if $! =~ /^Interrupted/;
X die "sysread: $!";
X }
X $offset = 0;
X while ($len) {
X $written = syswrite($TO, $_, $len, $offset);
X die "syswrite: $!" unless defined $written;
X $len -= $written;
X $offset += $written;
X }
X }
X}
X
Xsub safeopen {
X local($fh, $rw, $_) = @_;
X s#^\s#./$&#;
X open($fh, "$rw $_\0");
X}
X
X
Xsub setfd {
X local($flag, $_) = shift @_;
X while ($_ = shift @_) {
X fcntl($_, &F_SETFD, $flag); # set/clear close-on-exec
X }
X}
END_OF_FILE
if test 3470 -ne `wc -c <'server'`; then
echo shar: \"'server'\" unpacked with wrong size!
fi
chmod +x 'server'
# end of 'server'
fi
echo shar: End of shell archive.
exit 0