path: root/bin/generate-mirror-mail.pl

#!/usr/bin/perl
use warnings;
use strict;

use Config::Tiny;
use Date::Format;
use Date::Parse;
use File::Basename;
use HTTP::Cookies;
use JSON;
use List::Util qw(uniq);
use Text::Template;
use Try::Tiny;
use WWW::Mechanize;

use Data::Dumper;

=head1 NAME

generate-mirror-mail.pl - Generate notification mails for broken mirrors

=head1 DESCRIPTION

Run the script and pass it URLs to the archweb mirror page (e.g.
<https://www.archlinux.org/mirrors/melbourneitmirror.net/>) via STDIN. If the
mirror has a problem the script will generate an appropriate mail and run
`compose-mail-from-stdin` which should be a script that starts your favourite
mail client with the mail. You can also let the script send the mail directly
if you do not want to review it.

=cut

# TODO: put this in a config file

#$ENV{HTTPS_CA_FILE}    = '/etc/ssl/certs/ca-certificates.crt';

my %templates = (
	'out-of-sync' => {
		'subject' => '[{$mirror_name}] Arch Linux mirror out of sync',
		'template' => 'Hi,

Your mirror seems to be out of sync since {$out_of_sync{last_sync}}, could you please
investigate?

{$mirror_url}
{$out_of_sync{mirror_urls}}

Thanks,
{$mail_from_name}
',
	},
	'connection-failed' => {
		'subject' => '[{$mirror_name}] Arch Linux mirror not accessible{$OUT = ", ".join("/", @{$connection_failed{protocols}}) if @{$connection_failed{protocols}} > 0;}',
		'template' => 'Hi,

We\'re having trouble connecting to and/or verifying the content of your mirror{$OUT = " via ".join(", ", @{$connection_failed{protocols}}) if @{$connection_failed{protocols}} > 0;}. Could you
please check what\'s going on?

{$mirror_url}
{$connection_failed{mirror_urls}}

Thanks,
{$mail_from_name}
',
	},
	'multiple-issues' => {
		'subject' => '[{$mirror_name}] Multiple issues with your Arch Linux mirror',
		'template' => 'Hi,

We are seeing multiple issues with your Arch Linux mirror {$mirror_name}
{$mirror_url}

 - We are unable to reach and/or verify the content of your mirror{$OUT = " via ".join(", ", @{$connection_failed{protocols}}) if @{$connection_failed{protocols}} > 0;}:
{$connection_failed{mirror_urls}}

 - Your mirror seems to be out of sync since {$out_of_sync{last_sync}}:
{$out_of_sync{mirror_urls}}

Could you please check what is wrong?

Thanks,
{$mail_from_name}
',
	},
);

my $Config = Config::Tiny->new();
$Config = Config::Tiny->read(dirname($0) . "/../settings.conf");

my $cookie_jar = HTTP::Cookies->new(file => dirname($0) . "/../cookie_jar", autosave => 1);
my $mech = WWW::Mechanize->new(agent => "arch-mirror-tools", cookie_jar => $cookie_jar);

sub login {
	$mech->get("https://www.archlinux.org/login/");
	my $res = $mech->submit_form(
		form_id => "dev-login-form",
		fields => {
			username => $Config->{account}->{username},
			password => $Config->{account}->{password}
		}
	);
}

sub send_mail {
	my $to = shift;
	my $subject = shift;
	my $body = shift;

	open my $fh, "|compose-mail-from-stdin" or die "Failed to run mailer: $!";
	print $fh "To: $to\n";
	printf $fh "From: %s\n", $Config->{misc}->{email_from};
	print $fh "Subject: $subject\n";
	print $fh "\n";
	print $fh "$body";
	close $fh;
}

sub send_template_mail {
	my $to = shift;
	my $subject = shift;
	my $body = shift;
	my $values = shift;

	send_mail($to, fill_template($subject, $values), fill_template($body, $values));
}

sub fill_template {
	my $template = shift;
	my $values = shift;
	my $result = Text::Template::fill_in_string($template, HASH => $values)
		or die "Failed to fill in template: $Text::Template::ERROR";

	return $result;
}

sub get_mirror_json {
	my ($url) = @_;

	$mech->get($url."/json/");
	return JSON::decode_json($mech->content());
}

while (<STDIN>) {
	try {
		my $url = $_;
		chomp($url);
		die "Skipping non-mirror detail URL" if $url =~ m/\/[0-9]+(\/|$)/;
		die "Skipping non-mirror detail URL" if $url eq "https://www.archlinux.org/mirrors/status/";

		my ($mirror_name) = ($url =~ m#/([^/]+)/?$#);
		my $json = get_mirror_json($url);

		if (not defined $json->{admin_email}) {
			login();
			$json = get_mirror_json($url);
			die "Admin email not set in mirror json. Login problem?" unless defined $json->{admin_email};
		}

		my $issues;

		for my $mirror (@{$json->{urls}}) {
			next if not $mirror->{active};
			if ($mirror->{last_sync}) {
				my $time = str2time($mirror->{last_sync});
				if ($time < time() - 60*60*24*3) {
					push @{$issues->{out_of_sync}}, {
						time => $time,
						url => $mirror->{url},
						details_link => $mirror->{details},
					};
				}
			} else {
			#if ($mirror->{last_sync} and $mirror->{completion_pct} < 0.9 and $mirror->{completion_pct} > 0) {
				push @{$issues->{connection_failed}}, {
					url => $mirror->{url},
					details_link => $mirror->{details},
					protocol => $mirror->{protocol},
				};
			}
		}

		# extract and deduplicate sync times
		my @last_sync = keys %{{ map { ${$_}{time} => 1 } @{$issues->{out_of_sync}} }};
		my $sent_mail = 0;

		my $to = $json->{admin_email};
		$to .= ",".$json->{alternate_email} if $json->{alternate_email} ne "";

		my %values = (
			out_of_sync => {
				last_sync => join(", ", map {time2str("%Y-%m-%d", $_)} @last_sync),
				mirror_urls => join("\n", map {${$_}{details_link}} @{$issues->{out_of_sync}}),
			},
			connection_failed => {
				mirror_urls => join("\n", map {${$_}{details_link}} @{$issues->{connection_failed}}),
			},
			mirror_name => $mirror_name,
			mirror_url => $url,
			mail_from_name => $Config->{misc}->{name} // die "misc.name not set in config",
		);

		my @protocols = uniq map {${$_}{protocol}} @{$issues->{connection_failed}};
		my @active_urls = grep { $_->{active} } @{$json->{urls}};
		if (scalar(@protocols) != scalar(@active_urls)) {
			$values{connection_failed}->{protocols} = \@protocols;
		}

		my $issue_type_count = grep {@{$issues->{$_}} > 0} keys %$issues;
		if ($issue_type_count > 1) {
			send_template_mail($to, $templates{"multiple-issues"}{"subject"}, $templates{"multiple-issues"}{"template"}, \%values);
			$sent_mail = 1;
		} elsif (@{$issues->{out_of_sync}}) {
			send_template_mail($to, $templates{"out-of-sync"}{"subject"}, $templates{"out-of-sync"}{"template"}, \%values);
			$sent_mail = 1;
		} elsif (@{$issues->{connection_failed}}) {
			send_template_mail($to, $templates{"connection-failed"}{"subject"}, $templates{"connection-failed"}{"template"}, \%values);
			$sent_mail = 1;
		}

		if (!$sent_mail) {
			say STDERR "No issue detected for mirror $mirror_name";
		}

	} catch {
		warn "ignoring error: $_";
	}
}