Question

我刚刚找到了一个问题，我必须关闭所有打开的文件句柄才能继续使用我的Apache cgi脚本。我将问题追溯到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;
}

我的问题是如何找到所有打开的包文件句柄？

我知道fileno会返回一个打开文件句柄的计数器。有没有办法对它们进行反向查找，或者通过fileno计数器关闭文件句柄？

Answer 1

在某些系统上，"/proc/$$/fd/"返回的目录包含打开的文件描述符列表。您可以使用POSIX::close关闭它们。

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

Answer 2

在追踪关于ikegami的好奇心的详细执行细节时，我想我发现你需要做的就是自己关闭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是什么的替身。

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

这应该捕获所有全局句柄，甚至是任何已创建但从未清理过的词法句柄（由于循环引用或其他原因）。

如果在调用BEGIN之前放置此覆盖（use Parse::RecDescent块），则它将覆盖模块对open的调用。

Answer 5

我最终使用@ ikegami的建议，但我对@ Axeman的方法很感兴趣。这是一个简化版本。

# 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::');

如何在perl程序中查找开放的全局文件句柄

5 个答案: