summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2010-05-23 14:51:05 +0000
committerNorbert Preining <preining@logic.at>2010-05-23 14:51:05 +0000
commit01b299aa854d009a20e4fe28f5d21d878ee179cb (patch)
tree9ad8a7f6ba092767e521002f21895e6277b7c638 /Master/tlpkg/TeXLive
parenta2c049ad8325926e919ef9f2e1eca270288ad843 (diff)
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
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm66
1 files changed, 60 insertions, 6 deletions
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 {