add DEBUG_PKG_CACHE functionality. Doesn't interfere with normal operation.

Basically, if you set DEBUG_PKG_CACHE to a directory, pkg_add will download
debug packages "on the sly" any time it installs packages. It is mostly
silent (apart from fetching error or directory non existent).
It *won't* download packages that are already installed, but this allows
keeping debug packages "just in case" in synch with your current snapshot,
as some people (mpi@) have worried that by the time you get to debugging
something, the snapshots will have moved too much.

1 files changed, 61 insertions, 1 deletions

diff --git a/usr.sbin/pkg_add/OpenBSD/PkgAdd.pm b/usr.sbin/pkg_add/OpenBSD/PkgAdd.pm
index 8959a49f821..6267188c7fe 100644
--- a/usr.sbin/pkg_add/OpenBSD/PkgAdd.pm
+++ b/usr.sbin/pkg_add/OpenBSD/PkgAdd.pm
@@ -1,7 +1,7 @@
 #! /usr/bin/perl
 
 # ex:ts=8 sw=4:
-# $OpenBSD: PkgAdd.pm,v 1.116 2019/11/16 11:07:43 espie Exp $
+# $OpenBSD: PkgAdd.pm,v 1.117 2019/12/04 10:47:38 espie Exp $
 #
 # Copyright (c) 2003-2014 Marc Espie <espie@openbsd.org>
 #
@@ -153,6 +153,16 @@ OpenBSD::Auto::cache(cache_directory,
 		}
 	});
 
+OpenBSD::Auto::cache(debug_cache_directory,
+	sub {
+		my $self = shift;
+		if (defined $ENV{DEBUG_PKG_CACHE}) {
+			return $ENV{DEBUG_PKG_CACHE};
+		} else {
+			return undef;
+		}
+	});
+
 sub set_name_from_handle
 {
 	my ($state, $h, $extra) = @_;
@@ -1039,9 +1049,59 @@ sub process_set
 	}
 	$set->cleanup;
 	$state->tracker->done($set);
+	if (defined $state->debug_cache_directory) {
+		$self->grab_debug_packages($set, $state);
+	}
 	return ();
 }
 
+sub grab_debug_package
+{
+	my ($self, $pkg, $state) = @_;
+	my $o = $state->locator->find($pkg);
+	return if !defined $o;
+	my $d = $state->debug_cache_directory;
+	require OpenBSD::Temp;
+	my ($fh, $name) = OpenBSD::Temp::permanent_file($d, "debug-pkg");
+	if (!defined $fh) {
+		$state->errsay(OpenBSD::Temp->last_error);
+		return;
+	}
+	my $r = fork;
+	if (!defined $r) {
+		$state->fatal("Cannot fork: #1", $!);
+	} elsif ($r == 0) {
+		$DB::inhibit_exit = 0;
+		open(STDOUT, '>&', $fh);
+		open(STDERR, '>>', $o->{errors});
+		$o->{repository}->grab_object($o);
+	} else {
+		close($fh);
+		waitpid($r, 0);
+		my $c = $?;
+		$o->{repository}->parse_problems($o->{errors}, 1, $o);
+		if ($c == 0) {
+			rename($name, "$d/$pkg.tgz");
+		} else {
+			unlink($name);
+			$self->errsay("Grabbing debug package failed: #1",
+				$state->child_error($c));
+		}
+	}
+}
+
+sub grab_debug_packages
+{
+	my ($self, $set, $state) = @_;
+	for my $p ($set->newer_names) {
+		next if $p =~ m/^debug\-/;
+		my $dbg = "debug-$p";
+		next if $state->tracker->is_known($dbg);
+		next if OpenBSD::PackageInfo::is_installed($dbg);
+		$self->grab_debug_package($dbg, $state);
+	}
+}
+
 sub inform_user_of_problems
 {
 	my $state = shift;