marcl@ESD.3Com.COM (Marc Lavine) (03/13/91)
Well, last week I was having trouble using SIGIO inside Perl. I
decided to rewrite my code to use select instead. That's when I
discovered that the "recv" call doesn't work as documented. From
looking at the code in eval.c, it seems obvious that recv does NOT
grow the string which it is passed, potentially causing all manner of
horrible results as it overwrites other data. I am not enclosing a
patch for this. I switched to using "read" instead, which does grow
the string passed to it.
That's when I discovered this next problem. I found that if I created
a lot of sockets, the "socket" call would start creating filehandles
with no files attached. These would cause core dumps when I called
fcntl on them. I tracked down the problem to the fact that there was
no error checking on the fdopen calls in doio.c. In addition to
returning bogus filehandles, Perl was also losing open file
descriptors. I found similar problems in the code for the socketpair,
accept, pipe, and open functions. I've enclosed a patch which I
believe fixes these problems (which appear to have been around since
at least version 3.0.37) and a test script which will demonstrate one
of them.
I hope that the powers that be will review these fixes and incorporate
them into the official 4.0 release.
Marc Lavine
#! /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: socket.bug.pl doio.c.patch
# Wrapped by marcl@cook.ESD.3Com.COM on Tue Mar 12 21:17:25 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'socket.bug.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'socket.bug.pl'\"
else
echo shar: Extracting \"'socket.bug.pl'\" \(1252 characters\)
sed "s/^X//" >'socket.bug.pl' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X#
X# Demonstrates a bug in Perl 4.0.beta:
X# The "socket" call can appear to succeed even though fileno is bogus.
X#
X
Xrequire "sys/socket.ph";
Xrequire "fcntl.ph";
X
Xchop ( $ourhostname = `hostname` );
X$sockaddr = 'S n a4 x8';
X$host = "localhost";
X$port = "discard";
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 );
Xif ( !( ( $name, $aliases, $type, $len, $rmtaddr )
X = gethostbyname ( $host ) ) )
X{
X print ( "Can't get address for ", $host, "\n" );
X return;
X}
X
X$sock = sprintf ( "SOCK.%d", $sock_counter++ );
X$localsock = pack ( $sockaddr, &AF_INET, 0, $localaddr );
X$rmtsock = pack ( $sockaddr, &AF_INET, $rmtport, $rmtaddr );
X
Xwhile ( $result = socket ( $sock, &AF_INET, &SOCK_STREAM, $proto ) )
X{
X printf ( "Socket result=%d, file number=%d, counter=%d\n",
X $result, fileno ( $sock ), $sock_counter );
X if ( !fileno ( $sock ) )
X {
X # Cause a coredump.
X fcntl ( $sock, &F_SETFL, &FNDELAY ) || die "fcntl: $!";
X }
X
X $sock = sprintf ( "SOCK.%d", $sock_counter++ );
X $localsock = pack ( $sockaddr, &AF_INET, 0, $localaddr );
X}
END_OF_FILE
if test 1252 -ne `wc -c <'socket.bug.pl'`; then
echo shar: \"'socket.bug.pl'\" unpacked with wrong size!
fi
chmod +x 'socket.bug.pl'
# end of 'socket.bug.pl'
fi
if test -f 'doio.c.patch' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'doio.c.patch'\"
else
echo shar: Extracting \"'doio.c.patch'\" \(2443 characters\)
sed "s/^X//" >'doio.c.patch' <<'END_OF_FILE'
X*** doio.c.dist Wed Feb 6 18:15:32 1991
X--- doio.c Tue Mar 12 18:49:31 1991
X***************
X*** 221,227 ****
X else
X fd = -1;
X }
X! fp = fdopen(dup(fd),mode);
X }
X else {
X while (isspace(*name))
X--- 221,229 ----
X else
X fd = -1;
X }
X! if (!(fp = fdopen(fd = dup(fd),mode))) {
X! close(fd);
X! }
X }
X else {
X while (isspace(*name))
X***************
X*** 298,304 ****
X if (stio->type != 's')
X stio->ofp = fp;
X else
X! stio->ofp = fdopen(fileno(fp),"w");
X }
X return TRUE;
X }
X--- 300,309 ----
X if (stio->type != 's')
X stio->ofp = fp;
X else
X! if (!(stio->ofp = fdopen(fileno(fp),"w"))) {
X! fclose(fp);
X! stio->ifp = Nullfp;
X! }
X }
X return TRUE;
X }
X***************
X*** 469,474 ****
X--- 474,486 ----
X wstio->ifp = wstio->ofp;
X rstio->type = '<';
X wstio->type = '>';
X+ if (!rstio->ifp || !wstio->ofp) {
X+ if (rstio->ifp) fclose(rstio->ifp);
X+ else close(fd[0]);
X+ if (wstio->ofp) fclose(wstio->ofp);
X+ else close(fd[1]);
X+ goto badexit;
X+ }
X
X str_sset(str,&str_yes);
X return;
X***************
X*** 1304,1309 ****
X--- 1316,1327 ----
X stio->ifp = fdopen(fd, "r"); /* stdio gets confused about sockets */
X stio->ofp = fdopen(fd, "w");
X stio->type = 's';
X+ if (!stio->ifp || !stio->ofp) {
X+ if (stio->ifp) fclose(stio->ifp);
X+ if (stio->ofp) fclose(stio->ofp);
X+ if (!stio->ifp && !stio->ofp) close(fd);
X+ return FALSE;
X+ }
X
X return TRUE;
X }
X***************
X*** 1426,1431 ****
X--- 1444,1455 ----
X nstio->ifp = fdopen(fd, "r");
X nstio->ofp = fdopen(fd, "w");
X nstio->type = 's';
X+ if (!nstio->ifp || !nstio->ofp) {
X+ if (nstio->ifp) fclose(nstio->ifp);
X+ if (nstio->ofp) fclose(nstio->ofp);
X+ if (!nstio->ifp && !nstio->ofp) close(fd);
X+ goto badexit;
X+ }
X
X str_nset(str, buf, len);
X return;
X***************
X*** 1990,1995 ****
X--- 2014,2028 ----
X stio2->ifp = fdopen(fd[1], "r");
X stio2->ofp = fdopen(fd[1], "w");
X stio2->type = 's';
X+ if (!stio1->ifp || !stio1->ofp || !stio2->ifp || !stio2->ofp) {
X+ if (stio1->ifp) fclose(stio1->ifp);
X+ if (stio1->ofp) fclose(stio1->ofp);
X+ if (!stio1->ifp && !stio1->ofp) close(fd[0]);
X+ if (stio2->ifp) fclose(stio2->ifp);
X+ if (stio2->ofp) fclose(stio2->ofp);
X+ if (!stio2->ifp && !stio2->ofp) close(fd[1]);
X+ return FALSE;
X+ }
X
X return TRUE;
X }
END_OF_FILE
if test 2443 -ne `wc -c <'doio.c.patch'`; then
echo shar: \"'doio.c.patch'\" unpacked with wrong size!
fi
# end of 'doio.c.patch'
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!marcllwall@jpl-devvax.jpl.nasa.gov (Larry Wall) (03/13/91)
In article <marcl.668838671@cook.ESD.3Com.COM> marcl@ESD.3Com.COM (Marc Lavine) writes: : Well, last week I was having trouble using SIGIO inside Perl. I : decided to rewrite my code to use select instead. That's when I : discovered that the "recv" call doesn't work as documented. From : looking at the code in eval.c, it seems obvious that recv does NOT : grow the string which it is passed, potentially causing all manner of : horrible results as it overwrites other data. I am not enclosing a : patch for this. I switched to using "read" instead, which does grow : the string passed to it. : : That's when I discovered this next problem. I found that if I created : a lot of sockets, the "socket" call would start creating filehandles : with no files attached.... : : I hope that the powers that be will review these fixes and incorporate : them into the official 4.0 release. They're fixed now, including recv. Thanks. Tonight I finally hacked in timelocal.pl, like the book sez is supposed to be there. Pretty much all I have left is to futz with metaconfig some more, and 4.0 will be there. Doubtless I've totally busted it somehow that won't show up till I release it... :-) Larry P.S. For the curious, here's timelocal.pl. Comments welcome. ;# timelocal.pl ;# ;# Usage: ;# $time = timelocal($sec,$min,$hours,$mday,$mon,$year,$junk,$junk,$isdst); ;# $time = timegm($sec,$min,$hours,$mday,$mon,$year); ;# These routines are quite efficient and yet are always guaranteed to agree ;# with localtime() and gmtime(). We manage this by caching the start times ;# of any months we've seen before. If we know the start time of the month, ;# we can always calculate any time within the month. The start times ;# themselves are guessed by successive approximation starting at the ;# current time, since most dates seen in practice are close to the ;# current date. Unlike algorithms that do a binary search (calling gmtime ;# once for each bit of the time value, resulting in 32 calls), this algorithm ;# calls it at most 6 times, and usually only once or twice. If you hit ;# the month cache, of course, it doesn't call it at all. ;# timelocal is implemented using the same cache. We just assume that we're ;# translating a GMT time, and then fudge it when we're done for the timezone ;# and daylight savings arguments. The timezone is determined by examining ;# the result of localtime(0) when the package is initialized. The daylight ;# savings offset is currently assumed to be one hour. CONFIG: { package timelocal; @epoch = localtime(0); $tzmin = $epoch[2] * 60 + $epoch[1]; # minutes east of GMT if ($tzmin > 0) { $tzmin = 24 * 60 - $tzmin; # minutes west of GMT $tzmin -= 24 * 60 if $epoch[5] == 70; # account for the date line } $SEC = 1; $MIN = 60 * $SEC; $HR = 60 * $MIN; $DAYS = 24 * $HR; } sub timegm { package timelocal; $ym = pack(C2, @_[5,4]); $cheat = $cheat{$ym} || &cheat; $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS; } sub timelocal { package timelocal; $ym = pack(C2, @_[5,4]); $cheat = $cheat{$ym} || &cheat; $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS + $tzmin * $MIN - 60 * 60 * ($_[8] != 0); } package timelocal; sub cheat { $year = $_[5]; $month = $_[4]; $guess = $^T; @g = gmtime($guess); while ($diff = $year - $g[5]) { $guess += $diff * (364 * $DAYS); @g = gmtime($guess); } while ($diff = $month - $g[4]) { $guess += $diff * (28 * $DAYS); @g = gmtime($guess); } $g[3]--; $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS; $cheat{$ym} = $guess; }