Alright, so in looking deeper at the warnings I am receiving it seems as though windows is likely reusing the OS level filehandle I am pulling out from under the Perl handle via my hardclose logic.

Then when perl implicitly closes the Perl handle it is closing whatever ended up reusing that OS handle causing unspecified behavior.

So perhaps to avoid this I should ask for assistance in accomplishing my goal.

Hi,

What?

#!/usr/bin/perl --
use strict;
use warnings;
use autodie qw/ open close /;
use threads stack_size => 4096;
open FOO, '<', __FILE__ or die $!;
if( @ARGV ){
#~     threads->create(sub { use autodie qw/ close /; close FOO; })->d
+etach;
    threads->create(sub {
        close FOO;
    })->join;
    threads->create(sub {
        close FOO;
        ## close FOO; ## this one autodies, "terminated abnormally:"
        eval { close FOO; 1 } or warn $@;
        return;
    })->join;
    close FOO;
    close FOO; ## this one autodies
} else {
    close FOO;
    close FOO;    ## this one autodies
}
__END__
$ perl threads-close-filehandle.pl
Can't close filehandle 'FOO': 'Bad file descriptor' at threads-close-f
+ilehandle.pl line 22

$ perl threads-close-filehandle.pl 1
Can't close filehandle 'FOO': 'Bad file descriptor' at threads-close-f
+ilehandle.pl line 15
Can't close filehandle 'FOO': 'Bad file descriptor' at threads-close-f
+ilehandle.pl line 19
[download]

Thanks. At first I was responding with "it's not that easy", but this actually seems like it might have helped.

I am creating the threads from within a "constructor" in a package and need to close a file handle that is being assigned to a scalar rather than a type glob. Since the scalar is scoped to the scope of the subroutine and the thread logic was outside of that function I was attempting to pass the handle as an argument to the thread, which fails in various ways.

If I declare the thread logic in an anonymous sub nested inside the "constructor" it seems like I will be able to just reference the scalar within that same scope and be able to close the copy that gets dup'd into the new thread.

Test mockup works, I just need to test it with pipes and all the other details

#!/usr/bin/perl --
use strict;
use warnings;
use autodie qw/ open close /;
use threads stack_size => 4096;

package test;

sub doit {
    my $self = {};
    my $FOO;
    open $FOO, '<', 'WISDOM.ico' or die $!;
    my $threadcode = sub {
        close $FOO;
        eval { close $FOO; 1 } or warn $@;
        sleep 60;
        return;
    };
    $self->{'th'} = threads->create($threadcode);
    close $FOO;
    eval { close $FOO; 1 } or warn $@;
    bless $self;
}
sub joinit {
    my ($self) = @_;
    my $th = $self->{'th'};
    $th->join();
}

my $t = test::doit();
print "thread created\n";
# OS Tests here indicate the file descriptor is closed
$t->joinit();
print "thread ended\n";
sleep 100;
[download]

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]

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.
[download]

Testing with 5.16.3 on a system that experiences failures, it still fails, but without the "unable to close filehandle" warning messages.