diff options
-rwxr-xr-x | Master/install-tl | 14 | ||||
-rwxr-xr-x | Master/texmf/scripts/texlive/tlmgr.pl | 50 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 119 |
3 files changed, 89 insertions, 94 deletions
diff --git a/Master/install-tl b/Master/install-tl index 9efa22d2868..8c802f1bdc6 100755 --- a/Master/install-tl +++ b/Master/install-tl @@ -214,7 +214,6 @@ 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); @@ -375,9 +374,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('-allow-ftp' => $opt_allow_ftp); + $location = TeXLive::TLUtils::give_ctan_mirror(); } elsif ($location =~ m/^$TeXLiveServerURL/) { - my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base('-allow-ftp' => $opt_allow_ftp); + my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(); $location =~ s,^($TeXLiveServerURL|ctan$),$mirrorbase,; } $TeXLiveURL = $location; @@ -407,7 +406,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('-allow-ftp' => $opt_allow_ftp); + $TeXLiveURL = $location = TeXLive::TLUtils::give_ctan_mirror(); $media = 'NET'; } } @@ -2027,13 +2026,6 @@ 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 1615cd38038..4ffb20675bc 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -95,7 +95,6 @@ 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"; @@ -127,7 +126,6 @@ sub main { "machine-readable" => 1, "package-logfile" => "=s", "persistent-downloads" => "!", - "allow-ftp" => "!", "pause" => 1, "version" => 1, "help|h|?" => 1); @@ -355,26 +353,6 @@ 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. @@ -462,7 +440,7 @@ sub execute_action { } finish(0); } elsif ($action =~ m/^get-mirror$/i) { - my $loc = give_ctan_mirror(@allow_ftp_args); + my $loc = give_ctan_mirror(); print "$loc\n"; finish(0); } elsif ($action =~ m/^generate$/i) { @@ -4196,9 +4174,9 @@ sub init_tlmedia # choose a mirror if we are asked. if ($location =~ m/^ctan$/i) { - $location = give_ctan_mirror(@allow_ftp_args); + $location = give_ctan_mirror(); } elsif ($location =~ m,^$TeXLiveServerURL,) { - my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(@allow_ftp_args); + my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(); $location =~ s,^$TeXLiveServerURL,$mirrorbase,; } @@ -4416,12 +4394,6 @@ sub load_config_file } else { 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"); } @@ -4736,16 +4708,6 @@ 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 @@ -5566,9 +5528,9 @@ All other lines must look like key = value -where the allowed keys are C<gui_expertmode>, C<persistent-downloads>, and -C<allow-ftp>. The values can only be 0 or 1 for those settings. -C<persistent-downloads> and C<allow-ftp> correspond to the respective +where the allowed keys are C<gui_expertmode> and C<persistent-downloads>. +The values can only be 0 or 1 for those settings. +C<persistent-downloads> corresponds to the respective command line options of C<tlmgr>. C<gui_expertmode> switches between the full GUI and a simplified with only the important and mostly used settings. diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 7f0cc0f1c96..b2a8108cce2 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -3121,67 +3121,108 @@ sub query_ctan_mirror my $mirror = $TeXLiveServerURL; my $cmd = "$wget $mirror --timeout=60 -O " . (win32() ? "nul" : "/dev/null") . " 2>&1"; - my @out = `$cmd`; - # analyze the output for the mirror actually selected. - foreach (@out) { - if (m/^Location: (\S*)\s*.*$/) { - (my $mhost = $1) =~ s,/*$,,; # remove trailing slashes since we add it - return $mhost; + # + # we try 3 times to get a mirror from mirror.ctan.org in case it is + # not working + my $max_trial = 3; + my $i = 1; + my $mhost; + while ($i <= 3) { + my @out = `$cmd`; + # analyze the output for the mirror actually selected. + foreach (@out) { + if (m/^Location: (\S*)\s*.*$/) { + (my $mhost = $1) =~ s,/*$,,; # remove trailing slashes since we add it + return $mhost; + } } + $i++; + sleep(1); } + # we are still here, so three times we didn't get a mirror, give up + # and return undefined return; } -sub give_ctan_mirror_base +# check if the mirror is working +sub check_on_working_mirror { - my %args = @_; - my $allow_ftp = 0; - if (defined($args{'-allow-ftp'}) && $args{'-allow-ftp'}) { - $allow_ftp = 1; - } + my $mirror = shift; + my $wget = $::progs{'wget'}; + if (!defined ($wget)) { + tlwarn ("give_ctan_mirror: Programs not set up, trying wget\n"); + $wget = "wget"; + } # - # 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 test is currently not completely correct, because we do not + # use the LWP if it is set up for it, but I am currently to lazy + # to program it + # so try wget and only check for the return value + # please KEEP the / after $mirror, some ftp mirrors do give back + # an error if the / is missing after ../CTAN/ + my $cmd = "$wget $mirror/ --timeout=60 -O " + . (win32() ? "nul" : "/dev/null") + . " 2>" . (win32() ? "nul" : "/dev/null"); + my $ret = system($cmd); + # if return value is not zero it is a failure, so switch the meanings + return ($ret ? 0 : 1); +} + +sub give_ctan_mirror_base +{ # - # the set of backbone address we are falling bacl + # operation: + # 1. get a mirror (this retries 3 times to contact mirror.ctan.org) + # - if no mirror has been given, use one of the backbone servers + # - if it is an http server return it (no test!) + # - if it is a ftp server, continue below + # 2. if the ftp mirror is good, return it + # 3. if the ftp mirror is bad, search for http mirror (5 times) + # 4. if http mirror is found, return it (no test!) + # 5. if no http mirror is found return one of the backbone servers + 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; + # start by selecting a mirror and test its operationality + my $mirror = query_ctan_mirror(); + if (!defined($mirror)) { + # three times calling mirror.ctan.org did not give anything useful, + # return one of the backbone servers + tlwarn("cannot contact mirror.ctan.org, returning a backbone server!\n"); + return $backbone[int(rand($#backbone + 1))]; + } - my $mirror; - while (!$found && ($try <= $max_mirror_trial)) { + if ($mirror =~ m!^http://!) { + return $mirror; + } + + # we are still here, so we got a ftp mirror from mirror.ctan.org + if (check_on_working_mirror($mirror)) { + return $mirror; + } + # we are still here, so the ftp mirror failed, retry to find an http one + my $max_mirror_trial = 5; + my $try = 1; + while ($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; - } - } + if (defined($m) && $m =~ m!^http://!) { + return $m; } # 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"); + sleep(1) if ($try <= $max_mirror_trial); } - # no http mirror found, so return one of the backbone - return ($mirror ? $mirror : $backbone[int(rand($#backbone + 1))]); + # 5 times contacting the mirror service did not return a http server, + # use one of the backbone servers + debug("no mirror found ... randomly selecting backbone\n"); + return $backbone[int(rand($#backbone + 1))]; } + sub give_ctan_mirror { return (give_ctan_mirror_base(@_) . "/$TeXLiveServerPath"); |