Initial commit

Signed-off-by: Florian Pritz <bluewind@xinu.at>

4 files changed, 195 insertions, 0 deletions

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..439d006
--- /dev/null
+++ b/README.md
@@ -0,0 +1,3 @@
+# Arch Mirror Tools
+
+This repo contains some tools that make the life easier for Arch Linux staff maintaining the official mirror list.
diff --git a/bin/generate-mirror-mail.pl b/bin/generate-mirror-mail.pl
new file mode 100755
index 0000000..5249752
--- /dev/null
+++ b/bin/generate-mirror-mail.pl
@@ -0,0 +1,151 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use JSON;
+use WWW::Mechanize;
+use Date::Parse;
+use Date::Format;
+use Text::Template;
+use Try::Tiny;
+
+use Data::Dumper;
+
+#$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 {$last_sync}, could you please
+investigate?
+
+{$mirror_urls}
+
+Thanks,
+Florian
+',
+	},
+	'connection-failed' => {
+		'subject' => '[{$mirror_name}] Arch Linux mirror not accessible{$OUT = ", ".join("/", @affected_protocols) if @affected_protocols > 0;}',
+		'template' => 'Hi,
+
+We\'re having trouble connecting to your mirror{$OUT = " via ".join(", ", @affected_protocols) if @affected_protocols > 0;}, could you
+please check what\'s going on?
+
+{$mirror_urls}
+
+Thanks,
+Florian
+',
+	},
+);
+
+my $mech = WWW::Mechanize->new(cookie_jar => {});
+
+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";
+	print $fh "From: bluewind\@archlinux.org\n";
+	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;
+}
+
+while (<>) {
+	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/";
+
+		$mech->get($url."/json/");
+		my ($mirror_name) = ($url =~ m#/([^/]+)/?$#);
+		my $json = JSON::decode_json($mech->content());
+
+		my @out_of_sync;
+		my @connection_failed;
+
+		for my $mirror (@{$json->{urls}}) {
+			if ($mirror->{last_sync}) {
+				my $time = str2time($mirror->{last_sync});
+				if ($time < time() - 60*60*24*3) {
+					push @out_of_sync, {
+						time => $time,
+						url => $mirror->{url},
+						details_link => "", # TODO
+					};
+				}
+			} else {
+			#if ($mirror->{last_sync} and $mirror->{completion_pct} < 0.9 and $mirror->{completion_pct} > 0) {
+				push @connection_failed, {
+					url => $mirror->{url},
+					details_link => "", # TODO
+					protocol => $mirror->{protocol},
+				};
+			}
+		}
+
+		# extract and deduplicate sync times
+		my @last_sync = keys %{{ map { ${$_}{time} => 1 } @out_of_sync }};
+		my $sent_mail = 0;
+
+		# TODO: set $to
+		my $to = '';
+
+		if (@out_of_sync) {
+			my %values = (
+					last_sync => join(", ", map {time2str("%Y-%m-%d", $_)} @last_sync),
+					mirror_urls => join("\n", $url, map {${$_}{details_link}} @out_of_sync),
+					mirror_name => $mirror_name,
+				);
+			send_template_mail($to, $templates{"out-of-sync"}{"subject"}, $templates{"out-of-sync"}{"template"}, \%values);
+			$sent_mail = 1;
+		}
+
+		if (@connection_failed) {
+			my %values = (
+					mirror_urls => join("\n", $url, map {${$_}{details_link}} @connection_failed),
+					mirror_name => $mirror_name,
+				);
+
+			my @protocols = map {${$_}{protocol}} @connection_failed;
+			if (scalar(@protocols) != scalar(@{$json->{urls}})) {
+				$values{affected_protocols} = \@protocols;
+			}
+
+			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: $_";
+	}
+}
diff --git a/bin/mirror-stats.pl b/bin/mirror-stats.pl
new file mode 100755
index 0000000..601a4cc
--- /dev/null
+++ b/bin/mirror-stats.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use JSON;
+use WWW::Mechanize;
+use Data::Dumper;
+
+my $m = WWW::Mechanize->new();
+
+#$m->get("https://www.archlinux.org/mirrors/status/tier/1/json");
+$m->get("https://www.archlinux.org/mirrors/status/json");
+my $mirrors = decode_json($m->content());
+
+my %countries = ();
+
+for my $mirror (@{$mirrors->{urls}}) {
+	$countries{$mirror->{country_code}}++;
+}
+
+my @sorted_countries = sort {$countries{$a} <=> $countries{$b}} keys %countries;
+
+for my $key (@sorted_countries) {
+	my $value = $countries{$key};
+	print "$key: $value\n";
+}
diff --git a/bin/update-mirrorlist-pkg b/bin/update-mirrorlist-pkg
new file mode 100755
index 0000000..9fbeeb3
--- /dev/null
+++ b/bin/update-mirrorlist-pkg
@@ -0,0 +1,16 @@
+#!/bin/bash
+
+set -e
+
+cd ~/arch/extra/pacman-mirrorlist/
+svn up
+cd trunk
+
+upgpkg a
+svn diff mirrorlist | pygmentize
+printf "confirm update (enter)"
+read
+ch build 64
+
+corepkg "upstream update"
+ssh repos.archlinux.org /packages/db-update