by default allow only ftp mirrors, and try mirror.ctan.org 5 times

for a proper mirror. If then there is still no success, fall back to
one of the backbone nodes.
Add support for command line option -allow-ftp in install-tl and tlmgr
all support for setting allow-ftp = 1 permanently in tlmgr config file


git-svn-id: svn://tug.org/texlive/trunk@18431 c570f23f-e606-0410-a88d-b1316a301751

3 files changed, 114 insertions, 13 deletions

diff --git a/Master/install-tl b/Master/install-tl
index 4c21bbea15f..9efa22d2868 100755
--- a/Master/install-tl
+++ b/Master/install-tl
@@ -159,6 +159,7 @@ my $opt_custom_bin;
 my $opt_version = 0;
 my $opt_force_arch;
 my $opt_persistent_downloads = 1;
+my $opt_allow_ftp = 0;
 
 # show all options even those not relevant for that arch
 $::opt_all_options = 0;
@@ -213,6 +214,7 @@ GetOptions(
            "scheme=s"       => \$opt_scheme,
            "all-options"    => \$::opt_all_options,
            "persistent-downloads!"      => \$opt_persistent_downloads,
+           "allow-ftp!"     => \$opt_allow_ftp,
            "version"        => \$opt_version,
            "help|?"         => \$opt_help) or pod2usage(1);
 
@@ -373,9 +375,9 @@ $location || ($location = "$::installerdir");
 if ($location =~ m!^(ctan$|(http|ftp)://)!i) {
   $location =~ s,/(tlpkg|archive)?/*$,,;  # remove any trailing tlpkg or /
   if ($location =~ m/^ctan$/i) {
-    $location = TeXLive::TLUtils::give_ctan_mirror();
+    $location = TeXLive::TLUtils::give_ctan_mirror('-allow-ftp' => $opt_allow_ftp);
   } elsif ($location =~ m/^$TeXLiveServerURL/) {
-    my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base();
+    my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base('-allow-ftp' => $opt_allow_ftp);
     $location =~ s,^($TeXLiveServerURL|ctan$),$mirrorbase,;
   }
   $TeXLiveURL = $location;
@@ -405,7 +407,7 @@ if ($location =~ m!^(ctan$|(http|ftp)://)!i) {
       die "$0: cannot find installation source at $opt_location.\n";
     }
     # no --location given, but NET installation
-    $TeXLiveURL = $location = TeXLive::TLUtils::give_ctan_mirror();
+    $TeXLiveURL = $location = TeXLive::TLUtils::give_ctan_mirror('-allow-ftp' => $opt_allow_ftp);
     $media = 'NET';
   }
 }
@@ -2025,6 +2027,13 @@ fall back to using wget if this is not possible. If you want to disable
 usage of LWP and persistent connections, please use
 B<--no-persistent-downloads>.
 
+=item B<-allow-ftp>
+
+By default if mirror.ctan.org is contacted only http mirrors are accepted.
+Adding this command line switch allows ftp mirrors of the CTAN nodes.
+
+If you set a ftp mirror explicitely, that one is in any case used.
+
 =item B<-debug-translation>
 
 In GUI mode, this switch makes C<tlmgr> report any missing, or more
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 4765b15d77e..4f1b91fdaa6 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -95,6 +95,7 @@ our $tlmediatlpdb;
 our $location;     # location from which the new packages come
 our $localtlmedia; # local installation which we are munging
 our $localtlpdb;   # local installation which we are munging
+our @allow_ftp_args;
 
 # flags for machine-readable form
 our $FLAG_REMOVE = "d";
@@ -126,6 +127,7 @@ sub main {
     "machine-readable" => 1,
     "package-logfile" => "=s",
     "persistent-downloads" => "!",
+    "allow-ftp" => "!",
     "pause" => 1,
     "version" => 1,
     "help|h|?" => 1);
@@ -353,6 +355,26 @@ sub main {
       if $do_persistent;
   }
 
+  #
+  # check for allowing ftp connections in the tlmgr config file and
+  # command line
+  {
+    my $do_ftp;
+    if (defined($opts{'allow-ftp'})) {
+      $do_ftp = ($opts{'allow-ftp'} ? 1 : 0);
+    } else {
+      if (defined($config{'allow-ftp'})) {
+        $do_ftp = $config{'allow-ftp'};
+      }
+    }
+    # default is not to allow ftp mirrors
+    if (!defined($do_ftp)) {
+      $do_ftp = 0;
+    }
+    debug("are ftp mirrors are allowed: $do_ftp\n");
+    push @allow_ftp_args, '-allow-ftp', $do_ftp;
+  }
+
   execute_action($action, @ARGV);
 
   # end of main program.
@@ -440,7 +462,7 @@ sub execute_action {
     }
     finish(0);
   } elsif ($action =~ m/^get-mirror$/i) {
-    my $loc = give_ctan_mirror();
+    my $loc = give_ctan_mirror(@allow_ftp_args);
     print "$loc\n";
     finish(0);
   } elsif ($action =~ m/^generate$/i) {
@@ -4174,9 +4196,9 @@ sub init_tlmedia
 
   # choose a mirror if we are asked.
   if ($location =~ m/^ctan$/i) {
-    $location = give_ctan_mirror();
+    $location = give_ctan_mirror(@allow_ftp_args);
   } elsif ($location =~ m,^$TeXLiveServerURL,) {
-    my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base();
+    my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(@allow_ftp_args);
     $location =~ s,^$TeXLiveServerURL,$mirrorbase,;
   }
 
@@ -4392,7 +4414,13 @@ sub load_config_file
           if (($val eq "0") || ($val eq "1")) {
             $config{'persistent-downloads'} = $val;
           } else {
-            tlwarn("Unknown value $val for persistent_download in $fn\n");
+            tlwarn("Unknown value $val for persistent-downloads in $fn\n");
+          }
+        } elsif ($key eq "allow-ftp") {
+          if (($val eq "0") || ($val eq "1")) {
+            $config{'allow-ftp'} = $val;
+          } else {
+            tlwarn("Unknown value $val for allow-ftp in $fn\n");
           }
         } else {
           tlwarn("Unknown key $key in $fn\n");
@@ -4708,6 +4736,16 @@ fall back to using wget if this is not possible. If you want to disable
 usage of LWP and persistent connections, please use
 B<--no-persistent-downloads>.
 
+=item B<-allow-ftp>
+
+By default if mirror.ctan.org is contacted only http mirrors are accepted.
+Adding this command line switch allows ftp mirrors of the CTAN nodes.
+
+If you set a ftp mirror explicitely, that one is in any case used.
+
+You can permanently turn this option on in the tlmgr config file, see
+L<CONFIGURATION FILE> below for details.
+
 =item B<--debug-translation>
 
 In GUI mode, this switch makes C<tlmgr> report any missing, or more
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index f2504f62d5c..96b801ee46e 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -3086,6 +3086,12 @@ Return the specific mirror chosen from the generic CTAN auto-redirecting
 default (specified in L<$TLConfig::TexLiveServerURL>) if possible, else
 the default url again.
 
+By default these functions only return http mirrors. If after several
+trials of contacting mirror.ctan.org still no http mirror is found,
+one of the three backbone nodes are choosen by chance.
+
+If ftp mirrors should be allowed pass in C<'-allow-ftp' => 1> as arguments.
+
 Neither C<TL_DOWNLOAD_PROGRAM> nor <TL_DOWNLOAD_ARGS> is honored (see
 L<download_file>), since certain options have to be set to do the job
 and the program has to be C<wget> since we parse the output.
@@ -3096,7 +3102,7 @@ TeX Live net distribution on the respective mirror.
 
 =cut
 
-sub give_ctan_mirror_base
+sub query_ctan_mirror
 {
   my $wget = $::progs{'wget'};
   if (!defined ($wget)) {
@@ -3114,17 +3120,65 @@ sub give_ctan_mirror_base
   foreach (@out) {
     if (m/^Location: (\S*)\s*.*$/) {
       (my $mhost = $1) =~ s,/*$,,;  # remove trailing slashes since we add it
-      $mirror = "$mhost";
-      last;
+      return $mhost;
     }
   }
-  # if we cannot find a mirror, return the default again.
-  return $mirror;
+  return;
+}
+  
+sub give_ctan_mirror_base
+{
+  my %args = @_;
+  my $allow_ftp = 0;
+  if (defined($args{'-allow-ftp'}) && $args{'-allow-ftp'}) {
+    $allow_ftp = 1;
+  }
+
+  #
+  # we do want to have http mirrors, so try to query ctan mirror,
+  # and if it returns an ftp mirror, retry at max 3 times in total,
+  # after that fall back to one of the backbone nodes.
+  #
+  # the set of backbone address we are falling bacl
+  my @backbone = qw!http://www.ctan.org/tex-archive
+                    http://www.tex.ac.uk/tex-archive
+                    http://dante.ctan.org/tex-archive!;
+  my $max_mirror_trial = 5;
+
+  my $try = 1;
+  my $found = 0;
+
+  my $mirror;
+  while (!$found && ($try <= $max_mirror_trial)) {
+    my $m = query_ctan_mirror();
+    debug("querying mirror, got " . (defined($m) ? $m : "(nothing)") . "\n");
+    if (defined($m)) {
+      if ($allow_ftp) {
+        # everything is allowed, take it
+        $mirror = $m;
+        $found = 1;
+      } else {
+        # if ftp mirrors are not allowed, check for http start
+        if ($m =~ m!^http://!) {
+          $mirror = $m;
+          $found = 1;
+        }
+      }
+    }
+    # sleep Nsecs to make mirror happy, but only if we are not ready to return
+    $try++;
+    sleep(1) if (!$found && ($try <= $max_mirror_trial));
+  }
+  if (!$mirror) {
+    debug("no mirror found ... randomly selecting backbone\n");
+  }
+  # no http mirror found, so return one of the backbone
+  return ($mirror ? $mirror : $backbone[int(rand($#backbone + 1))]);
 }
 
 sub give_ctan_mirror
 {
-  return (give_ctan_mirror_base() . "/$TeXLiveServerPath");
+  return (give_ctan_mirror_base(@_) . "/$TeXLiveServerPath");
 }
 
 sub tlmd5 {