ebcccbd358
such as open files, current directories, mmaped files, etc. This is inherently unportable, but it's easy to adapt this script to other platforms. Currently we call `lsof' and try to read various bits in /proc/NNN. The goal is to prevent the garbage collector from removing store paths that are no longer reachable from a permanent root but that are still in use (for instance, after the user has done "nix-env -e" on a running program).
59 lines
1.2 KiB
Perl
59 lines
1.2 KiB
Perl
#! @perl@ -w
|
|
|
|
use strict;
|
|
|
|
my $procDir = "/proc";
|
|
|
|
|
|
sub readProc {
|
|
return unless -d $procDir;
|
|
|
|
opendir DIR, $procDir or return;
|
|
|
|
foreach my $name (readdir DIR) {
|
|
next unless $name =~ /^\d+$/;
|
|
|
|
my $process = "$procDir/$name";
|
|
|
|
#print STDERR "=== $process\n";
|
|
|
|
my $target;
|
|
print "$target\n" if $target = readlink "$process/exe";
|
|
print "$target\n" if $target = readlink "$process/cwd";
|
|
|
|
if (opendir FDS, "$process/fd") {
|
|
foreach my $name (readdir FDS) {
|
|
$target = readlink "$process/fd/$name";
|
|
print "$target\n" if $target && substr($target, 0, 1) eq "/";
|
|
}
|
|
closedir FDS;
|
|
}
|
|
|
|
if (open MAP, "<$process/maps") {
|
|
while (<MAP>) {
|
|
next unless /^ \s* \S+ \s+ \S+ \s+ \S+ \s+ \S+ \s+ \S+ \s+ (\/\S+) \s* $/x;
|
|
print "$1\n";
|
|
}
|
|
close MAP;
|
|
}
|
|
}
|
|
|
|
closedir DIR;
|
|
}
|
|
|
|
|
|
sub lsof {
|
|
return unless open LSOF, "lsof -b -w -F n |";
|
|
|
|
while (<LSOF>) {
|
|
next unless /^n (\/ .*)$/x;
|
|
print $1, "\n";
|
|
}
|
|
|
|
close LSOF;
|
|
}
|
|
|
|
|
|
readProc;
|
|
lsof;
|