diff options
Diffstat (limited to 'Master/tlpkg')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 4 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 62 |
2 files changed, 62 insertions, 4 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index cfd5b2fa2fc..e884e91e914 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -279,7 +279,7 @@ sub from_file { my $is_verified = 0; # do media detection my $rootpath = $self->root; - if ($rootpath =~ m,https?://|ftp://,) { + if ($rootpath =~ m,https?://|ftp://|rsync://,) { $media = 'NET'; } elsif ($rootpath =~ m,$TeXLive::TLUtils::SshURIRegex,) { $media = 'NET'; @@ -304,7 +304,7 @@ sub from_file { $self->{'media'} = $media; # # actually load the TLPDB - if ($path =~ m;^((https?|ftp)://|file:\/\/*); || $path =~ m;$TeXLive::TLUtils::SshURIRegex;) { + if ($path =~ m;^((https?|ftp|rsync)://|file:\/\/*); || $path =~ m;$TeXLive::TLUtils::SshURIRegex;) { debug("TLPDB.pm: trying to initialize from $path\n"); # now $xzfh filehandle is open, the file created # TLUtils::download_file will just overwrite what is there diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index c4d21e26cb9..e4edb1ac1a6 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -2194,7 +2194,7 @@ sub unpack { my $containerfile = "$tempdir/$fn"; my $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.$compressorextension$//; - if ($what =~ m,^(https?|ftp)://, || $what =~ m!$SshURIRegex!) { + if ($what =~ m,^(https?|rsync|ftp)://, || $what =~ m!$SshURIRegex!) { # we are installing from the NET # check for the presence of $what in $tempdir if (-r $containerfile) { @@ -2365,6 +2365,10 @@ sub setup_programs { } } + # try to set up rsync + setup_one(($isWin ? "w32" : "unix"), 'rsync', + "$bindir/rsync/rsync.$platform", "--version", 1); + # setup of the fallback downloaders my @working_downloaders; for my $dltype (@AcceptedFallbackDownloaders) { @@ -2626,6 +2630,25 @@ sub download_file { } } + if ($relpath =~ m!^rsync://!) { + my $rsync; + if (defined($::progs{'rsync'})) { + $rsync = $::progs{'rsync'}; + } else { + tlwarn("$0: rsync repository in use but rsync not found, cannot continue!\n"); + return 0; + } + my $ret = _download_file_rsync($relpath, $dest, $rsync); + if ($ret) { + debug("downloading file via rsync succeeded\n"); + return $ret; + } else { + # neither wget nor $tldownload server can do rsync, so stop + debug("TLUtils::download_file: rsync failed: $url\n"); + return 0; + } + } + if ($relpath =~ m!$SshURIRegex!) { my $downdest; if ($dest eq "|") { @@ -2761,6 +2784,41 @@ sub _download_file_program { } } +sub _download_file_rsync { + my ($url, $dest, $rsyncdefault) = @_; + if (win32()) { + $dest =~ s!/!\\!g; + } + + my $rsync = $rsyncdefault; + # TODO here we probably need better arguments + my $rsyncargs = "--compress --quiet"; + + debug("downloading $url using $rsync $rsyncargs\n"); + my $ret; + my ($outfh, $outfn); + if ($dest eq "|") { + ($outfh, $outfn) = tl_tmpfile(); + } else { + $outfn = $dest; + } + my @rsyncargs = split (" ", $rsyncargs); + $ret = system ($rsync, @rsyncargs, $url, $outfn); + # we have to reverse the meaning of ret because system has 0=success. + $ret = ($ret ? 0 : 1); + + # return false/undef in case the download did not succeed. + return ($ret) unless $ret; + debug("download of $url succeeded\n"); + if ($dest eq "|") { + seek $outfh, 0, 0; + return $outfh; + } else { + return 1; + } +} + + =item C<nulldev ()> Return C</dev/null> on Unix and C<nul> on Windows. @@ -3919,7 +3977,7 @@ Returns the local file name if succeeded, otherwise undef. sub download_to_temp_or_file { my $url = shift; my ($url_fh, $url_file); - if ($url =~ m,^(https?|ftp|file)://, || $url =~ m!$SshURIRegex!) { + if ($url =~ m,^(https?|ftp|rsync|file)://, || $url =~ m!$SshURIRegex!) { ($url_fh, $url_file) = tl_tmpfile(); # now $url_fh filehandle is open, the file created # TLUtils::download_file will just overwrite what is there |