marcl@ESD.3Com.COM (Marc Lavine) (03/09/91)
I've been fiddling around with some Perl code to do asynchronous
network I/O using SIGIO. I've been running this on a Sparcstation SLC
under SunOS 4.1.1. I'm having problems with Perl dying in a variety
of ways. I suspect that this is a reentrancy problem. I started with
Perl 3.0.44 and then switched to 4.0.beta. Malloc seemed like a
probable culprit (since malloc is likely to be used inside my SIGIO
handler), so I rebuilt perl with GNU malloc (which is supposed to be
reentrant). This changed the symptoms slightly (Perl would often get
an abort rather than a segmentation violation or bus error). The
problem also shows up using Sun malloc's and Perl's own malloc.
Sometimes it would die with "panic: restorelist inconsistency". I'm
enclosing a Perl script that should make it possible for others to
reproduce this problem. To see the problem, just feed sigio.pl a file
with one hostname per line (such as the enclosed "hosts" file). It
will create a bunch of connections to the hosts' SMTP ports and if
your environment has the same problem as mine, it will eventually die
(although, I suppose you might need to feed it more hostnames than are
in my sample file). Am I trying to do the impossible with Perl or
have I simply run into a bug?
#! /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: sigio.pl hosts
# Wrapped by marcl@cook.ESD.3Com.COM on Fri Mar 8 18:27:03 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'sigio.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'sigio.pl'\"
else
echo shar: Extracting \"'sigio.pl'\" \(3846 characters\)
sed "s/^X//" >'sigio.pl' <<'END_OF_FILE'
X#!/usr/local/bin/perl -- # -*-Perl-*-
X#
X# Experiments with networking in perl.
X#
X
X$debug_printing = 1;
X
Xrequire "sys/socket.ph";
Xrequire "fcntl.ph";
Xrequire "errno.ph";
Xrequire "ctime.pl";
X
Xchop ( $ourhostname = `hostname` );
X$sockaddr = 'S n a4 x8';
X$SIG{'IO'} = 'SIGIO_Handler';
X$sock_select_mask = '';
X
Xwhile ( <> )
X{
X chop;
X &Initiate_Connection ( $_, "smtp" );
X}
X
Xsleep ( 20 );
X
X
Xsub debug_print
X {
X if ( $debug_printing )
X {
X print @_;
X }
X }
X
X
X# SIGIO signal handler
Xsub SIGIO_Handler
X {
X &debug_print ( "SIGIO_Handler entered\n" );
X local ( $sock, $data );
X local ( $timeout ) = 0;
X local ( $read_mask ) = $sock_select_mask;
X local ( @ready_socks );
X local ( $bytes_read, $result );
X
X local ( $nfound ) = select ( $read_mask, undef, undef, 0 );
X if ( $nfound == -1 )
X {
X warn "select: $!";
X }
X else
X {
X &debug_print ( $nfound, " handles ready for reading\n" );
X }
X
X @ready_socks = grep ( vec ( $read_mask, fileno ( $_ ), 1 ),
X values ( %handles_by_number ) );
X
X foreach $sock ( @ready_socks )
X {
X # Socket has pending input
X $result = recv ( $sock, $data, 1024, 0 );
X if ( !defined ( $result ) )
X {
X print ( "Error talking to ",
X $sock_hostname { $sock }, ": ", $!, "\n" );
X &Terminate_Connection ( $sock );
X }
X else
X {
X &debug_print ( "Read " . length ( $data ) . " bytes from ",
X $sock_hostname { $sock }, ":\n" );
X print $data;
X }
X }
X
X &debug_print ( "SIGIO_Handler done\n" );
X }
X
X
X# Create a connection to the specified host and port.
Xsub Initiate_Connection
X {
X &debug_print ( "Initiate_Connection entered\n" );
X local ( $host ) = $_[0];
X local ( $port ) = $_[1];
X local ( $result, $localaddr, $rmtaddr, $localsock, $rmtsock );
X local ( $name, $aliases, $proto, $rmtport, $len );
X local ( $sock ) = sprintf ( "SOCK.%d", $sock_counter++ );
X
X &debug_print ( $_[0], ":\n" );
X
X ( $name, $aliases, $proto ) = getprotobyname ( "tcp" );
X ( $name, $aliases, $rmtport ) = getservbyname ( $port, "tcp" )
X unless $port =~ /^\d+$/;
X ( $name, $aliases, $type, $len, $localaddr ) =
X gethostbyname ( $ourhostname );
X if ( !( ( $name, $aliases, $type, $len, $rmtaddr )
X = gethostbyname ( $host ) ) )
X {
X print ( "Can't get address for ", $host, "\n" );
X return;
X }
X
X $localsock = pack ( $sockaddr, &AF_INET, 0, $localaddr );
X $rmtsock = pack ( $sockaddr, &AF_INET, $rmtport, $rmtaddr );
X
X while ( !( $result = socket ( $sock, &AF_INET, &SOCK_STREAM, $proto ) ) )
X {
X if ( $result == &EMFILE )
X {
X # Wait for an existing socket to be closed.
X &debug_print ( "Waiting for a socket...\n" );
X sleep ( 1 );
X }
X else
X {
X die "socket: $!";
X }
X }
X
X local ( $sockno ) = fileno ( $sock );
X $handles_by_number { $sockno } = $sock;
X $sock_hostname { $sock } = $name;
X vec ( $sock_select_mask, $sockno, 1 ) = 1;
X &debug_print ( "Socket file number=", $sockno, "\n" );
X
X fcntl ( $sock, &F_SETOWN, $$ ) || die "fcntl (set owner): $!";
X fcntl ( $sock, &F_SETFL, &FNDELAY | &FASYNC ) || die "fcntl: $!";
X &debug_print ( "Fcntls done.\n" );
X bind ( $sock, $localsock ) || die "bind: $!";
X &debug_print ( "Bind done.\n" );
X
X ( $result = connect ( $sock, $rmtsock ) ) || ( $! == &EINPROGRESS )
X || die "connect: $!";
X &debug_print ( "Connect done.\n" );
X
X &debug_print ( "Initiate_Connection done\n" );
X }
X
X
X# Destroy the specified connection.
Xsub Terminate_Connection
X {
X &debug_print ( "Terminate_Connection entered\n" );
X local ( $sock ) = $_[0];
X
X local ( $sockno ) = fileno ( $sock );
X vec ( $sock_select_mask, $sockno, 1 ) = 0;
X shutdown ( $sock, 2 );
X close ( $sock );
X
X undef $handles_by_number { $sockno };
X undef $sock_hostname { $sock };
X
X &debug_print ( "Terminate_Connection done\n" );
X }
END_OF_FILE
if test 3846 -ne `wc -c <'sigio.pl'`; then
echo shar: \"'sigio.pl'\" unpacked with wrong size!
fi
chmod +x 'sigio.pl'
# end of 'sigio.pl'
fi
if test -f 'hosts' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'hosts'\"
else
echo shar: Extracting \"'hosts'\" \(200 characters\)
sed "s/^X//" >'hosts' <<'END_OF_FILE'
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
Xlocalhost
END_OF_FILE
if test 200 -ne `wc -c <'hosts'`; then
echo shar: \"'hosts'\" unpacked with wrong size!
fi
# end of 'hosts'
fi
echo shar: End of shell archive.
exit 0
--
Marc Lavine Broken: marcl%3Com.Com@sun.com
Smart: marcl@3Com.Com UUCP: ...{sun|decwrl}!3Com.Com!marcl