portsnap broken?

[Matthew D. Fuller]

On Wed, Jul 03, 2019 at 10:11:41AM +0200 I heard the voice of
Kurt Jaeger, and lo! it spake thus:
> 
> > With a little script to pull the snapdates:
> > [...]
> 
> Nice! Can you put that script somewhere for others to use ?

It's pretty small and straightforward.  Attached.  It _is_ based on a
bit of reverse-engineering of /usr/sbin/portsnap, so there may well be
a better way already extant of getting the info (and there probably
should be, if there isn't), but it Works For Me...

-------------- next part --------------
#!/usr/bin/env perl
use strict;
use warnings;


# Find the server list
my @servers;
{
	use Net::DNS;
	my $res = Net::DNS::Resolver->new;
	my $srv = $res->search('_http._tcp.portsnap.freebsd.org', 'SRV');

	die "Nothing from SRV request: @{[$res->errorstring]}\n" unless $srv;

	foreach my $rr (grep { $_->type eq 'SRV' } $srv->answer)
	{
		my $si = {
			'priority' => $rr->priority,
			'host'     => $rr->target,
		};
		push @servers, $si;
	}

	@servers = sort {
			my $r;
			return $r if($r = ($a->{priority} <=> $b->{priority}));
			return $r if($r = ($a->{host} cmp $b->{host}));
			return 0;
		} @servers;
}


# We need to store temp files to go through openssl...
my $tmpdir;
{
	use File::Temp qw/tempdir/;
	$tmpdir = tempdir(CLEANUP => 1);
	die "Failed making tempdir" unless -d $tmpdir;
}


# Load snapshot info and check timestamp from each
for my $s (@servers)
{
	my $host = $s->{host};
	my $key  = "http://$host/pub.ssl";
	my $snap = "http://$host/latest.ssl";

	my $keyout  = "$tmpdir/$host.key";
	my $snapout = "$tmpdir/$host.snap";

	use LWP::UserAgent;
	my $web  = LWP::UserAgent->new(timeout => 5);
	my $res = $web->get($key, ':content_file' => $keyout);
	if(!$res->is_success)
	{
		$s->{failed} = 1;
		print STDERR "$host key fetch failed: @{[$res->status_line]}\n";
		next;
	}

	$res = $web->get($snap, ':content_file' => $snapout);
	if(!$res->is_success)
	{
		$s->{failed} = 1;
		print STDERR "$host snap fetch failed: @{[$res->status_line]}\n";
		next;
	}


	# Now we use openssl to dissect
	my @cmd = ( qw(openssl rsautl -pubin -inkey), $keyout, '-verify' );

	use IPC::Run3;
	my ($out, $err);
	run3(\@cmd, $snapout, \$out, \$err);
	my $rc = $? >> 8;
	if($rc  != 0)
	{
		$s->{failed} = 1;
		print STDERR "$host: openssl returned $rc\n$err\n";
		next;
	}

	# Second field of $out is the timestamp
	chomp $out;
	my $ts = (split/\|/, $out)[1];
	$s->{timestamp} = $ts;
}


# And show the results
my $now = time;
for my $s (@servers)
{
	my $host = $s->{host};
	(my $sh = $host) =~ s/\.portsnap\.freebsd\.org$//;
	if($s->{failed})
	{
		print "$sh: failed\n";
		next;
	}

	my $pri  = $s->{priority};
	my $ts   = $s->{timestamp};

	# How old?
	my $old = $now - $ts;
	my $age;
	if($old > 86400)
	{
		my $days = int($old / 86400);
		$age .= "$days days, ";
		$old -= ($days * 86400);
	}
	{
		my $hours = int($old / 3600);
		$old -= ($hours * 3600);
		my $mins = int($old / 60);
		$old -= ($mins * 60);
		$age .= sprintf("%02d:%02d:%02d", $hours, $mins, $old);
	}

	use Date::Format;
	chomp(my $ftime = ctime($ts));

	printf "%20s: $ftime  ($age ago)\n", $sh;
}