#! /usr/bin/perl
#
# analyze_results
#
# Script to analyze failed build logs. Look for specific regexps to
# classify things
#
#
# (c) 2018 Steve McIntyre <steve@einval.com> GPL v2+

use strict;
use warnings;
use POSIX qw(strftime);
use Data::Dumper;
use Getopt::Std;
use HTTP::Tiny;
use URI::Encode qw(uri_encode uri_decode);

my $name = "analyze_results";
my $repo = "https://git.einval.com/cgi-bin/gitweb.cgi?p=buildd-scripts.git";
my $hostname;
my $date;
my $time_start = time();
my $time_end;
my $time_taken;
my $num_fail = 0;
my $awaiting_analysis = 0;
my $lines_read = 0;
my $existing_bugs = 0;
my $buildd_base_url="https://buildd.debian.org/status/package.php?p=";

my $new_bugs_filed = 0;
my $new_bugs_arm64_alignment = 0;
my $new_bugs_arm64_misdetect = 0;
my $new_bugs_arm64_test_fail = 0;
my $new_bugs_arm64_other = 0;
my $new_bugs_arch_any = 0;

use constant {
    ERR_ARCH_MISMATCH      => 1,
    ERR_NO_SOURCE          => 2,
    ERR_INFRA              => 3,
    ERR_BD_PROBLEM         => 4,
    ERR_DETECT_WRONG_ARCH  => 5,
    ERR_CRASH              => 6,
    ERR_BUILD_PROBLEM      => 7,
    ERR_TEST_PROBLEM       => 8,
    ERR_BUILD_TIMEOUT      => 9,
};

my @err_descriptions;
$err_descriptions [ERR_ARCH_MISMATCH]     = "Architecture mismatches";
$err_descriptions [ERR_NO_SOURCE]         = "No source found";
$err_descriptions [ERR_INFRA]             = "Infrastructure errors";
$err_descriptions [ERR_BD_PROBLEM]        = "Problems with build-deps";
$err_descriptions [ERR_DETECT_WRONG_ARCH] = "Builds detected wrong architecture";
$err_descriptions [ERR_CRASH]             = "Crashes detected";
$err_descriptions [ERR_BUILD_PROBLEM]     = "Problems detected during build phase";
$err_descriptions [ERR_TEST_PROBLEM]      = "Problems detected during test phase";
$err_descriptions [ERR_BUILD_TIMEOUT]     = "Package builds timed out";

# Known failure modes to look for
my @logcheck = (
    {
	# "rchitecture mismatch" -> should never build on this arch
	# Stop working on this log at this point
	string   => 'rchitecture mismatch',
	message  => 'Architecture mismatch',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_ARCH_MISMATCH,
    },
    {
	string   => 'not in arch list or does not match any',
	message  => 'Architecture mismatch',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_ARCH_MISMATCH,
    },
    {
	# "binary build with no binary artifacts found" -> no packages
	# built. Why not picked up already above?.
	# Stop working on this log at this point
	string   => 'binary build with no binary artifacts found',
	message  => 'No binaries built',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_ARCH_MISMATCH,
    },
    {
	string   => 'E: Can not find version \S+ of package',
	message  => 'Could not find specified source package',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_NO_SOURCE,
    },
    {
	string   => 'schroot.*File is not owned by user root',
	message  => 'Schroot setup failure',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_INFRA,
    },
    {
	string   => 'No space left on device',
	message  => 'Build ran out of disk space',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_INFRA,
    },
    {
	string   => 'The system has no more ptys',
	message  => 'Build ran out of ptys',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_INFRA,
    },
    {
	string   => 'aarch64-unknown-linux-gnu',
	message  => 'Wrong arch detected',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_DETECT_WRONG_ARCH,
    },
    {
	string   => 'binutils-aarch64',
	message  => 'Wrong arch detected',
	check    => 0,
	stop     => 1,
	analyze  => 1,
	type     => ERR_DETECT_WRONG_ARCH,
    },
    {
	string   => 'lib.linux-aarch64',
	message  => 'Wrong arch detected',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_DETECT_WRONG_ARCH,
    },
    {
	# "Bus error" -> alignment bug
	string   => 'Bus error',
	message  => 'Alignment problem',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_CRASH,
    },
    {
	# "SIGBUS" -> alignment bug
	string   => 'signal SIGBUS',
	message  => 'Alignment problem',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_CRASH,
    },
    {
	# "Segmentation fault" -> code problem
	string   => 'Segmentation fault',
	pstring  => 'Setting up (\S+)',
	message  => 'Segmentation fault when installing RESULT',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_CRASH,
    },
    {
	# "Segmentation fault" -> code problem
	string   => 'Segmentation fault',
	message  => 'Segmentation fault',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_CRASH,
    },
    {
	# "Illegal instruction" -> bad build target?
	string   => 'Illegal instruction',
	pstring  => 'Setting up (\S+)',
	message  => 'Illegal instruction when installing RESULT',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_CRASH,
    },
    {
	# "Illegal instruction" -> bad build target?
	string   => 'Illegal instruction',
	message  => 'Illegal instruction',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_CRASH,
    },
    {
	# Installing build-deps failed
	string   => 'dpkg: error processing package (\S+)',
	message  => 'Build-dep failed to install (RESULT)',
	check    => 1,
	stop     => 0,
	analyze  => 0,
	type     => ERR_BD_PROBLEM,
    },
    {
	# Installing build-deps failed
	string   => 'E: pbuilder-satisfydepends failed.',
	message  => 'Pbuilder build-deps failed',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BD_PROBLEM,
    },
    {
	# Installing build-deps failed
	string   => 'E: Unmet dependencies',
	message  => 'Build-deps failed',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BD_PROBLEM,
    },
    {
	# Installing build-deps failed
	string   => 'unsat-dependency: (\S+)',
	message  => 'Missing build-dep (RESULT)',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BD_PROBLEM,
    },
    {
	# Installing build-deps failed
	string   => 'unsat-conflict: (\S+)',
	message  => 'Unsatisfiable build-dep conflict (RESULT)',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BD_PROBLEM,
    },
    {
	# Build failed - missing build-dep?
	string   => 'build dependencies/conflicts unsatisfied',
	message  => 'Build-deps not satisfiable',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BD_PROBLEM,
    },
    {
	# Build failed
	string   => 'dpkg-source: error: unrepresentable changes to source',
	message  => 'dpkg-source failure',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed - missing build-dep?
	string   => 'ld: cannot find',
	message  => 'Build failure: missing library - missing build-dep?',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed - missing build-dep?
	string   => 'fatal error:.*No such file or directory',
	message  => 'Build failure: missing header - missing build-dep?',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed - missing build-dep?
	string   => 'SEVERE: Cannot resolve dependencies',
	message  => 'Build failure - missing build-dep?',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed - can't exec something...
	string   => 'error trying to exec.*execvp: No',
	message  => 'Build failure (missing binary)',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed
	string   => 'BUILD FAIL',
	message  => 'Build failure (java/javadoc)',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed
	string   => '^make.*\*\*\*.* \[debian/rules.*Error \d+$',
	message  => 'Build failure (other)',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed
	string   => 'make.*returned exit code',
	message  => 'Build failure (other)',
	check    => 1,
	stop     => 0,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failure
	string   => 'dh_auto_build:.*returned exit code \d+',
	message  => 'Build failure (other)',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failure
	string   => 'dh_auto_clean:.*returned exit code \d+',
	message  => 'Build failure (clean failed)',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failure
	string   => 'dh_auto_install:.*returned exit code \d+',
	message  => 'Build failure (install failed)',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failure
	string   => 'dh_auto_configure:.*returned exit code \d+',
	message  => 'Build failure (configure failed)',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed
	string   => '^debian/.*recipe for target (\S+) failed',
	message  => 'Build failure (RESULT)',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed
	string   => '^debian/.*\*\*\* (.*).  Stop.',
	message  => 'Build error (RESULT)',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed
	string   => 'dpkg-buildpackage: error:.*(debian/rules \S+) subprocess returned exit status 2',
	message  => 'Build error (RESULT)',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failed
	string   => 'fakeroot debian/rules binary',
	message  => 'Build failure (other)',
	check    => 0,
	stop     => 1,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Build failure
	string   => 'constant \d+ overflows.*int',
	message  => 'Go 32-bit integer overflow',
	check    => 1,
	stop     => 0,
	analyze  => 1,
	type     => ERR_BUILD_PROBLEM,
    },
    {
	# Test failure
	string   => 'OSError: \[Errno 13\] Permission denied',
	message  => 'Python EPERM test failure',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_TEST_PROBLEM,
    },
    {
	# Test failure
	string   => 'dh_auto_test:.*returned exit code \d+',
	message  => 'Test failure',
	check    => 1,
	stop     => 1,
	analyze  => 1,
	type     => ERR_TEST_PROBLEM,
    },
    {
	# Timeout. pbuilder is too dumb to do this properly :-(
	string   => 'I: Terminating build process due to timeout',
	message  => 'Pbuilder build timeout',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BUILD_TIMEOUT,
    },
    {
	# Timeout from sbuild
	string   => 'Build killed with signal TERM after \d+ minutes of inactivity',
	message  => 'Sbuild build timeout',
	check    => 1,
	stop     => 1,
	analyze  => 0,
	type     => ERR_BUILD_TIMEOUT,
    },
);

my %log_results;
my %udd;

#foreach my $checktmp (@logcheck) {
#    my %check = %$checktmp;
#    print "looking for \"$check{string}\"\n";
#    print "  with log message \"$check{message}\"\n";
#    print "  check this regexp: $check{check}\n";
#    print "  stop if found: $check{stop}\n";
#}

print "<html>\n";
print "<head>\n";
print "<title>Build log analysis</title>\n";
print "</head>\n";
print "<body>\n";
print "<h1>Build log analysis</h1>\n";
print "<p><a href=\"#summary\">Summary</a></p>\n";
print "<h2>Packages</h2>\n";
print "<ol>\n";

my $line;

our($opt_u);
getopts('u:') or die "getopts failure\n";

if (defined $opt_u) {
    open (UDD, "< $opt_u") or die "Can't open UDD list file $opt_u for reading\n";
    while (defined ($line = <UDD>)) {
	chomp $line;
	my ($pkg, $bugno, $bugsubj) = split (/ /, $line, 3);
	my @buglist;
	my $tmp = $udd{"$pkg"};
	if ($tmp) {
	    @buglist = @$tmp;
	}
	push (@buglist, "$bugno: $bugsubj");
	$udd{"$pkg"} = \@buglist;
    }
    close UDD;

#    foreach my $key (keys %udd) {
#	my $tmp = $udd{$key};
#	my $num = scalar (@$tmp);
#	print "$key has $num bugs:\n";
#	foreach my $entry (@$tmp) {
#	    print "  $entry\n";
#	}
#    }
}

sub check_buildd_status {
    my $pkg = shift;
    my $version = shift;
    my $arch = shift;

    my $url = "$buildd_base_url$pkg";

#    print "Looking at URL $url\n";

    my $built_on_arches = "";
    my $built_my_arch = 0;
    my $ftbfs_my_arch = 0;
    my $not_my_arch = 0;
    my $current_version = "";

#    print "Checking buildd data for package $pkg, arch $arch\n";

    my $response = HTTP::Tiny->new->get($url);

    if ($response->{success}) {
#	print "$response->{status} $response->{reason}\n";
	my $content = $response->{content};
#	print "$content\n";

	# Split the content up into lines
	my @lines = split("\n", $content);

	# Now look for two things:
	# 1. how many arches have built this package?
	# 2. has *our* arch built it?
#	print "we tried $version on arch $arch\n";
	foreach my $line (@lines) {
	    chomp $line;
	    $line = uri_decode($line);
	    if ($line =~ /https:\/\/buildd.debian.org\/stats\/graph/) {
		my @info = split (/<\/td>/, $line);
		# Grab the info from our fields
		my $this_arch = "";
		if ($info[0] =~ /architecture.php\?a=([^&]*)&amp/) {
		    $this_arch = $1;
#		    print "Found entry for arch $this_arch\n";
		} else {
		    print "  <li>FAILED TO PARSE $url\n";
		}
		$current_version = $info[1];
		$current_version =~ s/^<td>//;
#		print "current_version for $this_arch is $current_version, we tried $version\n";
		my $status = "";
		if ($info[2] =~ /class="status status-([a-z]*)/) {
		    $status = $1;
#		    print "Found status $status\n";
		} else {
		    print "  <li>FAILED TO PARSE $url\n";
		}
#		foreach my $field(@info) {
#		    print "$field\n";
#		}
#		print "  On $this_arch we have version $current_version, status $status\n";
		if ($arch =~ /^\Q$this_arch\E$/) {
		    if ($status =~ /installed/) {
			$built_my_arch++;
		    } else {
			$ftbfs_my_arch++;
		    }
		}
		if ($status =~ /installed/) {
		    $built_on_arches .= "$this_arch ";
		}
	    }

	    if ($line =~ /$arch is not present in the architecture list set by the maintainer/) {
		$not_my_arch++;
	    }
	    if ($line =~ /No entry in $arch database/) {
		$not_my_arch++;
	    }
	}
	print "  <li>Built on this arch: $built_my_arch\n";
	print "  <li>Built on arches: $built_on_arches\n";
	if ($not_my_arch) {
	    print "  <li>Not set to build on $arch\n";
	}
	if ($ftbfs_my_arch) {
	    print "  <li>Already seen to FTBFS on $arch\n";
	}
	if (length($current_version) < 2) {
	    print "  <li>No current version found - has this been removed?\n";
	} elsif (! ($current_version =~ /\Q$version\E/)) {
	    print "  <li><strong>New version $current_version available - retry?</strong>\n";
	}
    } else {
	print "  <LI>FAILED TO RETRIEVE buildd URL $url\n";
    }
}
    

foreach my $input (@ARGV) {
    open (IN, "< $input") or die "Can't read $input: $!\n";
    $num_fail++;
    my $stop = 0;
    my $lineno = 0;
    my $errors = 0;
    my $errors_need_analysis = 0;
    my $oldline = "";
    my %file_results;
    my $pav;
    my $pkg;
    my $arch;
    my $version;

    $pav = $input;
    $pav =~ s,^.*/,,g;
    $pav =~ s,\.log,,g;
    ($pkg, $version, $arch) = split (/_/, $pav);

    print "<li>Looking at <a href=\"$input\">$pkg version $version on arch $arch</a>:\n";
    print "<ul>\n";
    while (defined ($line = <IN>) and !$stop) {
	$lineno++;
	$lines_read++;
	foreach my $checktmp (@logcheck) {
	    my %check = %$checktmp;
	    if ($check{check}) {
		if (!$stop
		    and ($line =~ m/$check{string}/)
		    and (!$check{pstring} or $oldline =~ m/$check{pstring}/)) {
#		    print "  Line $lineno: found \"$check{string}\"\n";
		    my $match = $1;
		    my $message = $check{message};
		    $message =~ s,RESULT,$match,g;
		    $file_results{$message} = $check{type};
		    if (($check{type} == ERR_BUILD_TIMEOUT) and ($errors == 0)) {
			print "  <li>Line $lineno: $message\n";
			print "  <li>Build killed by timeout before any errors at line $lineno\n";
		    } else {
			print "  <li>Line $lineno: $message\n";
			$errors++;
		    }
		    if ($check{analyze}) {
			$errors_need_analysis++;
		    }
		    if ($check{stop}) {
#			print "  stopping processing\n";
			$stop = 1;
		    }
		}
	    }
	}
	$oldline = $line;
    }
    close IN;
    # End of checking this package
    print "  <li><strong>Found errors: $errors</strong>\n";
    if (!$errors) {
	print " (maybe just timed out during build?)\n";
    }

    # Look for a note for manually-added logfile analysis
    my $note = $input;
    $note =~ s,\.log$,.note,;
    if (-f $note) {
	open (IN, "< $note") or die "Can't open $note for reading: $!\n";
	while (defined (my $line = <IN>)) {
	    chomp $line;
	    if ($line =~ m,#(\d+),) {
		my $bugno = $1;
		$existing_bugs++;
		$line =~ s,#(\d+),<a href="https://bugs.debian.org/$1">#$1</a>,g;
	    }
	    print "  <li>$line\n";
	    if ($line =~ m,^Filed,) {
		$new_bugs_filed++;
		if ($line =~ m,-on-arm64,) {
		    if ($line =~ m,misdetected architecture,) {
			$new_bugs_arm64_misdetect++;
		    } elsif ($line =~ m,alignment,) {
			$new_bugs_arm64_alignment++;
		    } elsif ($line =~ m,test,) {
			$new_bugs_arm64_test_fail++;
		    } else {
			$new_bugs_arm64_other++;
		    }
		} else {
		    $new_bugs_arch_any++;
		}
	    }
	}
	close IN;
    } else {
	if ($errors_need_analysis) {
	    print "  <li><strong>Needs analysis</strong>\n";
	    if ($udd{$pkg}) {
		my $tmp = $udd{$pkg};
		my $num = scalar (@$tmp);
		print "  <li>$num reported FTBFS bugs:\n";
		print "  <ul>\n";
		foreach my $entry (@$tmp) {
		    print "    <li>#$entry\n";
		}
		print "  </ul>\n";
	    }
	    check_buildd_status($pkg, $version, $arch);
	    $awaiting_analysis++;
	}
    }

    print "</ul>\n";
    foreach my $key (keys %file_results) {
	$log_results{$file_results{$key}}{$key} += 1;
#	print "now have $log_results{$key} for \"$key\"\n";
    }
}
print "</ol>\n";

print "<a name=\"summary\"</a>\n";
print "<h2>Summary of results from $num_fail failed builds:</h2>\n";
print "<p>$awaiting_analysis logs still need analysis</p>\n";
print "<ul>\n";
print "  <li>Linked to $existing_bugs bugs in the Debian BTS</li>\n";
foreach my $type (sort keys %log_results) {
    print "  <h3>$err_descriptions[$type]</h3>\n";
    my $tmp = $log_results{$type};
    my %result = %$tmp;
    foreach my $key (sort { $result{$b} <=> $result{$a} }keys %result) {
	print "  <li>Found $result{$key} log(s) showing $key\n";
    }
}
print "</ul>\n";

print "<h2>Filed $new_bugs_filed new bugs</h2>\n";
print "<ul>\n";
print "  <li>$new_bugs_arm64_misdetect bugs for arch misdetection\n";
print "  <li>$new_bugs_arm64_alignment bugs for alignment problems\n";
print "  <li>$new_bugs_arm64_test_fail bugs for arch-specific test failures\n";
print "  <li>$new_bugs_arm64_other bugs for arch-specific misc failures\n";
print "  <li>$new_bugs_arch_any bugs for general arch-independent FTBFS\n";
print "</ul>\n";

$time_end = time();
$time_taken = $time_end - $time_start;
$date = strftime "%a %b %e %H:%M:%S %Z %Y", localtime;
$hostname = `hostname`;
chomp $hostname;

print "<hr>\n";
print "<p>Log analysis generated on $hostname, $date.\n";
print "<br>Output from $name - see <a href=\"$repo\">$repo</a> for source.\n";
print "<br>Read $lines_read lines of logs and took $time_taken seconds to complete.\n";

print "</body>\n";
print "</html>\n";