#!/usr/bin/perl
#
# @author:	Ryan Steinmetz
# @desc:	Parse/process error logs from Jenkins, then mail the results to the MAINTAINERs
# @deps:	mail/p5-Email-Stuff www/p5-WWW-Mechanize devel/p5-Parallel-ForkManager lang/p5-Try-Tiny textproc/p5-Text-ASCIITable

use strict;
use warnings;
use Email::Stuff;
use File::Basename;
use File::Find;
use File::Path qw(remove_tree mkpath);
use File::Temp qw(tempdir);
use Parallel::ForkManager;
use Text::ASCIITable;
use Try::Tiny;
use WWW::Mechanize;

########## SETTINGS ##################
my $print_instead_of_email = 1; # print messages instead of emailing them
my $bcc = 'zi@FreeBSD.org'; # Always BCC this address (set to "" to disable)
my $to = 'zi@FreeBSD.org'; # send emails here when override_maintainer is enabled
my $override_maintainer = 1; # set to 1 to always send email to above address
my $from = 'FreeBSD Ports Builds <zi@FreeBSD.org>';
my $server = "localhost:25";
my $ssl = 0; # Use SSL for SMTP (for 465/tcp)
my $debug = 0; # debug processing
my $summary = 1; # print summary information
# NOTE: builds are <release>-<arch>
my @builds = ("head-amd64", "head-i386", "100-amd64", "100-i386", "92-amd64", "92-i386", "84-amd64"); #, "84-i386");
my $max_parallel = 10; # max parallel downloads
my $jenkins_url = "https://jenkins.freebsd.org/pci/";
# https://jenkins.freebsd.org/pci/${OSREL}-${OSARCH}/logs/bulk/${OSREL}${OSARCH}-default/${BUILDNUMBER}/logs/errors/
my $cleanup = 1; # delete logs after processing them
$ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;
######################################

my %errors;
my %error_files;
my $buildnum = shift;
my $dir;

$summary = 1 if ($debug);

if (!$buildnum) {
    	print "Usage: $0 <build_number>\n";
	exit(1);
} else {
     	$dir = File::Temp->newdir(CLEANUP => $cleanup);

	print "Using temporary directory: $dir\n" if $debug;
	{
		foreach (@builds) {
			my ($osrel, $osarch) = split(/-/, $_);
			getFailureLogs($jenkins_url . $_ . "/logs/bulk/" . ${osrel} . ${osarch} . "-default/" . $buildnum . "/logs/errors/", $dir . "/${osrel}/${osarch}/");
		}
	}

	find({ wanted => \&processErrorLog, no_chdir => 1 }, $dir);

	# build failure table and trigger email to maintainer
	foreach my $maintainer (keys %errors) {
		print "Failures for ${maintainer}:\n" if ($summary - $print_instead_of_email);
		my $t = Text::ASCIITable->new();
		$t->setCols("Port", "Build", "Error Log");

		while (my ($origin, $buildlist) = each %{ $errors{$maintainer} } ) {
			while (my ($build, $failurl) = each %{ $errors{$maintainer}{$origin} } ) {
				print " $origin - $build : ${failurl}\n" if ($summary - $print_instead_of_email);
				$t->addRow($origin, $build, $failurl);
			}
		}
		sendErrorLog($maintainer, $t);
	}
}

# iterate through error logs for $base_url and download the files to $target_dir
sub getFailureLogs {
	my ($base_url, $target_dir) = @_;
	mkpath($target_dir) if (! -d $target_dir);

	my $pm = Parallel::ForkManager->new($max_parallel);

	print "Getting error logs from $base_url\n" if $debug;

	try {
		my $mech = WWW::Mechanize->new(autocheck => 1, ssl_opts => { SSL_version => 'TLSv1'});
		$mech->get($base_url);
		my @links = $mech->find_all_links();

		foreach my $link (@links) {
			next if ($link->[1] eq "" || $link->[1] eq "../");

			my $newfile = $target_dir . $link->[1];
			my $newfile_url = $base_url . $link->[1];
			$error_files{$newfile} = $newfile_url;

			$pm->start and next;
			print " - " . $link->[1] . "\n" if $debug;
			$mech->get( $newfile_url, ':content_file' => $newfile );
			$pm->finish;
		}
	} catch {
		print " - Failed to download logs, skipping processing of $base_url\n";
	};

	$pm->wait_all_children;
}

# extract origin, maintainer, release, and arch from an error log
sub getFailureDetails {
  	my $errorlog = $_;
	my $maintainer = "";
	my $release = "";
	my $arch = "";
	my $origin = "";

	print "ERROR: Cannot read $errorlog\n" if (! -r $errorlog);
	return ("", "", "", "") if (! -r $errorlog);

	open(LOG, $errorlog);
	while(<LOG>) {
		chomp($_);
		# ====>> Building www/revive-adserver
		if ($_ =~ /^\S+ Building (\S+)$/) {
			$origin = $1;
	    	# building for: FreeBSD 92R-default 9.2-RELEASE FreeBSD 9.2-RELEASE amd64
		} elsif ($_ =~ /^building for: \S+ \S+ \S+ \S+ (\S+) (\S+)$/) {
			($release, $arch) = ($1, $2);
		# building for: FreeBSD headamd64-default-job-02 11.0-CURRENT FreeBSD 11.0-CURRENT r265336 amd64
		} elsif ($_ =~ /^building for: \S+ \S+ \S+ \S+ (\S+) \S+ (\S+)$/) {
			($release, $arch) = ($1, $2);
		# maintained by: zi@FreeBSD.org
		} elsif ($_ =~ /^maintained by: (\S+)$/) {
			$maintainer = $1;
			last;
		}
	}
	close(LOG);

	return ($maintainer, $release, $arch, $origin);
}

# given an error log, populate the %errors hash with error information
sub processErrorLog {
	my $errorfile = $_;
	my $maintainer = "";
	my $release = "";
	my $arch = "";
	my $origin = "";

	return if (! -f $errorfile || ! -r $errorfile);

	my ($filename, undef, $extension) = fileparse($errorfile, qr/\.[^.]*/);

	return if ($extension ne ".log");

	($maintainer, $release, $arch, $origin) = getFailureDetails($errorfile);

	if ($maintainer eq "" || $release eq "" || $arch eq "" || $origin eq "") {
		print "ERROR: Unable to find MAINTAINER, release, arch or origin for $errorfile\n";
		return;
	}

	print "Found $errorfile with a MAINTAINER of $maintainer on $release $arch\n" if $debug;

	$errors{$maintainer}{$origin}{$release . "-" . $arch} = $error_files{$errorfile};
}

# send a message to a maintainer, assuming override_maintainer is not enabled
sub sendErrorLog {
	my ($maintainer, $message) = @_;

	if (!$override_maintainer) {
		$to = $maintainer;
	}

	my $subject = "FreeBSD Port Build Failure Notification";
	my $body = "Dear port maintainer,\n\nThe FreeBSD Ports Build Infrastructure has detected a build failure for one or more of your ports.\nPlease take a moment to review the following and correct the problems:\n\n";
	$body .= $message;
	$body .= "\n\nThanks!\n";
	$body .= "--\n";
	$body .= "\nNotification sent to $maintainer as you are listed as the MAINTAINER for one or more ports in the FreeBSD Ports Tree\n";

	if ($print_instead_of_email) {
		print "\n-----------------------------------------------------\n";
		print "\n\nTo: $to\nFrom: $from\nSubject: $subject\n\n$body\n";
		print "-----------------------------------------------------\n";
		return;
	}

	try {
		my $mail = Email::Stuff->from($from);
		$mail->to($to)
		->subject($subject)
		->text_body($body);

		if ($bcc ne "") {
			$mail->bcc($bcc);
		}

		my $mailer = Email::Send->new({mailer => 'SMTP'});
		$mailer->mailer_args([Host => $server, ssl => $ssl]);
		$mail->send($mailer);
	} catch {
	    	print "Failed to send email to $maintainer, aborting...\n";
		exit(1);
	};

	print "Sent error logs for $maintainer to $to\n" if $summary;
}

# _EOF_