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
|
#!/usr/bin/env perl
# $Id$
# Copyright 2011 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
# Write parsable list of active CTAN mirrors; run from tl-update-auto cron.
# Needed input:
# http://ctan.org/mirrors (CTAN.sites, README.mirrors)
# rsync://comedy.dante.de/MirMon/mirmon.state
use strict;
$^W = 1;
use Data::Dumper;
exit (&main ());
sub main {
if (@ARGV != 2) {
die "Usage: $0 CTAN_SITES MIRMON_STATE.\n";
}
my %good_urls = read_mstate($ARGV[1]);
my %ctan_sites = read_readme_mirror($ARGV[0], \%good_urls);
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1; # stable output
print Data::Dumper->Dump([\%ctan_sites], [qw(mirrors)]);
return 0;
}
#
# Return hash of good and bad urls from mirmon state data.
#
sub read_mstate {
my ($mstate) = @_;
my %good_urls;
open (MSTATE, "<$mstate") || die "$0: open($mstate) failed: $!\n";
while (<MSTATE>) {
my ($m, $age, $status_last_probe, $time_last_succesful_probe,
$probe_history, $state_history, $last_probe)
= split (' ');
if ($status_last_probe eq "ok") {
$good_urls{$m} = 1;
} else {
$good_urls{$m} = 0;
}
}
close(MSTATE);
die "no good urls found in ctan mirmon: $mstate" if keys %good_urls == 0;
return %good_urls;
}
#
# return hash of CTAN.sites info.
#
sub read_readme_mirror {
my ($ctan_sites,$good_urls_ref) = @_;
my %mirrors;
my ($continent, $country, $mirror, %protocols);
open (CTAN_SITES,"<$ctan_sites") || die "$0: open($ctan_sites) failed: $!\n";
while (<CTAN_SITES>) {
chomp;
if (m/^ (Africa|Asia|Oceania|Europe|North America|South America)/) {
my $save_continent = $1;
#warn "got continent $save_continent\n";
if (defined($mirror)) {
for my $p (keys %protocols) {
add_mirror(\%mirrors,$continent,$country,$mirror,$p,$protocols{$p},
$good_urls_ref);
}
}
$continent = $save_continent;
$mirror = undef;
$country = undef;
%protocols = ();
next;
}
next if ! defined $continent;
if (m/^ ([-a-zA-Z0-9.]+) \((.*)\)\s*$/) {
my $save_mirror = $1;
my $save_country = $2;
# make country names more reasonable
$save_country =~ s/^The //;
if (defined($mirror)) {
for my $p (keys %protocols) {
add_mirror(\%mirrors,$continent,$country,$mirror,$p,$protocols{$p},
$good_urls_ref);
}
}
$mirror = $save_mirror;
$country = $save_country;
%protocols = ();
next;
}
next if ! defined($mirror);
if (m!^ URL: (ftp|http|rsync)://([-a-zA-Z0-9.]+)/([-\w/]*)!) {
$protocols{$1} = "$2/$3";
next;
}
#warn "ignored >>$_<<\n";
}
die "no ctan mirrors found in $ctan_sites" if keys %mirrors == 0;
return %mirrors;
}
sub add_mirror {
my ($mirref,$continent,$country,$mirror,$p,$ppath,$good_urls_ref) = @_;
my $url = "$p://$ppath";
if (exists $good_urls_ref->{$url}) {
if ($good_urls_ref->{$url}) {
#$mirref->{$continent}{$country}{$mirror}{'protocols_path'}{$p} = $ppath;
$mirref->{$continent}{$country}{$url} = 1;
} else {
printf STDERR "$0: mirror seems to be dead, skipped: $url\n";
}
} else {
# CTAN people leave out ftp/rsync, and intentionally let the
# CTAN.sites file stay unchanged even when something is removed from
# mirmon, on occasion. So don't complain about it.
#printf STDERR "$0: mirror not in mirmon file, skipped: $url\n";
}
}
|
