scripts/find-runtime-roots.pl.in


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

#! @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;