I have been able to narrow down the code a little.

In doing so I can see that my call to threads->create is attempting to close half of my pipe that I am passing to it. Due to Win32 process peculiarities I need to forcefully close some file handles using a hardclose function. I also needed to close the STDOUT/STDERR handles in my thread, so I wasn't seeing the warnings. Somehow the combination of the warnings and hardcloses causes file descriptors to get corrupted on *SOME* systems.

It is possibly a race condition, as the Perl software is identical between the systems I test on, yet one fails within the first 50 iterations of the loop in this test, whereas the other system has processed over 40000 iterations of the loop with no issues (aside from the warning messages). The behavior also changes when removing the print statements.

failure is either the report that either STDOUT or STDERR are gone, or message that new_from_fd failed

use threads;
use threads::shared;
use Time::HiRes;
require Win32API::File;
Win32API::File->import(":Func",":Misc",":HANDLE_FLAG_");

my $running :shared = 0;
my $goreaders :shared = 0;

END {
        print "This is the end\n";
}

my $i = 0;

while(1) {

        $running = 0;
        $goreaders = 0;

        my $fh = Scalar::Util::openhandle(\*STDOUT);
        if (! defined $fh) {
                print STDERR "STDOUT is gone\n";
        }
        $fh = Scalar::Util::openhandle(\*STDERR);
        if (! defined $fh) {
                print STDOUT "STDERR is gone\n";
        }

        pipe my $outread, my $outwrite;
        pipe my $errread, my $errwrite;

        my $outthread = threads->create('fhreader', \$goreaders, \$run
+ning, $outread);
        my $errthread = threads->create('fhreader', \$goreaders, \$run
+ning, $errread);

        # wait for threads to initialize
        lock($running);
        if ($running < 2) {
                my $absto = time() + 4;  # 4 second timeout
                do {
                        cond_timedwait($running, $absto) || last;
                } while ($running < 2);
                if ($running < 2) {
                        die "reader threads did not start!\n";
                }
        }
        print "Threads Started\n";

        # connect STDOUT/STDERR to the write end of the pipes
        # save a copy of the original STDOUT/STDERR
        my $saveIN  = IO::Handle->new_from_fd(\*STDIN, 'r');
        my $saveOUT = IO::Handle->new_from_fd(\*STDOUT, 'w');
        my $saveERR = IO::Handle->new_from_fd(\*STDERR, 'w');

        if (! defined $saveOUT) {
                print STDERR "new_from_fd(STDOUT) failed!!!!!\n";
        }
        if (! defined $saveERR) {
                print STDERR "new_from_fd(STDERR) failed!!!!!\n";
        }

        pipe STDIN, $inwrite;

        STDOUT->fdopen($outwrite, 'w');
        STDERR->fdopen($errwrite, 'w');
        # Need hardclose because our threads hold copies of the handle
+s and prevent
        # the refcnt on the handles from hitting zero and closing the 
+OS Handle
        # hardclose will close the OS Handle
        hardclose($outwrite);
        hardclose($errwrite);
        print $saveOUT "Swapped STDOUT/STDERR\n";

        # fork subprocess -- unnecessary to demonstrate issue
        # Win32::Process::Create ...

        hardclose(\*STDIN);
        hardclose(\*STDOUT);
        hardclose(\*STDERR);
        print $saveOUT "Closed pipes\n";

        STDIN->fdopen($saveIN, 'r');
        STDOUT->fdopen($saveOUT, 'w');
        STDERR->fdopen($saveERR, 'w');
        softclose($saveIN);
        softclose($saveOUT);
        softclose($saveERR);
        print STDOUT "Restored STDOUT/STDERR\n";

        # signal threads to process
        {
                lock($goreaders);
                $goreaders=1;
                cond_broadcast($goreaders);
        }

for my $th ($outthread,$errthread) {
        if (! $th->is_joinable()) {
                eval { $th->exit(); };
                my $quitinTime = Time::HiRes::time() + 2;
                while($th->is_running() && ($quitinTime > Time::HiRes:
+:time())) {
                        Time::HiRes::sleep(0.05);
                }
                if ($th->is_running()) {
                        eval { $th->kill('KILL')->detach(); } ;
                        next;
                }
        }
        eval { $th->join(); } ;
}

printf "Done %d\n", ++$i;

}

sub fhreader {
        my ($start, $running, $reader) = @_;
        {
                lock($$start);
                {
                        lock($$running);
                        ++$$running;
                        cond_signal($$running);
                }
                cond_wait($$start); # wait to start
        }
        while(<$reader>) { }
        $reader->close();
        return(0);
}

sub hardclose {
        # not only close the regular Perl IO Handle, but close the und
+erlying OS Handle as well
        # This is primarily useful for closing the handles we had open
+ when creating a new thread
        # forcing the handle closed in the entire process, even though
+ the ithread holds a copy of
        # the perl handle  (can't use :shared on the handle, might yet
+ be another way though)
        my (@handles) = @_;
        for my $h (@handles) {
                next if(! defined $h);
                #my $fd = eval { fileno $h };
                my $fd = fileno $h;
                if (defined $fd && $fd >= 0) {
                        my $osfh =  FdGetOsFHandle($fd); # get the OS 
+native file handle
                        if (! CloseHandle($osfh)) {
                                print STDERR "CloseHandle failed\n";
                        }
                } else {
                        print STDERR "fileno failed\n";
                }
                $h->close();
        }
}

sub softclose {
        # normal Perl IO Handle close on each handle passed
        my (@handles) = @_;
        for my $h (@handles) {
                next if (! defined $h);
                $h->close();
        }
}

[download]

In reply to Re^2: Perl jumps to END logic after fileno (Win32) by dchidelf
in thread Perl jumps to END logic after fileno (Win32) by dchidelf

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.