summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLUtils.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm119
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");