Jak znaleźć otwarte globalne uchwyty plików w programie perla

Question

Właśnie odkryłem problem, w którym musiałem zamknąć wszystkie otwarte uchwyty plików dla mojego skryptu Apache cgi, aby kontynuować. Prześledziłem problem w 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; 
} 

Moje pytanie brzmi: jak znaleźć wszystkie otwarte uchwyty plików?

Wiem, że fileno zwróci licznik otwartej uchwytu pliku. Czy istnieje sposób, aby wykonać do nich odwrócone wyszukiwanie lub zamknąć uchwyty plików za pomocą ich licznika fileno?

Answer 1

W niektórych systemach katalog zwracany przez "/proc/$$/fd/" zawiera listę otwartych deskryptorów plików. Możesz użyć POSIX::close, aby je zamknąć.

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

Answer 2

można zejść przez drzewo pakiet:

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 3

A co globalnie nadrzędnymi open z wersji, która przechowuje listę wszystkich uchwytów to tworzy? Coś takiego może być początek:

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 

ten powinien złapać wszystkich światowych uchwyty, a nawet jakieś uchwyty, które dostałem leksykalne stworzone, ale nigdy nie były czyszczone w górę (ze względu na okrągłych referencji lub innych powodów).

Jeśli umieścisz to pomijanie (blok BEGIN) przed wywołaniem use Parse::RecDescent, spowoduje to zastąpienie wywołań do open, które wykonuje moduł.

Answer 4

Skończyło się na tym, że korzystałem z sugestii @ ikegami, ale byłem zainteresowany metodą @ Axemana. Oto uproszczona wersja.

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

Answer 5

Podczas tropienia bliskie-on-exec szczegóły ciekawości Ikegami jest, myślę, że okazało się, że wszystko, co musisz zrobić, to blisko STDIN, STDOUT i STDERR siebie, jeśli jesteś po prostu wykonując inny proces:

$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(). 

Oczywiście, jeśli twoje długotrwałe zadanie nie wymaga wywołania execve(2), flaga zbliżania się do końca nie pomoże ci wcale. Wszystko zależy od tego, na co sleep 5 jest stand-in.