1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
#!/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]+(\/|$)/;
$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 {
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: $_";
}
}
|
