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.