develooper 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


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About