Tools/scripts/chkversion.pl: Fix and modernize
chkversion.pl was broken in a number of ways, including looking for CVS-style Id lines in svn headers, not being updated for pkgng, etc. This commit fixes those, and adopts some modern Perl practices. NOTE: The $PKG_VERSION env var is renamed to $PKG. This should be a no-op for most people (in the sense of it didn't work before, and the default should work for pretty much everybody).
This commit is contained in:
Adam Weinberger
parent
9705bce596
commit
ec6ad647fa
Notes:
svn2git
2021-03-31 03:12:20 +00:00
svn path=/head/; revision=562715
|
|
@ -28,7 +28,7 @@
|
|||
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
|
||||
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
#
|
||||
# $FreeBSD$
|
||||
# $FreeBSD: head/Tools/scripts/chkversion.pl 562503 2021-01-24 18:42:29Z adamw $
|
||||
#
|
||||
# MAINTAINER= portmgr@FreeBSD.org
|
||||
#
|
||||
|
|
@ -64,20 +64,25 @@
|
|||
# out by SVN, every entry is listed with a record of the last SVN commit.
|
||||
#
|
||||
|
||||
require 5.005;
|
||||
use v5.20;
|
||||
use strict;
|
||||
use warnings;
|
||||
use POSIX;
|
||||
use File::Find;
|
||||
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
use Cwd 'abs_path';
|
||||
use File::Find;
|
||||
use List::Util qw(first);
|
||||
use POSIX;
|
||||
|
||||
my $portsdir = $ENV{PORTSDIR} // '/usr/ports';
|
||||
my $versiondir = $ENV{VERSIONDIR} // '/var/db/chkversion';
|
||||
my $svnblame = exists $ENV{SVNBLAME};
|
||||
my $allports = exists $ENV{ALLPORTS};
|
||||
|
||||
my $watchre = $ENV{WATCH_REGEX} // '';
|
||||
my $watchmre = $ENV{WATCHM_REGEX} // '';
|
||||
my $watch_re = $ENV{WATCH_REGEX} // '';
|
||||
my $watchm_re = $ENV{WATCHM_REGEX} // '';
|
||||
my $returnpath = $ENV{RETURNPATH} // '';
|
||||
my $h_from = $ENV{HEADER_FROM} // $ENV{USER} . '@' . ($ENV{HOST} // `/bin/hostname`);
|
||||
my $h_replyto = $ENV{HEADER_REPLYTO} // $h_from;
|
||||
|
|
@ -90,14 +95,11 @@ my $cc_mntnr = exists $ENV{CC_MAINTAINER};
|
|||
|
||||
my $make = '/usr/bin/make';
|
||||
my $svn = '/usr/local/bin/svn';
|
||||
my $pkg_version =
|
||||
$ENV{PKG_VERSION} && -x $ENV{PKG_VERSION} ? $ENV{PKG_VERSION}
|
||||
: -x '/usr/local/sbin/pkg_version' ? '/usr/local/sbin/pkg_version'
|
||||
: '/usr/sbin/pkg_version';
|
||||
my $sendmail = '/usr/sbin/sendmail';
|
||||
my $pkg = first { -x $_ } ($ENV{PKG} // '', '/usr/local/sbin/pkg', '/usr/sbin/pkg');
|
||||
|
||||
my $watch_re = join '|', split ' ', $watchre;
|
||||
my $watchm_re = join '|', split ' ', $watchmre;
|
||||
$watch_re =~ s/ /|/g;
|
||||
$watchm_re =~ s/ /|/g;
|
||||
|
||||
-d $portsdir or die "Can't find ports tree at $portsdir.\n";
|
||||
$portsdir = abs_path($portsdir);
|
||||
|
|
@ -105,19 +107,19 @@ $portsdir = abs_path($portsdir);
|
|||
my $versionfile = "$versiondir/VERSIONS";
|
||||
my $useindex = !-w $versiondir;
|
||||
|
||||
my $starttime = strftime("%a %b %e %G %k:%M:%S %Z",localtime);
|
||||
my $starttime = strftime "%a %b %e %G %k:%M:%S %Z", localtime;
|
||||
|
||||
sub readfrom {
|
||||
my $dir = shift;
|
||||
|
||||
if (!open CHILD, '-|') {
|
||||
open STDERR, '>/dev/null';
|
||||
# @output_lines = readfrom(dir, cmd, arg1, arg2, ...)
|
||||
sub readfrom($dir, @cmd) {
|
||||
my $CHILD;
|
||||
if (!open $CHILD, '-|') {
|
||||
open STDERR, '>', '/dev/null';
|
||||
chdir $dir if $dir;
|
||||
exec @_;
|
||||
exec @cmd;
|
||||
die;
|
||||
}
|
||||
my @childout = <CHILD>;
|
||||
close CHILD;
|
||||
my @childout = <$CHILD>;
|
||||
close $CHILD;
|
||||
|
||||
map chomp, @childout;
|
||||
|
||||
|
|
@ -125,22 +127,23 @@ sub readfrom {
|
|||
}
|
||||
|
||||
foreach (qw(ARCH OPSYS OSREL OSVERSION UID)) {
|
||||
my @cachedenv = readfrom $portsdir, $make, "-V$_";
|
||||
my @cachedenv = readfrom($portsdir, $make, "-V$_");
|
||||
$ENV{$_} = $cachedenv[0];
|
||||
}
|
||||
|
||||
# These map a 2-dir path (editors/vim) to variables set in
|
||||
# that port's Makefile
|
||||
my %pkgname;
|
||||
my %pkgorigin;
|
||||
my %masterdir;
|
||||
my %pkgmntnr;
|
||||
|
||||
sub wanted {
|
||||
return
|
||||
if !-d;
|
||||
sub wanted() {
|
||||
return unless -d;
|
||||
|
||||
# Skip directories we shouldn't descend into
|
||||
if (/^.svn$/
|
||||
|| $File::Find::name =~
|
||||
m"^$portsdir/(?:Mk|Templates|Tools|distfiles|packages)$"os
|
||||
|| $File::Find::name =~ m"^$portsdir/(?:Mk|Templates|Tools|distfiles|packages)$"os
|
||||
|| $File::Find::name =~ m"^$portsdir/[^/]+/pkg$"os)
|
||||
{
|
||||
$File::Find::prune = 1;
|
||||
|
|
@ -148,14 +151,15 @@ sub wanted {
|
|||
elsif ($File::Find::name =~ m"^$portsdir/([^/]+/[^/]+)$"os) {
|
||||
$File::Find::prune = 1;
|
||||
if (-f "$File::Find::name/Makefile") {
|
||||
my @makevar = readfrom $File::Find::name,
|
||||
$make, '-VPKGORIGIN', '-VPKGNAME', '-VMAINTAINER', '-VMASTERDIR';
|
||||
my @makevar = readfrom $File::Find::name, $make, qw(-VPKGORIGIN -VPKGNAME -VMAINTAINER -VMASTERDIR);
|
||||
|
||||
# $1 is the current 2-dir path
|
||||
if ($#makevar == 3 && $makevar[1]) {
|
||||
$pkgorigin{$1} = $makevar[0]
|
||||
if $1 ne $makevar[0];
|
||||
$pkgname{$1} = $makevar[1];
|
||||
$pkgmntnr{$1} = $makevar[2];
|
||||
# %pkgorigin is the list of dirs that gets monitored. Only monitor a
|
||||
# path if it matches the PKGORIGIN.
|
||||
$pkgorigin{$1} = $makevar[0] if $1 ne $makevar[0];
|
||||
$pkgname{$1} = $makevar[1];
|
||||
$pkgmntnr{$1} = $makevar[2];
|
||||
$masterdir{$1} = $makevar[3];
|
||||
}
|
||||
}
|
||||
|
|
@ -166,23 +170,20 @@ if ($allports) {
|
|||
find(\&wanted, $portsdir);
|
||||
}
|
||||
else {
|
||||
my @categories = split ' ', readfrom $portsdir, $make, '-VSUBDIR';
|
||||
my @categories = split ' ' => readfrom($portsdir, $make, '-VSUBDIR');
|
||||
|
||||
foreach my $category (@categories) {
|
||||
-f "$portsdir/$category/Makefile" || next;
|
||||
my @ports = split ' ',
|
||||
readfrom "$portsdir/$category", $make, '-VSUBDIR';
|
||||
next unless -f "$portsdir/$category/Makefile";
|
||||
my @ports = split ' ' => readfrom("$portsdir/$category", $make, '-VSUBDIR');
|
||||
foreach (map "$category/$_", @ports) {
|
||||
-f "$portsdir/$_/Makefile" || next;
|
||||
next unless -f "$portsdir/$_/Makefile";
|
||||
|
||||
my @makevar = readfrom "$portsdir/$_",
|
||||
$make, '-VPKGORIGIN', '-VPKGNAME', '-VMAINTAINER', '-VMASTERDIR';
|
||||
my @makevar = readfrom "$portsdir/$_", $make, qw(-VPKGORIGIN -VPKGNAME -VMAINTAINER -VMASTERDIR);
|
||||
|
||||
next if $#makevar != 3 || ! $makevar[1];
|
||||
$pkgorigin{$_} = $makevar[0]
|
||||
if $_ ne $makevar[0];
|
||||
$pkgname{$_} = $makevar[1];
|
||||
$pkgmntnr{$_} = $makevar[2];
|
||||
$pkgorigin{$_} = $makevar[0] if $_ ne $makevar[0];
|
||||
$pkgname{$_} = $makevar[1];
|
||||
$pkgmntnr{$_} = $makevar[2];
|
||||
$masterdir{$_} = $makevar[3];
|
||||
}
|
||||
}
|
||||
|
|
@ -197,14 +198,18 @@ if ($useindex) {
|
|||
$versionfile = "$portsdir/$indexname";
|
||||
}
|
||||
|
||||
open VERSIONS, "<$versionfile";
|
||||
|
||||
while (<VERSIONS>) {
|
||||
# Read in the old (expected) values
|
||||
open my $VERSIONS, '<', $versionfile;
|
||||
while (<$VERSIONS>) {
|
||||
chomp;
|
||||
next if /^(#|$)/;
|
||||
|
||||
# These are the old (expected) values
|
||||
my ($origin, $version, $maintainer);
|
||||
|
||||
if ($useindex) {
|
||||
($origin, $version, $maintainer) = (split /\|/)[1,0,5];
|
||||
($origin, $version, $maintainer) = (split '|')[1,0,5];
|
||||
# Only keep the 2-dir path (editors/vim)
|
||||
$origin =~ s,^.*/([^/]+/[^/]+)/?$,$1,;
|
||||
}
|
||||
else {
|
||||
|
|
@ -217,9 +222,9 @@ while (<VERSIONS>) {
|
|||
$newversion =~ s/^.*-//;
|
||||
$oldversion =~ s/^.*-//;
|
||||
|
||||
my $result = $newversion eq $oldversion ? '=' : readfrom '',
|
||||
$pkg_version, '-t', $newversion, $oldversion;
|
||||
$result //= '';
|
||||
# If the two values differ, use `pkg version` to find which one is bigger
|
||||
my $result = $newversion eq $oldversion ? '='
|
||||
: readfrom '', $pkg, 'version', '-t', $newversion, $oldversion;
|
||||
|
||||
$watched{$origin} = "$version -> $pkgname{$origin}"
|
||||
if ($watch_re && $result ne '=' && $origin =~ /^(?:$watch_re)$/o);
|
||||
|
|
@ -238,44 +243,40 @@ while (<VERSIONS>) {
|
|||
$pkgmntnr{$origin} = $maintainer;
|
||||
}
|
||||
}
|
||||
close VERSIONS;
|
||||
close $VERSIONS;
|
||||
|
||||
if (!$useindex) {
|
||||
system 'mv', '-f', $versionfile, "$versionfile.bak";
|
||||
rename $versionfile, "$versionfile.bak";
|
||||
|
||||
open VERSIONS, ">$versionfile";
|
||||
open my $VERSIONS, '>', $versionfile;
|
||||
foreach (sort keys %pkgname) {
|
||||
print VERSIONS "$_\t$pkgname{$_}\t$pkgmntnr{$_}\n";
|
||||
print $VERSIONS "$_\t$pkgname{$_}\t$pkgmntnr{$_}\n";
|
||||
}
|
||||
close VERSIONS;
|
||||
close $VERSIONS;
|
||||
}
|
||||
|
||||
my %revision;
|
||||
|
||||
sub parsemakefile {
|
||||
my ($portdir) = @_;
|
||||
my ($r, $d, $a);
|
||||
|
||||
open MAKEFILE, "<$portdir/Makefile";
|
||||
while (<MAKEFILE>) {
|
||||
if (m'\$FreeBSD\: [^\$ ]+,v (\d+(?:\.\d+)+) (\d{4}(?:[/-]\d{2}){2} \d{2}(?::\d{2}){2}) (\w+) [\w ]+\$') {
|
||||
($r, $d, $a) = ($1, $2, $3);
|
||||
# Parses the $FreeBSD$ line to return revision, date, author
|
||||
sub parsemakefile($portdir) {
|
||||
open my $MAKEFILE, '<', "$portdir/Makefile";
|
||||
while (<$MAKEFILE>) {
|
||||
if (m/^# \$FreeBSD: [^ ]+ (?<rev>\d{6}) (?<date>\d{4}-\d\d-\d\d) [\d:]+Z (?<author>\w+) \$$/) {
|
||||
close $MAKEFILE;
|
||||
return ($+{rev}, $+{date}, $+{author});
|
||||
}
|
||||
}
|
||||
close MAKEFILE;
|
||||
|
||||
return ($r, $d, $a);
|
||||
close $MAKEFILE;
|
||||
}
|
||||
|
||||
sub getauthors {
|
||||
my ($ports) = @_;
|
||||
|
||||
sub getauthors($ports) {
|
||||
my %author;
|
||||
foreach my $origin (keys %{$ports}) {
|
||||
if (!$revision{$origin}) {
|
||||
my ($r, $d, $a) = parsemakefile "$portsdir/$origin";
|
||||
push @{$revision{$origin}}, $r;
|
||||
push @{$author{$origin}}, $a;
|
||||
|
||||
if ($masterdir{$origin} ne "$portsdir/$origin") {
|
||||
($r, $d, $a) = parsemakefile $masterdir{$origin};
|
||||
push @{$revision{$origin}}, $r;
|
||||
|
|
@ -288,31 +289,27 @@ sub getauthors {
|
|||
return %author;
|
||||
}
|
||||
|
||||
sub printlog {
|
||||
my ($fh, $portdir, $r) = @_;
|
||||
|
||||
# Gets the Makefile log starting from the last known rev for a port
|
||||
sub printlog($fh, $portdir, $rev) {
|
||||
if ($svnblame && -d "$portsdir/.svn") {
|
||||
my @svnlog = readfrom $portdir,
|
||||
$svn, 'log', '-r' . ($r ? $r : '.'), 'Makefile';
|
||||
my @svnlog = readfrom $portdir, $svn, 'log', ($rev ? "-r$rev" : ''), 'Makefile';
|
||||
foreach (@svnlog) {
|
||||
my $in_log = /^-{28}$/ ... /^(-{28}|={77})$/;
|
||||
my $in_log = /^-{20,}$/ ... /^(-{20,}|={70,})$/;
|
||||
print $fh " | $_\n"
|
||||
if ($in_log && $in_log != 1 && $in_log !~ /E0$/);
|
||||
if ($in_log && $in_log ne 1 && $in_log !~ /E0$/);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub blame {
|
||||
my ($fh, $ports) = @_;
|
||||
|
||||
sub blame($fh, $ports) {
|
||||
if (%{$ports}) {
|
||||
foreach my $origin (sort keys %{$ports}) {
|
||||
print $fh "- *$origin* <$pkgmntnr{$origin}>: $ports->{$origin}\n";
|
||||
printlog $fh, "$portsdir/$origin", $revision{$origin}[0];
|
||||
if ($masterdir{$origin} ne "$portsdir/$origin") {
|
||||
my $master = $masterdir{$origin};
|
||||
$master =~ s/^$portsdir\///o;
|
||||
while ($master =~ s/(^|\/)[^\/]+\/\.\.(?:\/|$)/$1/) {}
|
||||
$master =~ s|^$portsdir/||o;
|
||||
while ($master =~ s!(^|/)[^/]+/\.\.(?:/|$)!$1!) {}
|
||||
print $fh " (master: $master)\n";
|
||||
printlog $fh, $masterdir{$origin}, $revision{$origin}[1];
|
||||
}
|
||||
|
|
@ -322,10 +319,8 @@ sub blame {
|
|||
}
|
||||
}
|
||||
|
||||
sub template {
|
||||
my ($from, $rcpt, $replyto, $starttime, $ports) = @_;
|
||||
|
||||
my $portlist = join ', ', sort keys %{$ports};
|
||||
sub template($from, $rcpt, $replyto, $starttime, $ports) {
|
||||
my $portlist = join ', ' => sort keys %{$ports};
|
||||
substr($portlist, 32) = '...'
|
||||
if length $portlist > 35;
|
||||
|
||||
|
|
@ -344,34 +339,34 @@ sub template {
|
|||
if $_;
|
||||
}
|
||||
}
|
||||
my $cc = join ', ', sort keys %cclist;
|
||||
my $cc = join ', ' => sort keys %cclist;
|
||||
|
||||
my $header = '';
|
||||
while (<main::DATA>) {
|
||||
last if /^\.\n?$/;
|
||||
$_ =~ s/%%FROM%%/$from/og;
|
||||
$_ =~ s/%%RCPT%%/$rcpt/og;
|
||||
$_ =~ s/%%CC%%/$cc/og;
|
||||
$_ =~ s/%%REPLYTO%%/$replyto/og;
|
||||
$_ =~ s/%%SUBJECT%%/$portlist/og;
|
||||
$_ =~ s/%%STARTTIME%%/$starttime/og;
|
||||
$header .= $_;
|
||||
$header .= $_
|
||||
=~ s/%%FROM%%/$from/ogr
|
||||
=~ s/%%RCPT%%/$rcpt/ogr
|
||||
=~ s/%%CC%%/$cc/ogr
|
||||
=~ s/%%REPLYTO%%/$replyto/ogr
|
||||
=~ s/%%SUBJECT%%/$portlist/ogr
|
||||
=~ s/%%STARTTIME%%/$starttime/ogr;
|
||||
}
|
||||
return $header;
|
||||
}
|
||||
|
||||
sub mail {
|
||||
my ($template, $rcpt, $ports) = @_;
|
||||
|
||||
sub mail($template, $rcpt, $ports) {
|
||||
if (%{$ports}) {
|
||||
# If the RCPT_* variables are empty, just print the mail to STDOUT
|
||||
if ($rcpt) {
|
||||
if (!open MAIL, '|-') {
|
||||
exec $sendmail, '-oi', '-t', '-f', $returnpath;
|
||||
my $MAIL;
|
||||
if (!open $MAIL, '|-') {
|
||||
exec $sendmail, qw(-oi -t -f), $returnpath;
|
||||
die;
|
||||
}
|
||||
print MAIL $template;
|
||||
blame *MAIL, $ports;
|
||||
close MAIL;
|
||||
print $MAIL $template;
|
||||
blame $MAIL, $ports;
|
||||
close $MAIL;
|
||||
} else {
|
||||
$template =~ s/^.*?\n\n//os;
|
||||
print $template;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user