texlive[54581] Master/tlpkg: tl-update-ctan-mirrors: rewrite to avoid
commits+karl at tug.org
commits+karl at tug.org
Fri Mar 27 19:01:15 CET 2020
Revision: 54581
http://tug.org/svn/texlive?view=revision&revision=54581
Author: karl
Date: 2020-03-27 19:01:15 +0100 (Fri, 27 Mar 2020)
Log Message:
-----------
tl-update-ctan-mirrors: rewrite to avoid losing last entry; add -v option; update mirror list
Modified Paths:
--------------
trunk/Master/tlpkg/bin/tl-update-ctan-mirrors
trunk/Master/tlpkg/installer/ctan-mirrors.pl
Modified: trunk/Master/tlpkg/bin/tl-update-ctan-mirrors
===================================================================
--- trunk/Master/tlpkg/bin/tl-update-ctan-mirrors 2020-03-27 00:40:00 UTC (rev 54580)
+++ trunk/Master/tlpkg/bin/tl-update-ctan-mirrors 2020-03-27 18:01:15 UTC (rev 54581)
@@ -1,12 +1,12 @@
#!/usr/bin/env perl
# $Id$
-# Copyright 2011-2018 Norbert Preining
+# Copyright 2011-2020 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)
+# http://ctan.org/mirrors (aka CTAN.sites and README.mirrors)
# rsync://comedy.dante.de/MirMon/mirmon.state
use strict;
@@ -13,13 +13,22 @@
$^W = 1;
use Data::Dumper;
+my $prg;
+my $verbose = 0;
+
exit (&main ());
sub main {
- if (@ARGV != 2) {
- die "Usage: $0 CTAN_SITES MIRMON_STATE.\n";
+ if (@ARGV != 2 && @ARGV != 3) {
+ die "Usage: $0 [-v] CTAN_SITES MIRMON_STATE.\n";
}
-
+ ($prg = $0) =~ s,^.*/,,;
+
+ if ($ARGV[0] eq "-v") {
+ $verbose = 1;
+ shift @ARGV;
+ }
+
my %good_urls = read_mstate($ARGV[1]);
my %ctan_sites = read_readme_mirror($ARGV[0], \%good_urls);
$Data::Dumper::Indent = 1;
@@ -43,7 +52,9 @@
= split (' ');
if ($status_last_probe eq "ok") {
$good_urls{$m} = 1;
+ #warn "probe ok $m\n";
} else {
+ #warn "probe not ok $m\n";
$good_urls{$m} = 0;
}
}
@@ -59,51 +70,35 @@
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";
+
+ my ($continent,$country,$mirror);
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/^ (Africa|Asia|Oceania|Europe|North America|South America)/) {
+ $continent = $1;
+ warn "got continent $continent\n" if $verbose;
+
+ } elsif (m/^ ([-a-zA-Z0-9.]+) \((.*)\)\s*$/) {
+ $mirror = $1;
+ $country = $2;
+ # make many names a little shorter
+ $country =~ s/^The //;
+ warn " got country $country, with mirror $mirror\n" if $verbose;
- 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);
+ } elsif (m!^ +URL: (ftp|https?|rsync)://([-a-zA-Z0-9.]+)/([-\w/]*)!) {
+ next if $1 eq "rsync"; # we can't use rsync, so skip
+ my $protocol = $1;
+ my $ppath = "$2/$3";
+ add_mirror(\%mirrors, $continent, $country, $mirror, $protocol, $ppath,
+ $good_urls_ref);
- if (m!^ URL: (ftp|https?|rsync)://([-a-zA-Z0-9.]+)/([-\w/]*)!) {
- $protocols{$1} = "$2/$3";
- next;
+ } else {
+ last if /^Please send updates/; # quite at final blurb
+ warn "$prg: ignored CTAN.sites url: $_\n" if /URL:/;
+ # some other kind of line, e.g., ==== or blank. Silently Ignore.
}
- #warn "ignored >>$_<<\n";
}
die "no ctan mirrors found in $ctan_sites" if keys %mirrors == 0;
@@ -110,21 +105,24 @@
return %mirrors;
}
-
+# Subroutine for read_readme_mirror.
+#
sub add_mirror {
my ($mirref,$continent,$country,$mirror,$p,$ppath,$good_urls_ref) = @_;
my $url = "$p://$ppath";
+ #warn "considering $url ($continent $country)";
+
if (exists $good_urls_ref->{$url}) {
if ($good_urls_ref->{$url}) {
- #$mirref->{$continent}{$country}{$mirror}{'protocols_path'}{$p} = $ppath;
$mirref->{$continent}{$country}{$url} = 1;
+ warn "ok: $url\n" if $verbose;
} else {
- printf STDERR "$0: mirror seems to be dead, skipped: $url\n";
+ warn "probe not ok, skipped: $url\n" if $verbose;
}
} 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";
+ # CTAN.sites has many more urls than mirmon, so don't worry about it.
+ warn "not in mirmon file, skipped: $url\n" if $verbose;
+ # Also the mirmon file has some old urls that aren't in CTAN.sites,
+ # so don't worry about that direction either, on occasion.
}
}
Modified: trunk/Master/tlpkg/installer/ctan-mirrors.pl
===================================================================
--- trunk/Master/tlpkg/installer/ctan-mirrors.pl 2020-03-27 00:40:00 UTC (rev 54580)
+++ trunk/Master/tlpkg/installer/ctan-mirrors.pl 2020-03-27 18:01:15 UTC (rev 54581)
@@ -166,6 +166,7 @@
},
'USA' => {
'http://ctan.math.illinois.edu/' => 1,
+ 'http://ctan.math.utah.edu/ctan/tex-archive/' => 1,
'http://ctan.math.washington.edu/tex-archive/' => 1,
'http://ctan.mirrors.hoobly.com/' => 1,
'http://mirror.las.iastate.edu/tex-archive/' => 1,
@@ -186,6 +187,9 @@
'South America' => {
'Brazil' => {
'http://linorg.usp.br/CTAN/' => 1
+ },
+ 'Chile' => {
+ 'http://ctan.dcc.uchile.cl/' => 1
}
}
};
More information about the tex-live-commits
mailing list.