4 files changed, 469 insertions, 0 deletions

diff --git a/ports-mgmt/portupdate-scan/Makefile b/ports-mgmt/portupdate-scan/Makefile
new file mode 100644
index 000000000000..3398a2454610
--- /dev/null
+++ b/ports-mgmt/portupdate-scan/Makefile
@@ -0,0 +1,30 @@
+# New ports collection makefile for:	portupdate-scan
+# Date created:				08 November 2007
+# Whom:					Alex Stangl <alex@stangl.us>
+#
+# $FreeBSD$
+#
+# This port is self contained in the files directory.
+
+PORTNAME=	portupdate-scan
+PORTVERSION=	0.1
+CATEGORIES=	ports-mgmt
+MASTER_SITES=	# none
+DISTFILES=	# none
+
+MAINTAINER=	alex@stangl.us
+COMMENT=	Display pertinent parts of {PORTSDIR}/UPDATING
+
+NO_BUILD=	yes
+USE_PERL5_RUN=	yes
+
+PLIST_FILES=	sbin/portupdate-scan
+SRC=		${.CURDIR}/src
+
+MAN8=		portupdate-scan.8
+
+do-install:
+	${INSTALL_SCRIPT} ${SRC}/portupdate-scan ${PREFIX}/sbin/portupdate-scan
+	${INSTALL_MAN} ${SRC}/portupdate-scan.8 ${MAN8PREFIX}/man/man8
+
+.include <bsd.port.mk>
diff --git a/ports-mgmt/portupdate-scan/pkg-descr b/ports-mgmt/portupdate-scan/pkg-descr
new file mode 100644
index 000000000000..cfcc65b820c0
--- /dev/null
+++ b/ports-mgmt/portupdate-scan/pkg-descr
@@ -0,0 +1,10 @@
+portupdate-scan simplifies dealing with /usr/ports/UPDATING when you have so
+many ports installed that it is difficult to know which sections are relevant.
+
+It reads /usr/ports/UPDATING, attempting for each block to determine whether
+the affected ports are installed. It omits blocks that do not apply.
+It handles wildcards and other special cases, however it cannot handle
+all variants of phrases used on the APPLIES: line.
+In uncertain cases, it errs on the side of reporting.
+
+Alex Stangl <alex@stangl.us>
diff --git a/ports-mgmt/portupdate-scan/src/portupdate-scan b/ports-mgmt/portupdate-scan/src/portupdate-scan
new file mode 100644
index 000000000000..bff797c883ec
--- /dev/null
+++ b/ports-mgmt/portupdate-scan/src/portupdate-scan
@@ -0,0 +1,352 @@
+#!/usr/bin/perl -w
+
+# Copyright (c) 2007 Alex Stangl <alex@stangl.us>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+# Check /usr/ports/UPDATING file for all sections matching packages
+# that are installed, and outputting those sections.
+# Intended to be used prior to upgrading ports
+# Usage: portupdatescan [-dDhmuvV] [--help] [--version]
+# Created:      2006/12/21	Alex Stangl
+# Last updated: 2007/11/09	Alex Stangl
+
+use Text::ParseWords;
+use Getopt::Std;
+use strict;
+
+# Display usage and exit
+sub HELP_MESSAGE() {
+	print <<EOF;
+Usage: portupdate-scan [-dhmuvV] [-D portsdir] [--help] [--version]
+  -d             display additional debugging info
+  -D portsdir    override default port directory
+  -h, --help     display this help and exit
+  -m             display detailed port install info for MIXED
+  -u             display information about uninstalled ports (Default off)
+  -v             display verbose information (e.g., more debugging info)
+  -V, --version  output version information and exit
+EOF
+	exit;
+}
+
+sub VERSION_MESSAGE() {
+	print "portupdate-scan 0.1\n";
+}
+
+# Fetch cmdline args, display usage if appropriate
+$Getopt::Std::STANDARD_HELP_VERSION=1;          # std, not paranoia behavior
+# our($opt_d, $opt_h, $opt_m, $opt_u, $opt_v, $opt_V);
+my %opt;            # map of command-line options
+HELP_MESSAGE() unless getopts("dD:hmuvV", \%opt);
+HELP_MESSAGE() if $opt{h};
+VERSION_MESSAGE() && exit if $opt{V};
+
+my $portsdir = $opt{D} || "/usr/ports";     # ports directory
+
+my $portIndexFile = "$portsdir/INDEX";      # port index file
+my $movedFile = "$portsdir/MOVED";          # file w/ port renames/deletes
+my $updatingFile = "$portsdir/UPDATING";    # file w/ ports update news
+
+my @portlist = `pkg_info -aoq`
+    or die "Error trying to execute pkg_info -aoq: $!";
+my %installedPorts =
+    map {chomp($_);$_, 1} @portlist;    # map of installed ports -> 1
+
+my %allPorts;       # map of all portnames -> its INDEX line
+my %fromTo;         # map of old -> new portname
+my %toFrom;         # map of new -> old portname
+my %deletedPorts;   # map of deleted ports
+my %substmap = (    # map of port name substitutions
+	'xorg' => 'x11/xorg',
+	'Xorg' => 'x11/xorg',
+	'automake' => 'devel/automake*',
+);
+my %glob2regexp = ( 		# map glob-style regexp chars to regular expr
+	'*' => '.*',
+	'?' => '.',
+);
+
+# Process a single block from /usr/ports/UPDATING
+sub processBlock(@) {
+	my ($affects, $remainder, $line);
+	my $index = 0;
+	foreach $line (@_) {
+		if ($line =~ /^\s*AFFECTS:/) {
+			$affects = $line;
+			$remainder = $index;
+		} elsif ($affects and $line =~ /^\s*AUTHOR/) {
+			last;
+		} elsif ($affects) {
+			$affects .= $line;
+		}
+		++$index;
+	}
+
+	return unless defined $remainder;
+	if (checkline($affects, $_[$remainder - 1])) {
+		print "$_[$remainder++]\n" while $remainder < @_;
+	}
+}
+
+# Given a port name, attempt to find and return an existing port of that
+# name, or a different name, taking into account /usr/ports/MOVED
+sub findPortByName($@) {
+	my $name = $_[0];
+	print "+ findPortByName $name\n" if $opt{d};
+	$_[1]{$name} = 1;
+	return $name if $allPorts{$name};
+	my $retval = checkaliases($name, $_[1], \%fromTo);
+	return $retval if defined $retval;
+	return checkaliases($name, $_[1], \%toFrom);
+}
+
+sub checkaliases($\@\@) {
+	my $name = $_[0];
+	my ($alias, $retval);
+	foreach $alias (@{$_[2]{$name}}) {
+		$retval = findPortByName($alias, $_[1]) if not exists $_[1]{$alias};
+		print "+ Checking alias $alias for $name\n" if $opt{d};
+		if (defined $retval and $retval ne "") {
+			print "+ returns $retval\n" if $opt{d};
+			return $retval;
+		}
+	}
+}
+
+
+# Recursively parse package name string, possibly containing
+# {a,b,c} or * metacharacters, requiring expansion
+sub parseexpr($);	# forward declaration needed because of recursion
+sub parseexpr($) {
+	my @retval;
+	my $sepExp = "(,\\s+and\\s+|,\\s+or\\s+|,\\s+|\\s+and\\s+|\\s+or\\s+|\\s+)";
+	if ($_[0] =~ /{.*,.*}/)
+	{
+		# Handle expression like textproc/{senna,p5-Senna}
+		# to produce textproc/senna, textproc/p5-Senna
+		my ($prefix, $subexpr, $suffix) = ($_[0] =~ /([^{]*){([^}]*)}(.*)/);
+
+		# Parse portname fragment contained within braces
+		# Breaks string at "," and discards quotes and single backslashes
+		my @exprs = &quotewords(",", 0, $subexpr);
+		my $line;
+		foreach $line (@exprs) {
+			push @retval, parseexpr($prefix . $line . $suffix);
+		}
+	} elsif ($_[0] =~ /\[\d{1,4}\]/) {
+		# Handle expressions like net/openldap2[34]-server
+		# to produce net/openldap23-server, net/openldap24-server
+		my ($prefix, $subexpr, $suffix) = ($_[0] =~ /([^[]*)\[([^\]]+)\](.*)/);
+
+		my $char;
+		foreach $char (split //, $subexpr) {
+			push @retval, parseexpr($prefix . $char . $suffix);
+		}
+	} elsif ($_[0] =~ /\[.+\]/) {
+		# Handle expressions like textproc/docproj[-jadetex]
+		# to produce textproc/docproj, textproc/docproj-jadetex
+		my ($prefix, $subexpr, $suffix) = ($_[0] =~ /([^[]*)\[([^\]]+)\](.*)/);
+		push @retval, parseexpr($prefix . $suffix);
+		push @retval, parseexpr($prefix . $subexpr . $suffix);
+	} elsif ($_[0] =~ /$sepExp/) {
+		# Handle "dir1/port1 and dir2/port2" recursively.
+		my ($prefix, $sep, $suffix) = ($_[0] =~ /(.*?)$sepExp(.*)/);
+		push @retval, parseexpr($prefix) if $prefix ne "";
+		push @retval, parseexpr($suffix) if $suffix ne "";
+	} elsif ($_[0] =~ /\*/ or $_[0] =~ /\?/) {
+		push @retval, expandwildcard($_[0]);
+	} else {
+		# Perform canned substitution, if appropriate, else use input string
+		my $subst = $substmap{$_[0]};
+		push @retval, $subst ? parseexpr($subst) : $_[0];
+	}
+	return @retval;
+}
+
+# Parse a single AFFECTS: line
+sub parseline($) {
+	return ("ALL") if $_[0] =~ /^\s+AFFECTS:\s*everybody\s*$/i
+	    or $_[0] =~ /^\s+AFFECTS:\s*everyone\s*$/i
+	    or $_[0] =~ /^\s+AFFECTS:\s*all\s*$/i;
+	if ($_[0] =~ s/.*([uU]sers|[tT]esters) of[ \t]*(.*)/$2/) {
+		my @retval = parseexpr($_[0]);
+		print "+ parseline returns @retval for $_[0]\n" if $opt{d};
+		return @retval;
+	}
+}
+
+# For arg "PREFIX*SUFFIX", expand by returning all portnames
+# beginning with "PREFIX" and ending with "SUFFIX".
+# If no matching current portnames found, deleted portnames are checked.
+# If no current or deleted portnames match, the expression itself is returned.
+sub expandwildcard($) {
+	my (@retval, $key);
+	my $globpattern = $_[0];
+	$globpattern = "*/$globpattern" if $globpattern !~ /.+\/.+/;
+	my $pattern = glob2pat($globpattern);
+
+	foreach $key (keys %allPorts) {
+		push @retval, $key if $key =~ /$pattern/;
+	}
+	return @retval if @retval;
+
+	# No current ports matched, so try checking for matching deleted ports
+	foreach $key (keys %deletedPorts) {
+		push @retval, $key if $key =~ /$pattern/;
+	}
+	push @retval, $_[0] if @retval == 0;	# push expr if no expansion
+	return @retval;
+}
+
+# Convert glob-style pattern to standard regular-expression pattern
+sub glob2pat($) {
+	(my $globstr = $_[0]) =~ s/(.)/$glob2regexp{$1} || "\Q$1"/ge;
+	return '^' . $globstr . '$';
+}
+
+# Possibilities when evaluating a line:
+# 0. Not able to make sense of line (find any known port names)
+# 1. Able to find 1 or more port names, each either
+# 1a. Is installed
+# 1b. Is unknown
+# 1c. Is known, but not installed
+#
+# Conservatively, output line unless all apparent port names on
+# line are known and are not installed.
+sub checkline($$) {
+	# Copy args for readability and because we will mutate localCopy
+	my ($localCopy, $prevLine) = @_;
+	my @ret = parseline($localCopy);
+	if ($#ret == -1) {
+		print "(NOT RECOGNIZED!) $_[1]\n";
+		return 1;
+	}
+
+	# boolean accumulator flags tracking whether all known, all deleted, etc.
+	my ($allKnown, $allUnknown, $allInstalled, $allNotInstalled, $allDeleted) = (1,1,1,1,1);
+
+	my ($line, @details);
+	foreach $line (@ret) {
+		if ($line eq "ALL") {
+			$allUnknown = $allDeleted = 0;
+			last;
+		}
+		my $alias = findPortByName($line, \());
+		if ($alias) {
+			$allUnknown = $allDeleted = 0;
+			if ($installedPorts{$alias}) {
+				$allDeleted = $allNotInstalled = 0;
+				push @details, logPortFinding("installed", $line, $alias);
+			} else {
+				$allDeleted = $allInstalled = 0;
+				push @details, logPortFinding("NOT installed", $line, $alias);
+			}
+		} elsif ($deletedPorts{$line}) {
+			push @details, logPortFinding("Deleted", $line, $alias);
+			$allUnknown = 0;
+		} else {
+			$allKnown = $allDeleted = 0;
+			push @details, logPortFinding("UNKNOWN", $line, $alias);
+		}
+	}
+
+	if ($allDeleted) {
+		printall(\@details) if $opt{v};
+		return 0 unless $opt{u};
+		print "(ALL Deleted) $_[1]\n";
+		return 1;
+	} elsif ($allUnknown) {
+		printall(\@details) if $opt{v};
+		print "(ALL Unknown) $_[1]\n";
+		return 1;
+	} elsif ($allKnown && $allInstalled) {
+		printall(\@details) if $opt{v};
+		print "(ALL Installed) $_[1]\n";
+		return 1;
+	} elsif ($allKnown && $allNotInstalled) {
+		printall(\@details) if $opt{v};
+		return 0 unless $opt{u};
+		print "(ALL NOT Installed) $_[1]\n";
+		return 1;
+	} else {
+		printall(\@details) if $opt{m} || $opt{v};
+		print "(MIXED) $_[1]\n";
+		return 1;
+	}
+}
+
+# Log detailed port discovery, if verbose enabled
+sub logPortFinding($$$) {
+	my ($type, $line, $alias) = @_;
+	my $aliasexpr = (not defined $alias or $alias eq $line or $alias eq "") ? "" : " ($alias)";
+	return "+ Found $type $line$aliasexpr\n";
+}
+
+sub printall(@) {
+	my $line;
+	foreach $line (@{$_[0]}) {
+		print $line;
+	}
+}
+
+# Main entry point. First, open INDEX and read all ports into allPorts
+MAIN:{
+	open(IDX, $portIndexFile) or die "Can't open $portIndexFile: $!";
+	while(<IDX>) {
+		chomp;
+		my ($portLine) = ($_ =~ /^[^|]*\|\/usr\/ports\/([^|]*)/)
+		    or die "$_ is not correctly formed!";
+		$allPorts{$portLine} = $_;
+		print "+ Processed INDEX line $_\n" if $opt{d} and $opt{v};
+		print "+ Generated from INDEX portLine $portLine\n" if $opt{d};
+	}
+	close(IDX);
+		
+	# Now open /usr/ports/MOVED to read ports which have moved
+	open(MOVED, $movedFile) or die "Can't open $movedFile: $!";
+	while(<MOVED>) {
+		chomp;
+		if ($_ !~ /^\s*#/) {
+			my ($from, $to) = ($_ =~ /^([^|]*)\|([^|]*)/)
+			    or die "$_ is not a correctly formed MOVED line";
+
+			if ($to eq "") {
+				$deletedPorts{$from} = 1;
+			} else {
+				push @{$fromTo{$from}}, $to;
+				push @{$toFrom{$to}}, $from;
+			}
+		}
+	}
+	close(MOVED);
+
+	# Parse /usr/ports/UPDATING into logical blocks, pass each to processBlock
+	my $prevLine;
+	my @bufferBlock;
+	open(UPD, $updatingFile) or die "Can't open $updatingFile: $!";
+	while(<UPD>) {
+		chomp;
+		if (/^\s*AFFECTS:/ && @bufferBlock > 0) {
+			processBlock(@bufferBlock);
+			@bufferBlock = ();
+		}
+		push @bufferBlock, $prevLine if defined $prevLine;
+		$prevLine = $_;
+	}
+	close(UPD);
+
+	# Process residue and exit
+	push @bufferBlock, $prevLine;
+	processBlock(@bufferBlock);
+}
diff --git a/ports-mgmt/portupdate-scan/src/portupdate-scan.8 b/ports-mgmt/portupdate-scan/src/portupdate-scan.8
new file mode 100644
index 000000000000..446b6d2d7131
--- /dev/null
+++ b/ports-mgmt/portupdate-scan/src/portupdate-scan.8
@@ -0,0 +1,77 @@
+.\" Man page for portupdate-scan
+.\"
+.\" Copyright (c) 2007 Alex Stangl <alex@stangl.us>
+.\"
+.\" Permission to use, copy, modify, and distribute this software for any
+.\" purpose with or without fee is hereby granted, provided that the above
+.\" copyright notice and this permission notice appear in all copies.
+.\"
+.\" THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+.\" WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+.\" MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+.\" ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+.\" WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+.\" ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+.\" OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+.Dd November 5, 2007
+.Os
+.Dt PORTUPDATE-SCAN 8
+.Sh NAME
+.Nm portupdate-scan
+.Nd scan /usr/ports/UPDATING, showing sections for installed ports
+.Sh SYNOPSIS
+.Nm
+.Op Fl dhmuVv
+.Op Fl D Ar portdir
+.Op Fl -help
+.Op Fl -version
+.Sh DESCRIPTION
+Reads port-related files, including /usr/ports/UPDATING, and outputs
+those sections of UPDATING that might be pertinent to this system.
+Only sections that apply to recognize ports that are known, and not
+installed are omitted.
+.Pp
+The following options are available:
+.Bl -tag -width indent
+.It Fl D Ar portsdir
+use portsdir as ports directory instead of /usr/ports
+.It Fl d
+output additional debugging information
+.It Fl h , -help
+output command usage information and exit
+.It Fl m
+for MIXED sections, show breakdown of which ports are installed and not installed. The verbose information from the v flag is a superset of this.
+.It Fl u
+output information on uninstalled ports (default: off)
+.It Fl v
+output more verbose information
+.It Fl V , -version
+output version information and exit
+.El
+.Sh EXIT STATUS
+.Ex -std
+.Sh FILES
+.Bl -tag -width /usr/ports/UPDATING -compact
+.It Pa /usr/ports/UPDATING
+port update news
+.It Pa /usr/ports/INDEX
+port index file
+.It Pa /usr/ports/MOVED
+record of port renames and deletions
+.Sh EXAMPLES
+.Pp
+Basic normal operation:
+.Pp
+.Dl portupdate-scan
+.Pp
+To include details of installed/uninstalled ports for MIXED sections:
+.Pp
+.Dl portupdate-scan -m
+.Sh SEE ALSO
+.Xr ports 7
+.Sh AUTHORS
+.An "Alex Stangl" Aq alex@stangl.us
+.Sh BUGS
+The concept of machine-interpreting the APPLIES: line in /usr/ports/UPDATING,
+which were intended for human consumption, is dubious. It would be nice to
+evolve some more robust method for communicating this information.