in reply to Re: Perl jumps to END logic after fileno (Win32)
in thread Perl jumps to END logic after fileno (Win32)

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(); } }

Replies are listed 'Best First'.
Re^3: Perl jumps to END logic after fileno (Win32)
by Anonymous Monk on Aug 09, 2017 at 01:32 UTC

    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) ... failure is either the report that either STDOUT or STDERR are gone, or message that new_from_fd failed

    Hi,

    What is "perl software" and "systems" (versions)?

    I cannot reproduce on strawberry-perl-5.18.2.2-32bit-portable on old winxp machine

      It is Strawberry Perl 5.24.0 (64-bit) on Windows 7 and Windows 10.

      My Windows 7 laptop does not experience any issues, but some other Windows 7 systems and a Windows 10 test system I have do. Each of the systems that experience issues have SSD drives. So far that has been the only thing we have found in common with the failing systems.

      I tried with an old 5.16.3 Version of perl I had on my system and the warnings go away. So somewhere between 5.16.3 and 5.24.0 the changes with threading have added logic that is attempting to close some of my handles or at least is warning about failing.

      Here are those warnings
      Warning: unable to close filehandle $errwrite properly: Bad file descr +iptor at tshoot.pl line 34. Warning: unable to close filehandle $outwrite properly: Bad file descr +iptor at tshoot.pl line 34.
      Testing with 5.16.3 on a system that experiences failures, it still fails, but without the "unable to close filehandle" warning messages.