diff options
author | Norbert Preining <preining@logic.at> | 2010-05-25 07:56:32 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-25 07:56:32 +0000 |
commit | c7e460b65829bcffdd2d3fb216735843753a1c61 (patch) | |
tree | 6f5280835f3fee4dda8ac0d446ef037358b3846b /Master/tlpkg | |
parent | f71682b1662ada1b4fcdaa74dfbeea91d7c74bc8 (diff) |
remove the -allow-ftp and implement automatic fallback to http
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
THe above als changes the way mirror.ctan.org is contacted. If it
fails at first time it automatically retries 3 times to get a mirror.
git-svn-id: svn://tug.org/texlive/trunk@18467 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg')
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 119 |
1 files changed, 80 insertions, 39 deletions
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"); |