Front page | perl.perl5.porters |
Postings from March 2000
Dave's Insanity PATCH fixes duped opens and spices up your life!
Thread Next
From:
Tom Christiansen
Date:
March 20, 2000 09:12
Subject:
Dave's Insanity PATCH fixes duped opens and spices up your life!
Message ID:
142.953572367@chthon
I've fixed a hot bug that's been with us back since perl5.0, in
which you can't dup or fdopen anything you can use as a legitimate
filehandle. After my saucy patch, all existing io tests continue
to work. I include my own test to test the patch, although they're
not yet in "ok\n" form, pending acceptance. Here are the results
of my included tests after the insanity patch:
fh1 GLOB(0x11455c) is fileno 3
fh2 GLOB(0x11458c) is fileno 4
fh3 GLOB(0x1145bc) is fileno 3
fh4 GLOB(0x1145d4) is fileno 5
fh5 GLOB(0x114610) is fileno 3
iofileobj IO::File=GLOB(0x137fb4) is fileno 6
fh6 GLOB(0x13783c) is fileno 7
fh7 GLOB(0x1146b8) is fileno 6
fhobj FileHandle=GLOB(0x1e3968) is fileno 8
fh8 GLOB(0xfdf90) is fileno 9
ioobj Dave's Insanity Sauce=IO(0xff460) is fileno 0
fh9 GLOB(0xfdf6c) is fileno 10
fh10 GLOB(0xfdcd8) is fileno 0
All tests ran as expected
First the patch; season at will. I don't pretend that this is
pretty (I don't like that I scan twice, but I'm trying to use
existing interfaces; perhaps this should be its own function). Nor
is the the potential for assisted suicide particulary pretty, but
I don't know how to fix that: how can I test whether *p is legal
for unknown p? Just don't create files named "IO(ffffffff)" and
run perl -p on * in that directory -- atlhough this is obviously
far less riskly than the existing case of creating files named
"rm -rf *|" and running the same thing. :-)
Ok, fine, so like this might well be completely insane. I whipped
it up pretty quickly. Nevertheless, it does work as stated, fixes
things broken for*EVER*, and passes both its own tests and all
existing I/O tests. I even commented it, which I realize is largely
unheard of in the Perl core, but, as I admit, it may be insane. If
you don't like it, could you please suggest another fix for all
these ugly bugs? :-(
--- doio.c-PREHACK Mon Mar 20 06:41:44 2000
+++ doio.c Mon Mar 20 09:35:30 2000
@@ -299,13 +299,54 @@
else {
IO* thatio;
gv = gv_fetchpv(name,FALSE,SVt_PVIO);
+
thatio = GvIO(gv);
if (!thatio) {
+ /* Are they trying to dup an interpolated
+ * handle object, either a GLOB or IO,
+ * irrespective of blessing? XXX: could
+ * have been intentionally faked up string
+ * w/ illegal memory addr. Well, for that
+ * they get the SEGV they earned. Tough noogies.
+ * --tchrist 3/20/00 */
+ if (!gv) {
+ char *sp = name;
+ int wasio = 0;
+ for (; *sp && *sp != '='; sp++) /* continue */ ;
+ if (*sp && *sp == '=') name = sp+1;
+ if (*name && (strnEQ(name, "GLOB(0x", 7) ||
+ (strnEQ(name, "IO(0x", 5) && ++wasio)))
+ {
+ I32 nl; /* unused */
+ UV addr; /* where it really lives */
+ char *s; /* chase down end of hex */
+ int maxlen; /* how far to hex scan */
+
+ name += wasio ? 5 : 7;
+ for ( s = name, maxlen = 12;
+ *s && maxlen &&
+ strchr((char *) PL_hexdigit, *s);
+ s++, --maxlen) /* continue */ ;
+
+ if (addr = (UV)scan_hex(name, 12-maxlen, &nl)) {
+ if (wasio)
+ thatio = (struct io *)addr;
+ else {
+ gv = (GV *)addr;
+ thatio = GvIO(gv);
+ }
+ if (thatio)
+ goto got_an_io;
+ }
+ }
+ }
+
#ifdef EINVAL
SETERRNO(EINVAL,SS$_IVCHAN);
#endif
goto say_false;
}
+got_an_io:
if (IoIFP(thatio)) {
PerlIO *fp = IoIFP(thatio);
/* Flush stdio buffer before dup. --mjd
And now the tests:
use warnings;
for $fh (*STDIN, *STDOUT, *STDERR) { $seen{ fileno $fh } ++ }
open($fh1, "< /etc/motd") or die "open motd: $!";
die "no $fh1 fileno" unless defined fileno $fh1;
print "fh1 $fh1 is fileno ", fileno($fh1), "\n";
die "already saw " . fileno $fh1 if $seen{fileno $fh1}++;
open($fh2, "<&$fh1") or die "dup of $fh1 failed: $!";
die "no $fh2 fileno" unless defined fileno $fh2;
print "fh2 $fh2 is fileno ", fileno($fh2), "\n";
die "already saw " . fileno $fh2 if $seen{fileno $fh2}++;
die "$fh2 is dup $fh1, but shouldn't be" if fileno $fh1 == fileno $fh2;
open($fh3, "<&=$fh1") or die "fdopen of $fh1 failed: $!";
die "no $fh3 fileno" unless defined fileno $fh3;
print "fh3 $fh3 is fileno ", fileno($fh3), "\n";
die "never saw " . fileno $fh3 unless $seen{fileno $fh3}++;
die "$fh3 not dup $fh1, but should be" if fileno $fh1 != fileno $fh3;
$io = *{$fh3}{IO};
open($fh4, "<&$io") or die "io dup of $fh3 ($io) failed: $!";
die "no $fh4 fileno" unless defined fileno $fh4;
die "already saw " . fileno $fh4 if $seen{fileno $fh4}++;
print "fh4 $fh4 is fileno ", fileno($fh4), "\n";
die "$fh4 is dup $fh3, but shouldn't be" if fileno $fh4 == fileno $fh3;
open($fh5, "<&=$io") or die "io fdopen of $fh3 ($io) failed: $!";
die "no $fh5 fileno" unless defined fileno $fh5;
print "fh5 $fh5 is fileno ", fileno($fh5), "\n";
die "never saw " . fileno $fh5 unless $seen{fileno $fh5}++;
die "$fh5 not dup $fh3, but should be" if fileno $fh5 != fileno $fh3;
die "$fh5 is dup $fh4, but shouldn't be" if fileno $fh5 == fileno $fh4;
require IO::File;
($iofileobj = IO::File::->new)->open("< /dev/null")
or die "IO::Handle new open failed: $!";
die "no $iofileobj fileno" unless defined fileno $iofileobj;
print "iofileobj $iofileobj is fileno ", fileno($iofileobj), "\n";
die "already saw " . fileno $iofileobj if $seen{fileno $iofileobj}++;
open($fh6, "<&$iofileobj") or die "dup of $iofileobj failed: $!";
die "no $fh6 fileno" unless defined fileno $fh6;
print "fh6 $fh6 is fileno ", fileno($fh6), "\n";
die "already saw " . fileno $fh6 if $seen{fileno $fh6}++;
open($fh7, "<&=$iofileobj") or die "fdopen of $fd6 ($iofileobj) failed: $!";
die "no $fh7 fileno" unless defined fileno $fh7;
print "fh7 $fh7 is fileno ", fileno($fh7), "\n";
die "never saw " . fileno $fh7 unless $seen{fileno $fh7}++;
require FileHandle;
$fhobj = FileHandle::->new("< /dev/null")
or die "FileHandle new failed: $!";
die "no $fhobj fileno" unless defined fileno $fhobj;
print "fhobj $fhobj is fileno ", fileno($fhobj), "\n";
die "already saw " . fileno $fh8 if $seen{fileno $fh8}++;
open($fh8, "<&$fhobj") or die "dup of $fhobj failed: $!";
die "no $fh8 fileno" unless defined fileno $fh8;
print "fh8 $fh8 is fileno ", fileno($fh8), "\n";
die "already saw " . fileno $fh8 if $seen{fileno $fh8}++;
$ioobj = bless *STDIN{IO} => "Dave's Insanity Sauce";
print "ioobj $ioobj is fileno ", fileno($ioobj), "\n";
open($fh9, "<&$ioobj") or die "dup of $fh9 ($ioobj) failed: $!";
die "no $fh9 fileno" unless defined fileno $fh9;
print "fh9 $fh9 is fileno ", fileno($fh9), "\n";
die "already saw " . fileno $fh9 if $seen{fileno $fh9}++;
open($fh10, "<&=$ioobj") or die "fdopen of $fh10 ($ioobj) failed: $!";
die "no $fh10 fileno" unless defined fileno $fh10;
print "fh10 $fh10 is fileno ", fileno($fh10), "\n";
die "never saw " . fileno $fh10 unless $seen{fileno $fh10}++;
close $fh1 || warn "can't close fh1 $fh1: $!";
close $fh2 || warn "can't close fh2 $fh2: $!";
close $fh3 && warn "failed to not close fh3 $fh3";
close $fh4 || warn "can't close fh4 $fh4: $!";
close $fh5 && warn "failed to not close fh5 $fh5";
close $iofileobj || warn "can't close iofileobj $iofileobj";
close $fh6 || warn "can't close fh6 $fh6: $!";
close $fh7 && warn "failed to not close fh7 $fh7";
close $fhobj || warn "can't close fhobj $fhobj";
close $fh8 || warn "can't close fh8 $fh8: $!";
close $fh9 || warn "can't close fh9 $fh9: $!";
close $ioobj || warn "can't close ioobj $ioobj";
close $fh10 && warn "failed to not close fh10 $fh10";
print "All tests ran as expected\n";
Thread Next
-
Dave's Insanity PATCH fixes duped opens and spices up your life!
by Tom Christiansen