From 01b299aa854d009a20e4fe28f5d21d878ee179cb Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Sun, 23 May 2010 14:51:05 +0000 Subject: 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 --- Master/install-tl | 15 ++++++-- Master/texmf/scripts/texlive/tlmgr.pl | 46 +++++++++++++++++++++--- Master/tlpkg/TeXLive/TLUtils.pm | 66 +++++++++++++++++++++++++++++++---- 3 files changed, 114 insertions(+), 13 deletions(-) (limited to 'Master') 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 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 below for details. + =item B<--debug-translation> In GUI mode, this switch makes C 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 nor is honored (see L), since certain options have to be set to do the job and the program has to be C 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 { -- cgit v1.2.3