sbolint: check package names against core Slackware package names.

1 files changed, 135 insertions, 1 deletions

diff --git a/sbolint b/sbolint
index 0f40127..0f2c5e5 100755
--- a/sbolint
+++ b/sbolint
@@ -11,7 +11,7 @@ sbolint - check SlackBuild directories or tarballs for common errors.
 
 =head1 SYNOPSIS
 
-B<sbolint> [--help | --man | --version ] | [-a] [-q] [-u] [-e] [-n] [-r] [-c] [-m] [build [build ...]]
+B<sbolint> [--help | --man | --version ] | [-a] [-q] [-u] [-e] [-n] [-r] [-c] [-m] [-U] [build [build ...]]
 
 =head1 DESCRIPTION
 
@@ -102,6 +102,12 @@ auto-detect.
 
 Don't use color, even if standard output is a terminal.
 
+=item B<-U>, B<--update-package-list>
+
+Update the list of Slackware packages. Requires network access. The package list
+normally lives in B<PREFIX>/share/sbo-maintainer-tools/pkglist.txt (where
+B<PREFIX> is set when you run B<make install>, and defaults to I</usr/local/>).
+
 =item B<--version>
 
 Show version number and exit.
@@ -362,6 +368,7 @@ B<sbopkglint>(1), B<sbodl>, B<sbofixinfo>(1), B<sbopkg>(8), B<sboinstall>(1)
 # These perl modules ship with Slackware's perl package.
 use POSIX qw/getcwd/;
 use Getopt::Long qw/:config gnu_getopt no_require_order/;
+use Cwd qw/abs_path/;
 
 @boilerplate = (
 	qr/#\s*REMOVE THIS ENTIRE BLOCK OF TEXT/,
@@ -419,6 +426,7 @@ GetOptions(
 		"man" => sub { exec("pod2man --stderr -s1 -csbo-maintainer-tools -r$VERSION $0"); },
 		"color|colour|c" => sub { $color_output = 1; },
 		"mono|no-color|no-colour|m" => sub { $color_output = 0; },
+		"U|update-package-list" => sub { exit &update_package_list; },
 ) or die_usage("Error in command line options");
 
 $color_output = -t STDOUT unless defined $color_output;
@@ -772,6 +780,7 @@ sub run_checks {
 
 	if(script_exists()) {
 		my @checks = (
+				\&check_package_list,
 				\&check_readme,
 				\&check_slackdesc,
 				\&check_info,
@@ -2078,3 +2087,128 @@ sub check_images {
 		im_check_img($_);
 	}
 }
+
+# 20260816 bkw: all these *_package_list() functions are here to
+# support the "$prgnam is a core Slackware package" check. The
+# package list (pkglist.txt) can be in the script directory or
+# share/ under the PREFIX.
+sub find_package_list {
+	(my $cur) = (abs_path($0) =~ m,^(.*)/,);
+	my @check = ( $cur, '@PREFIX@/share/sbo-maintainer-tools' );
+
+	for(@check) {
+		my $path = "$_/pkglist.txt";
+		return $path if -e $path;
+	}
+
+	return undef;
+}
+
+# only gets called once per run (even when linting multiple builds)
+sub load_package_list {
+	my $file = find_package_list();
+	if(not defined $file) {
+		warn "$SELF: no pkglist.txt, not checking package name (try -U)\n";
+		return;
+	}
+
+	## warn "loading packages from $file\n";
+	open my $fh, "<", $file or die "$SELF: $file: $!";
+	while(<$fh>) {
+		chomp;
+		$pkglist{$_}++;
+	}
+	close $fh;
+
+	## warn "pkglist.txt loaded, " . (keys %pkglist) . " packages\n";
+}
+
+sub check_package_list {
+	if(!$pkglist_tried) {
+		load_package_list;
+		$pkglist_tried++;
+	}
+
+	return unless %pkglist;
+
+	if($pkglist{$buildname}) {
+		log_error("$buildname is a core Slackware package!");
+	}
+}
+
+# 20260816 bkw: find the right PACKAGES.TXT for this Slackware release.
+# PACKAGES_TXT will override the URL, in case someone's doing something nonstandard.
+sub get_package_list_url {
+	my $url = $ENV{PACKAGES_TXT};
+	return $url if $url;
+
+	my $bits = "";
+	my $stable = 0;
+	my $slackver;
+	my $is_slackware = 0;
+	my $arch;
+
+	# 20260816 bkw: I got a question. Why the hell doesn't /etc/os-release define
+	# an ARCH= key? I have to look at the "pretty name" to get the arch...
+	open my $f, "</etc/os-release" or die "$SELF: /etc/os-release: $!\n";
+	while(<$f>) {
+		chomp;
+		$is_slackware++  if /^NAME=Slackware$/;
+		$arch     =   $1 if /^PRETTY_NAME.*\s+(\S+)"/;
+		$stable   =    1 if /^VERSION_CODENAME=stable/;
+		$slackver =   $1 if /^VERSION_ID=(.*)$/;
+	}
+	close $f;
+
+	if($arch eq 'x86_64') {
+		$bits = 64;
+	} elsif($arch =~ /^i\d86/) {
+		$bits = "";
+	} else {
+		die "$SELF: -U only works for i?86 or x86_64, not '$arch'\n";
+	}
+
+	die "$SELF: can't update package list for non-Slackware OS\n" unless $is_slackware;
+	die "$SELF: can't update package list for -current\n" unless $stable;
+	die "$SELF: can't tell what version of Slackware this is\n" unless defined $slackver;
+
+	$url = "https://slackware.uk/slackware/slackware$bits-$slackver/PACKAGES.TXT";
+	return $url;
+}
+
+# 20260816 bkw: note: don't use die() here, use warn() followed by exit(1).
+sub update_package_list {
+	my $url = get_package_list_url();
+	my $file = find_package_list();
+
+	if(not defined $file) {
+		warn "$SELF: can't find pkglist.txt, create it manually (with touch)\n";
+		exit 1;
+	}
+
+	warn "$SELF: updating $file from $url\n";
+
+	my $count = 0;
+	open my $pl, ">", $file or die "$SELF: $file: $!\n";
+	open my $curl, "-|", "curl", "-sS", $url or do {
+	  	warn "$SELF: curl: $!\n";
+		exit 1;
+	};
+	while(<$curl>) {
+		chomp;
+		next unless /^PACKAGE DESCRIPTION/;
+		my $p = <$curl>;
+		$p =~ s/:.*//;
+		print $pl $p;
+		$count++;
+	}
+	close $curl;
+	close $pl;
+
+	warn "$SELF: $count package names written to $file\n";
+	if($count < 1000) {
+		warn "$SELF: $count doesn't seem like enough packages for a Slackware release, does it?\n";
+		exit 1;
+	}
+	exit 0;
+}