107 lines
3.0 KiB
Perl
Executable File
107 lines
3.0 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# $Id: prtcheckmissing,v 1.1 2003/10/27 15:26:50 opel Exp $
|
|
# prtcheckmissing,v 1.2 2022/05/31 18:41:19 jmq Exp $
|
|
# prtcheckmissing,v 1.3 2023/09/07 18:51:46 jmq Exp $
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
sub check_missing {
|
|
my @mask = parse_pkgadd_conf();
|
|
open (my $dbh, "/var/lib/pkg/db") or die "Could not read package database!\n";
|
|
local $/ = ""; # read files paragraph-wise; see ``perldoc perlvar''
|
|
|
|
while(<$dbh>) {
|
|
my ($name, $version, @files) = split /\n/;
|
|
|
|
# apply the pkgadd rules to eliminate false positives
|
|
my @missing = grep { (! -e "/$_") && wanted($_, @mask) } @files;
|
|
|
|
# final report for this package
|
|
next if not @missing;
|
|
print map "/$_ $name\n", @missing;
|
|
}
|
|
close($dbh);
|
|
}
|
|
|
|
sub parse_pkgadd_conf {
|
|
my @unwanted;
|
|
local $/ = "\n";
|
|
open my $pah, "< /etc/pkgadd.conf"
|
|
or die "Couldn't open pkgadd install rules!\n";
|
|
|
|
while(<$pah>) {
|
|
next if /^\s*#/ or /^$/;
|
|
my ($event, $pattern, $choice) = split;
|
|
push (@unwanted, qr/$pattern/s) if ($event eq "INSTALL" and $choice eq "NO");
|
|
}
|
|
close ($pah);
|
|
|
|
return @unwanted;
|
|
}
|
|
|
|
sub wanted {
|
|
my $testfile = shift;
|
|
my $retval = 1;
|
|
while (my $regexp=shift) {
|
|
$retval = 0 if $testfile =~ $regexp;
|
|
last if $retval==0;
|
|
}
|
|
return $retval;
|
|
}
|
|
|
|
sub check_perms {
|
|
my %wrongmode; # hash from suspicious file to the port(s) that claim to own it
|
|
|
|
foreach (split('\n', `prt-get printf "%i:%p:%n\n"`)) {
|
|
my ($isinst, $repo, $name) = split(':', $_, 3);
|
|
next if ($isinst eq "no");
|
|
open (my $fp,"$repo/$name/.footprint") or die "no footprint for $repo/$name";
|
|
while(<$fp>) {
|
|
my ($Emod,$Eown,$file) = split(/\t| -> /, $_, 3);
|
|
chomp($file); $file =~ s/\/$//;
|
|
next if (! -e "/$file"); # this case is handled by check_missing
|
|
|
|
# there's a file on disk, so inspect its owner and perms
|
|
my @stat = (-l "/$file") ? lstat("/$file") : stat("/$file");
|
|
my $Fown = getpwuid($stat[4]) . "/" . getgrgid($stat[5]);
|
|
my $Fmod = mode_to_string($stat[2]);
|
|
$wrongmode{$file} .= " $name" if (($Eown ne $Fown) or ($Emod ne $Fmod));
|
|
}
|
|
close($fp);
|
|
}
|
|
|
|
# final report
|
|
next if (not %wrongmode);
|
|
print map "/$_ $wrongmode{$_}\n", sort keys %wrongmode;
|
|
}
|
|
|
|
# inlined from Stat::lsMode in order to avoid an extra dependency
|
|
# (https://metacpan.org/pod/Stat::lsMode)
|
|
sub mode_to_string {
|
|
my ($mode) = @_;
|
|
my @perms = qw(--- --x -w- -wx r-- r-x rw- rwx);
|
|
my @ftype = qw(. p c ? d ? b ? - ? l ? s D ? ?);
|
|
$ftype[0] = '';
|
|
my @str_mode = @perms[($mode&0700)>>6, ($mode&0070)>>3, $mode&0007];
|
|
my $ftype = $ftype[($mode & 0170000)>>12];
|
|
|
|
my $setids = ($mode & 07000)>>9;
|
|
if ($setids) {
|
|
if ($setids & 01) { # Sticky bit
|
|
$str_mode[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e;
|
|
}
|
|
if ($setids & 02) { # Setgid bit
|
|
$str_mode[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
|
|
}
|
|
if ($setids & 04) { # Setuid bit
|
|
$str_mode[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
|
|
}
|
|
}
|
|
return join '', $ftype, @str_mode;
|
|
}
|
|
|
|
if ($0 =~ /perms$/) { check_perms;
|
|
} else { check_missing; }
|