path: root/mk/bulk/post-build

#!/usr/pkg/bin/perl
# $NetBSD: post-build,v 1.63 2006/01/21 11:29:32 rillig Exp $
#
# Collect stuff after a pkg bulk build
#
# (c) 2000 Hubert Feyrer, All Rights Reserved.
#

use File::Basename;
use POSIX qw(strftime);
use strict;
use warnings;

#
# Global variables
#

my %vars;
my $verbose = 1; # set to 2 to see more command execution detail

#
# Helper functions
#

sub pb_die($$) {
	my ($fname, $msg) = @_;
	my ($text, $sep);

	$text = "[post-build] error: ";
	$sep = "";
	if (defined($fname)) {
		$text .= "${sep}${fname}";
		$sep = ": ";
	}
	$text .= "${sep}${msg}";
	die "${text}\n";
}

sub my_system (@) {
	print STDERR '> '.join(' ', @_)."\n" if ($verbose >= 2);
	return system(@_);
}

sub readfirstline($) {
	my ($fname) = @_;
	my ($contents);

	open(F, "<", $fname)
	or pb_die($fname, "Cannot be read: $!");

	defined($contents = <F>)
	or pb_die($fname, "Must not be empty.");
	chomp($contents);

	close(F)
	or pb_die($fname, "Cannot be closed: $!");

	return $contents;
}

#
# Load configuration variables from the bulk.conf file, which is a shell
# script.
#

my $BULK_BUILD_CONF = $ENV{BULK_BUILD_CONF} || (dirname($0).'/build.conf');
$BULK_BUILD_CONF = "./$BULK_BUILD_CONF" if ($BULK_BUILD_CONF !~ m:^/:);

if (!-f $BULK_BUILD_CONF) {
	pb_die($BULK_BUILD_CONF, "Does not exist.");
}

# Dig given variable out of config file, and set it
sub get_build_conf_vars(@) {
	my (@varnames) = @_;
	my ($is_set, $value);

	foreach my $varname (@varnames) {
		my $cmd = join("\n", (
			#"set -eu",		# TODO: Should be enabled soon
			". '${BULK_BUILD_CONF}'",
			". mk/bulk/post-build-conf",
			"check_config_vars",
			"echo \"\${${varname}+set}\"",
			"echo \"\${${varname}-}\""
		));
		
		open(CMD, "${cmd} |")
			or pb_die($BULK_BUILD_CONF, "Could not evaluate configuration file.");

		chomp($is_set = <CMD>);
		{ local $/ = undef; $value = <CMD>; }
		chomp($value);	# This must be outside the above {...} block

		close(CMD) or pb_die($BULK_BUILD_CONF, "Could not evaluate configuration file (close).");

		#
		# Sanity checks
		#

		if ($is_set ne "set") {
			pb_die($BULK_BUILD_CONF, "${varname} must be set.");
		}
		if ($value =~ qr"^\s+$") {
			pb_die($BULK_BUILD_CONF, "${varname} must be non-empty.");
		}
		if ($value =~ qr"\n") {
			pb_die($BULK_BUILD_CONF, "${varname} must not contain newlines.");
		}

		$vars{$varname} = $value;
		if ($verbose >= 2) {
			print STDERR "> $varname=$vars{$varname}\n";
		}
	}
}

get_build_conf_vars(
	'ADMINSIG',		# "-Your Name"
	'REPORTS_URL',		# "ftp://ftp.example.com/pub/pkgsrc/misc/pkgstat"
	'REPORTS_DIR',		# "$HOME/bulk-logs"
# REPORT_BASEDIR often depends on a timestamp, which has been saved at
# the beginning of the bulk build in the BULK_BUILD_ID_FILE. It will be
# retrieved later.
	'REPORT_HTML_FILE',	# "report.html"
	'REPORT_TXT_FILE',	# "report.txt"
	'USR_PKGSRC',		# "/usr/pkgsrc"
	'osrev',		# `uname -r`
);


my $os = `uname -s`;
chomp $os;

my $BMAKE = $ENV{BMAKE} || pb_die(undef, "The BMAKE environment variable must be set.");

sub get_mk_conf_vars (@) {
	my ($rest);

	open(I, "set -e; . '$BULK_BUILD_CONF'; . '$vars{USR_PKGSRC}/mk/bulk/post-build-conf'; export_config_vars; cd $vars{USR_PKGSRC}/pkgtools/pkglint && $BMAKE show-vars BATCH=1 VARNAMES='".join(' ', @_)."' |")
		or pb_die(undef, "Cannot get mk.conf variables.");

	foreach my $var (@_) {
		chomp($vars{$var} = <I>);

		if ($vars{$var} eq "") {
			pb_die(undef, "\${$var} must be defined in your mk.conf");
		}

		print STDERR "> $var=$vars{$var}\n" if ($verbose >= 2);
	}

	{ local $/ = undef; $rest = <I>; }
	if (defined($rest) && $rest ne "") {
		pb_die(undef, "Output of $BMAKE show-vars too long:\n${rest}");
	}

	close(I) or die pb_die(undef, "Cannot get mk.conf variables (close).");
}

# Extract the names of the files used for the build log and broken build logs.
# These have defaults set by bsd.bulk-pkg.mk and may be overridden in
# /etc/mk.conf
get_mk_conf_vars(qw(
	BROKENFILE
	BROKENWRKLOG
	BULKFILESDIR
	BULK_DBFILE
	DEPENDSFILE
	DEPENDSTREEFILE
	FIND
	INDEXFILE
	LOCALBASE
	MACHINE_ARCH
	ORDERFILE
	PAX
	PKG_DBDIR
	STARTFILE
	SUPPORTSFILE
	X11BASE
	PKG_TOOLS_BIN
	BULK_BUILD_ID_FILE
));

my $bulk_dbfile_base = basename($vars{BULK_DBFILE});
my $dependstreefile_base = basename($vars{DEPENDSTREEFILE});
my $dependsfile_base = basename($vars{DEPENDSFILE});
my $supportsfile_base = basename($vars{SUPPORTSFILE});
my $indexfile_base = basename($vars{INDEXFILE});
my $orderfile_base = basename($vars{ORDERFILE});

my $reports_url = $vars{"REPORTS_URL"};
my $reports_dir = $vars{"REPORTS_DIR"};
my $report_basedir = readfirstline($vars{"BULK_BUILD_ID_FILE"});
my $report_html_file = $vars{"REPORT_HTML_FILE"};
my $report_txt_file = $vars{"REPORT_TXT_FILE"};

my $report_url = "${reports_url}/${report_basedir}";
my $report_dir = "${reports_dir}/${report_basedir}";
my $report_html_path = "${report_dir}/${report_html_file}";
my $report_txt_path = "${report_dir}/${report_txt_file}";

my $startdate = (stat($vars{STARTFILE}))[9];
my $enddate = '';
if (!defined($startdate) || $startdate == 0) {
	$startdate = "unknown";
} else {
	local $ENV{TZ} = "UTC";
	$startdate = strftime("%c %Z", gmtime($startdate));
	$enddate = strftime("%c %Z", gmtime(time()));
}

sub print_summary_line($$) {
	my ($name, $value) = @_;

	printf("        %-30s  %s\n", $name, $value);
}

sub print_report_line($$$) {
	my ($pkgpath, $breaks, $maintainer) = @_;

	printf("%-26s %-7s %s\n", $pkgpath, $breaks, $maintainer);
}

sub print_report_header() {
	print_report_line("Package", "Breaks", "Maintainer");
	print("--------------------------------------------------------------\n");
}

my_system("mkdir", "-p", "--", $report_dir);

# Copy over the output from the build process
chdir($vars{"BULKFILESDIR"}) or pb_die($vars{"BULKFILESDIR"}, "Cannot change directory.");
my_system("find . -name $vars{BROKENFILE} -print -o -name $vars{BROKENWRKLOG} -print | $vars{PAX} -r -w -X ${report_dir}");

# Copy over the cache files used during the build
foreach my $f qw(BULK_DBFILE DEPENDSTREEFILE DEPENDSFILE SUPPORTSFILE INDEXFILE ORDERFILE) {
	if (-f $vars{$f}) {
		my_system("cp", "--", $vars{$f}, $report_dir);
	}
}

chdir($report_dir) or pb_die($report_dir, "Cannot change directory.");
writeReport();

#
# Adjust "last" symlink
#
unlink("${reports_dir}/last");
symlink($report_basedir, "${reports_dir}/last");

#
# Generate leftovers-$vars{MACHINE_ARCH}.html: files not deleted
# Leftover files are copied to leftovers-$vars{MACHINE_ARCH} dir,
# and linked from leftovers-$vars{MACHINE_ARCH}.html
#
{
	chdir($report_dir) or pb_die($report_dir, "Cannot change directory.");
	my_system("mkdir", "-p", "leftovers-$vars{MACHINE_ARCH}");

	# Find files since last build:
	my $leftovers_txt = "leftovers-$vars{MACHINE_ARCH}.txt";
	my $leftovers_html = "leftovers-$vars{MACHINE_ARCH}.html";

	my_system("$vars{FIND} $vars{LOCALBASE}/ -newer $vars{STARTFILE} -type f -print >>$leftovers_txt");
	my_system("$vars{FIND} $vars{X11BASE}/ -newer $vars{STARTFILE} -type f -print >>$leftovers_txt");

	# Strip perl-files:
	my $perlfiles;
	{
		local $/;
		undef $/;
		$perlfiles = `$vars{PKG_TOOLS_BIN}/pkg_info -qL perl*`;
	}

	my $perlfiles_pattern = $perlfiles;
	$perlfiles_pattern =~ s/\n/|/g;
	$perlfiles_pattern =~ s/|$//;

	open (LEFT, $leftovers_txt) or die "can't read $leftovers_txt: $!";
	my @left = <LEFT>;
	close (LEFT);
	my @leftovers = grep(!/^(?:${perlfiles_pattern})$/, @left);

	if (index($vars{PKG_DBDIR}, $vars{LOCALBASE}) == 0) {
		# If PKG_DBDIR is inside LOCALBASE, exclude it from the leftovers.
		@leftovers = grep { index($_, $vars{PKG_DBDIR}) != 0 } @leftovers;
	}

	open (LEFT, ">$leftovers_txt") or die "can't write $leftovers_txt: $!";
	print LEFT @leftovers;
	close (LEFT);

	if (scalar(@leftovers)) {
		# Store leftovers, for easier identification:
		my_system("$vars{PAX} -r -w -X leftovers-$vars{MACHINE_ARCH} < $leftovers_txt");
	}

	# Add links to leftover list:
	open (OUT, "> $leftovers_html")
		or die "can't write $leftovers_html";
	print OUT <<EOOUT;
<html>
<body>
<pre>
EOOUT
	foreach (@leftovers) {
		chomp;
		print OUT "<a href=\"${report_url}/leftovers-$vars{MACHINE_ARCH}$_\">$_</a>\n";
	}
	print OUT <<EOOUT2;
</pre>
</body>
</html>
EOOUT2
	close(OUT);
}

# print the result of a single broken package
sub pkgResult ($$) {
	my ($pinfo, $state) = @_;
	my $pkg = $pinfo->{pkg};
	my $nbrokenby = $pinfo->{nbrokenby};
	my $nerrors = $pinfo->{nerrors};

	my @idents = `$vars{FIND} $vars{USR_PKGSRC}/$pkg -type f -print | xargs grep \\\$NetBSD`;
	my $datetime = "";
	my $file = "";
	my $ver = "";
	foreach my $ident (@idents) {
		$ident =~ /\$[N]etBSD: ([^ ]*),v [^ ]* ([^ ]*) ([^ ]*) [^ ]* Exp \$/;
		if (defined($2) && defined($3) && ("$2 $3" gt $datetime)) {
			$datetime = "$2 $3";
			$file = $1;
			$ver = $1;
		}
	}

	my $maintainer = `grep ^MAINTAINER $vars{USR_PKGSRC}/$pkg/Makefile`;
	$maintainer =~ s/MAINTAINER=[ \t]*//;
	if (! $maintainer) {
		 $maintainer = `cd $vars{USR_PKGSRC}/$pkg ; $BMAKE show-var VARNAME=MAINTAINER`;
	}
	$maintainer =~ s/</&lt;/g;
	$maintainer =~ s/>/&gt;/g;
	chomp($maintainer);

	(my $state_style = $state) =~ s/ //g;

	my $nbrokenby_html = '<td>&nbsp;</td>';
	$nbrokenby_html =
		'<td align="right" class="pkg-'.$state_style.'">'.$nbrokenby.'</td>'
		if $nbrokenby > 0;

	if ($pinfo->{nerrors} != 0 && $verbose && ($state eq "broken" || $state eq "topten")) {
		print_report_line($pkg, $nbrokenby > 0 ? $nbrokenby : "", $maintainer);
	}

	return <<EOHTML;
<tr>
  <td><a class="pkg-$state_style" href="$pinfo->{bf}" title="build log for $pkg">$pkg</a></td>
  $nbrokenby_html
  <td>$file</td>
  <td>$maintainer</td>
</tr>

EOHTML
}

# write the build report
sub writeReport {
	my $broken = getBroken();
	my $nbroken = scalar(@{$broken->{"broken"}});
	my $nbrokendep = scalar(@{$broken->{"broken depends"}});
	my $nunpackaged = scalar(@{$broken->{"not packaged"}});
	my $nbrokentot = $nbroken + $nbrokendep;
	my $ntotal = $nunpackaged + $nbroken + $nbrokendep;

	# determine the number of packages attempted, and then successful
	open(ORDER, $vars{ORDERFILE}) || die "can't open $vars{ORDERFILE}: $!";
	my @order = <ORDER>;
	close(ORDER);
	my $nattempted = scalar(@order);
	my $nsuccessful = $nattempted - $ntotal;

	if ($verbose) {
		print <<EOF;
pkgsrc bulk build results
$os $vars{osrev}/$vars{MACHINE_ARCH}

Summary:

EOF
		print_summary_line("Build started:", $startdate);
		print_summary_line("Build ended:", $enddate);
		print("\n");
		print_summary_line("Successfully packaged:", $nsuccessful);
		print_summary_line("Packages really broken:", $nbroken);
		print_summary_line("Pkgs broken due to them:", $nbrokendep);
		print_summary_line("Total broken:", $nbrokentot);
		print_summary_line("Not packaged:", $nunpackaged);
		print_summary_line("Total:", $ntotal);
		print <<EOF;

Packages not listed here resulted in a binary package. The build
report, including logs of failed/not-packaged is available from:

${report_url}/${report_html_file}
EOF
	}

	open(HTML, ">", $report_html_path) or die "Can't write ${report_html_path}: $!";
	print HTML <<EOHTML;
<html>
<head>
<title>$os $vars{osrev}/$vars{MACHINE_ARCH} bulk package build</title>
<style type="text/css">
<!--

body {
	Font-Family: Tahoma, Verdana, sans-serif;
	Line-Height: 1.3em;
	Text-Decoration: None;
	Color: black;
	Background-Color: white;
	Border-Width: 0;
}

table {
	Border-Width: 0;
}

table td {
	Font-Family: Tahoma, Verdana, sans-serif;
	line-height: 1em;
}

a:link {
	Color: #3535c5;
}

a:visited {
	Color: #700080;
}

a:hover {
	Color: #6565e5;
	Text-Decoration: underline;
}

tr {
	Vertical-Align: top;
}

td {
	Vertical-Align: top;
}

h1 {
	Font-Size: 3.5ex;
	Line-Height: 1em;
	Color: #000066;
}

h2 {
	Font-Size: 2.5ex;
	Line-Height: 1em;
	Color: #660000;
}

h3 {
	Font-Size: 2ex;
	Color: #660066;
}

h4 {
	Font-Size: 1.8ex;
	Color: #006600;
}

tt.filename {
	Line-Height: 1.3em;
	Color: #AA0000;
}

.pkgname {
	Font-Family: Arial, Helvetica, Courier, fixed;
	Font-Style: Italic;
	Text-Decoration: none;
	Line-Height: 1.3em;
}

.pkg-broken {
	Color: red;
}

.pkg-brokendepends {
	Color: orange;
}

.pkg-notpackaged {
	Color: blue;
}
-->
</style>
</head>

<body bgcolor="white" text="black" link="#3535c5" vlink="#700080" alink="#3535c5">

<a name="top"></a>
<h1>pkgsrc bulk build results</h1>
<h2>$os $vars{osrev}/$vars{MACHINE_ARCH}</h2>

<h3>Summary</h3>

<table>
<tr>
  <td>Build started:			<td align="right">$startdate</td>
</tr>
<tr>
  <td>Build ended:			<td align="right">$enddate</td>
</tr>
<tr>
  <td>&nbsp;</td>			<td>&nbsp;</td>
</tr>
<tr>
  <td>Successfully packaged:</td>	<td align="right">$nsuccessful</td>
</tr>
<tr class="pkg-broken">
  <td>Packages really broken:</td>	<td align="right">$nbroken</td>
</tr>
<tr class="pkg-brokendepends">
  <td>Packages broken due to them:</td>	<td align="right">$nbrokendep</td>
</tr>
<tr>
  <td>Total broken:</td>		<td align="right">$nbrokentot</td>
</tr>
<tr class="pkg-notpackaged">
  <td>Not packaged:</td>		<td align="right">$nunpackaged</td>
</tr>
<tr>
  <td>Total:</td>			<td align="right">$ntotal</td>
</tr>
</table>

<p>
  Packages not listed here resulted in a <a
  href="../../packages/" title="binary packages for $os $vars{osrev}/$vars{MACHINE_ARCH}">binary
  package</a>. Results of failed packages are available below.
</p>

<p>
  Files leftover from the build (because of broken PLISTs, etc.) can be
  found in <a href="leftovers-$vars{MACHINE_ARCH}.html" title="leftover files">this
  list</a>.
</p>

<p>
  Jump to:<br/>
  <ul>
    <li><a href="#topten">Top Ten Offenders</a></li>
    <li><a href="#broken">Broken packages</a></li>
    <li><a href="#broken depends">Broken dependencies</a></li>
    <li><a href="#not packaged">Not packaged</a></li>
  </ul>
</p>

EOHTML

	my %state_head = (
		"topten" => "Top Ten Offenders",
		"broken" => "Broken packages",
		"broken depends" => "Broken dependencies",
		"not packaged" => "Not packaged"
	);

	foreach my $state ("topten", "broken", "broken depends", "not packaged") {
		next unless scalar(@{$broken->{$state}});

		if ($verbose && ($state eq "topten" || $state eq "broken")) {
			print "\n\n$state_head{$state}\n\n";
		print_report_header();
	}


		print HTML <<EOHTML;

<a name="$state"></a>
<h2>$state_head{$state}</h2>
<table width="100%">
<tr align="left">
  <th width="30%">Package</th>
  <th>Breaks</th>
  <th>File touched last</th>
  <th>Maintainer</th>
</tr>

EOHTML
		foreach my $pinfo (@{$broken->{$state}}) {
			print HTML pkgResult($pinfo, $state);
		}

		print HTML <<EOHTML;
</table>
<hr>
<a href="#top">Up to top</a><br/>
<hr>
EOHTML
	}

	print HTML <<EOHTML;
<hr>
<p>
The following cache files were used during the build:
</p>
<ul>
<li>The <a href="$bulk_dbfile_base">SPECIFIC_PKGS bulk database file</a>.</li>
<li>The <a href="$dependstreefile_base">depends tree file</a>.</li>
<li>The <a href="$dependsfile_base">depends file</a>.</li>
<li>The <a href="$supportsfile_base">supports file</a>.</li>
<li>The <a href="$indexfile_base">index file</a>.</li>
<li>The <a href="$orderfile_base">build order file</a>.</li>
</ul>
<hr>

<p>
<ul>
<!-- <li>See the list of <a href="../index.html">all log files</a>. -->
<li>Visit the <a href="http://www.NetBSD.org">NetBSD web site</a>.
<li>Learn more about
    <a href="http://www.NetBSD.org/Documentation/software/packages.html">
    The NetBSD Packages Collection</a>.
</ul>
</p>
</body>
</html>
EOHTML
	close(HTML);

	if ($verbose) {
		print "\n\n$vars{ADMINSIG}\n\n";
		print "[* This message was created by the Packages Collection bulk build software *]\n";
	}
}

# get and sort the broken packages
sub getBroken {
	my $res = {
		'broken' => [],
		'broken depends' => [],
		'not packaged' => [],
		'topten' => []
	};

	open (BF, $vars{BROKENFILE}) || return $res;
	my @in = <BF>;
	close (BF);

	foreach (@in) {
		chomp;
		my ($nerrors, $bf, $nbrokenby) = split;
		my $pkg = $bf;
		$pkg =~ s,/$vars{BROKENFILE},,;
		my %tmp = (
			bf => $bf,
			pkg => $pkg,
			nbrokenby => $nbrokenby,
			nerrors => $nerrors,
		);

		if ($nerrors > 0) {
			push(@{$res->{"broken"}}, \%tmp);
		} elsif ($nerrors == -1) {
			push(@{$res->{"broken depends"}}, \%tmp);
		} else {
			push(@{$res->{"not packaged"}}, \%tmp);
		}
	}

	# sort pkgs in each state
	foreach my $state ("broken", "broken depends", "not packaged") {
		$res->{$state} = [ sort { $a->{pkg} cmp $b->{pkg} } @{$res->{$state}} ];
	}

	$res->{"topten"} = [ sort { $b->{nbrokenby} <=> $a->{nbrokenby} } @{$res->{"broken"}} ];

	for (my $count = $#{$res->{"topten"}}; $count >= 10; $count--) {
		pop(@{$res->{"topten"}});
	}

	return $res;
}