summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bin/portage-scan141
1 files changed, 141 insertions, 0 deletions
diff --git a/bin/portage-scan b/bin/portage-scan
new file mode 100644
index 0000000..f5a0d98
--- /dev/null
+++ b/bin/portage-scan
@@ -0,0 +1,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;
+ }
+ },
+ },
+ '/',
+);