How to find open global file descriptors in perl program

Question

I just discovered a problem when I had to close all open file descriptors for my Apache cgi script to continue. I traced the issue with Parse :: RecDescent.

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
$|++;

print "Content-Type: text/plain\n\n";

use Parse::RecDescent;

say "$$: pre-fork: ". time;

if(my $pid = fork) {
    # parent
    say "$$: return immediately: ". time;
}
else {
    # child 
    say "$$: kicked off big process: ". time;
    close STDIN;
    close STDOUT;
    close STDERR;
    # close *{'Parse::RecDescent::ERROR'};
    sleep 5;
}

My question is how to find all open package file descriptors?

I know that it filenowill return a counter for an open file descriptor. Is there a way to do a reverse lookup for them or close file descriptors with their counter fileno?

Answer 1

On some systems, the directory returned "/proc/$$/fd/"contains a list of open file descriptors. You can use POSIX::closeto close them.

# close all filehandles
for (glob "/proc/$$/fd/*") { POSIX::close($1) if m{/(\d+)$}; }

Answer 2

ikegami curiosity, , , , , STDIN, STDOUT STDERR , :

   $SYSTEM_FD_MAX
   $^F     The maximum system file descriptor, ordinarily 2.
           System file descriptors are passed to exec()ed
           processes, while higher file descriptors are not.
           Also, during an open(), system file descriptors are
           preserved even if the open() fails.  (Ordinary file
           descriptors are closed before the open() is
           attempted.)  The close-on-exec status of a file
           descriptor will be decided according to the value of
           $^F when the corresponding file, pipe, or socket was
           opened, not the time of the exec().

, execve(2) , close-on-exec . , sleep 5 stand-in .

Answer 3

:

use strict;
use warnings;
use constant BREAK_DESCENT => {};

use Carp    qw<croak>;
use English qw<$EVAL_ERROR>; # $@

sub break_descent { 
    return BREAK_DESCENT if defined wantarray;
    die BREAK_DESCENT;
}

sub _package_descend {
    my ( $package_name, $stash, $selector ) = @_;
    my $in_main     = $package_name =~ m/^(?:main)?::$/; 
    foreach my $name ( keys %$stash ) { 
        next if ( $in_main and $name eq 'main::' );
        my $full_name = $package_name . $name;
        local $_      = do { no strict 'refs'; \*$full_name; };
        my $return 
            = $name =~ m/::$/ 
            ? _package_descend( $full_name, *{$_}{HASH}, $selector ) 
            : $selector->( $package_name, $name => $_ )
            ;
        return BREAK_DESCENT if ( ref( $return ) and $return == BREAK_DESCENT );
    }
    return;
}

sub package_walk {

    my ( $package_name, $selector ) 
        = @_ == 1 ? ( '::', shift )
        :           @_
        ;

    $package_name  .= '::' unless substr( $package_name, -2 ) eq '::';
    local $EVAL_ERROR;

    eval { 
       no strict 'refs';
       _package_descend( $package_name, \%$package_name, $selector ); 
    };

    return unless $EVAL_ERROR;
    return if     do { no warnings 'numeric'; $EVAL_ERROR == BREAK_DESCENT; };

    say STDERR $EVAL_ERROR;
    croak( 'Failed in selector!' );
}

package_walk( sub { 
    my ( $pkg, $name ) = @_;
    #say "$pkg$name";
    # to not close handles in ::main::
    #return if $pkg =~  m/^(?:main)?::$/;
    # use IO::Handle methods...
    map { defined and $_->opened and $_->close } *{$_}{IO}; 
});

Answer 4

open , ? - :

use Scalar::Util 'weaken';
use Symbol ();
my @handles;
BEGIN {
    *CORE::GLOBAL::open = sub (*;$@) {
        if (defined $_[0] and not ref $_[0]) {
            splice @_, 0, 1, Symbol::qualify_to_ref($_[0])
        }
        my $ret =
            @_ == 1 ? CORE::open $_[0] :
            @_ == 2 ? CORE::open $_[0], $_[1] :
                      CORE::open $_[0], $_[1], @_[2 .. $#_];
        if ($ret) {
            push @handles, $_[0];
            weaken $handles[-1];
        }
        $ret
    }
}

sub close_all_handles {
    $_ and eval {close $_} for @handles
}

open FH, $0;

say scalar <FH>;  # prints "use Scalar::Util 'weaken';"

close_all_handles;

say scalar <FH>;  # error: readline() on closed file handle

, , (- ).

If you place this override (block BEGIN) before the call use Parse::RecDescent, then it will override the calls to openwhich the module makes.

Answer 5

I ended up using @ikegami's suggestion, but I was interested in the @Axeman method. Here is a simplified version.

# Find all file-handles in packages.
my %seen;
sub recurse {
    no strict 'refs';
    my $package = shift or return;
    return if $seen{$package}++;

    for my $part (sort keys %{$package}) {
        if (my $fileno = fileno($package.$part)) {
            print $package.$part." => $fileno\n";
        }
    }
    for my $part (grep /::/, sort keys %{$package}) {
        (my $sub_pkg = $package.$part) =~ s/main:://;
        recurse($sub_pkg);
    }
}
recurse('main::');