bin/portage-scan


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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

#!/usr/bin/env perl 
use strict;
use warnings;
use 5.020;
use experimental 'smartmatch';
use autodie;
use Try::Tiny;
use File::Find;
use File::stat;
use Digest::MD5;
 
sub load_portage_data {
    my %data;
    find(
        {
            wanted => sub {
                $_ eq 'CONTENTS' or return;
                open my $fh,'<',$File::Find::name;
                while (defined(my $line=<$fh>)) {
                    chomp $line;
                    if ($line =~ /^dir /) {
                        my ($path) = $line =~ m{\A dir [ ] (.+)\z}x;
                        $data{$path}={kind=>'dir'};
                    }
                    elsif ($line =~ /^obj /) {
                        my ($path,$md5,$mtime) = $line =~
                            m{\A obj [ ] (.+) [ ] ([0-9a-f]+) [ ] ([0-9]+)\z}x;
                        $data{$path} = {
                            kind => 'obj',
                            md5 => $md5,
                            mtime => $mtime,
                        };
                    }
                    elsif ($line =~ /^sym /) {
                        my ($path,$dest,$mtime) = $line =~
                            m{\A sym [ ] (.+) [ ]->[ ] (.+) [ ] ([0-9]+)\z}x;
                        $data{$path} = {
                            kind => 'sym',
                            dest => $dest,
                            mtime => $mtime,
                        };
                    }
                    else {
                        warn "WTF? <$line> in $File::Find::name\n";
                    }
                }
            },
        },
        '/var/db/pkg',
    );
    return \%data;
}
 
sub match_file {
    my ($fn,$data) = @_;
 
    my $file_info = $data->{$fn} || $data->{ $fn =~ s{^/lib64/}{/lib/}r };
    my $fs = lstat($fn);
    my $kind = -l $fs ? 'sym' : -d $fs ? 'dir' : 'obj';
 
    my %ret = (
        kind => $kind,
        dev => $fs->dev,
        errs => [],
    );
    my $errs = $ret{errs};
 
    if (!$file_info) {
        push @$errs, 'O';
        return \%ret;
    }
 
    if ($kind ne $file_info->{kind}) {
        push @$errs, 'K';
        return \%ret;
    }
    return \%ret if $kind eq 'dir'; # nothing else to check 
 
    my $mtime = $fs->mtime;
    if ($mtime != $file_info->{mtime}) {
        push @$errs, 'T';
    }
    if ($kind eq 'sym') {
        my $dest = readlink($fn);
        if ($dest ne $file_info->{dest}) {
            push @$errs, 'L';
        }
    }
    else {
        my $d = Digest::MD5->new;
        try {
            open my $fh,'<:raw',$fn;
            $d->addfile($fh);
            my $md5 = $d->hexdigest;
            if ($md5 ne $file_info->{md5}) {
                push @$errs, '5';
            }
        }
        catch { push @$errs, '*' };
    }
    return \%ret;
}
 
my $prune_rx = qr{\A / (?:home/|ssd/|vm-disk/|net/|dev/|sys/|proc/|run/|tmp/|var/(?:db/pkg/|cache/|spool/|run/|log/)|usr/(?:src/linux/|portage/)) }x;
 
my $data = load_portage_data;
warn "loaded\n";
 
my $root_stat = stat('/');
my $root_dev = $root_stat->dev;
my %symbol_for_kind=(
    dir => '/',
    sym => '@',
    obj => '',
);
find(
    {
        no_chdir => 1,
        wanted => sub {
            if (/$prune_rx/) {
                $File::Find::prune=1;
                return;
            }
            my $match = match_file($_,$data);
            if (@{$match->{errs}}) {
                say $_, $symbol_for_kind{$match->{kind}},
                    ' ',@{$match->{errs}};
            }
            if (
                ($_ ne '/'
                     and $match->{kind} eq 'dir'
                     and 'O' ~~ $match->{errs})
                    or
                    ($match->{dev} != $root_dev)
                ) {
                $File::Find::prune=1;
            }
        },
    },
    '/',
);