rsync support WIPdev/rsync

4 files changed, 70 insertions, 15 deletions

diff --git a/Master/install-tl b/Master/install-tl
index 56863efe87e..390859ead0b 100755
--- a/Master/install-tl
+++ b/Master/install-tl
@@ -504,12 +504,9 @@ if (!$opt_custom_bin && (platform() eq "i386-cygwin")) {
 # check command line arguments if given
 if ($opt_location) {
   my $tmp = $opt_location;
-  if ($tmp =~ m!^(https?|ftp)://!i) {
+  if ($tmp =~ m!^(https?|rsync|ftp)://!i) {
     push @media_available, "NET#$tmp";
 
-  } elsif ($tmp =~ m!^(rsync|)://!i) {
-    tldie ("$0: sorry, rsync unsupported; use an http or ftp url here.\n"); 
-
   } else {
     # remove leading file:/+ part
     $tmp =~ s!^file://*!/!i;
@@ -678,7 +675,7 @@ sub only_load_remote {
   $location = $opt_location;
   $location = $selected_location if defined($selected_location);
   $location || ($location = "$::installerdir");
-  if ($location =~ m!^(ctan$|(https?|ftp)://)!i) {
+  if ($location =~ m!^(ctan$|(https?|rsync|ftp)://)!i) {
     $location =~ s,/(tlpkg|archive)?/*$,,;  # remove any trailing tlpkg or /
     if ($location =~ m/^ctan$/i) {
       $location = TeXLive::TLUtils::give_ctan_mirror();
@@ -2636,7 +2633,7 @@ simplified Chinese (zh_CN), and traditional Chinese (zh_TW).
 
 Specify the package repository to be used as the source of the
 installation. In short, this can be a directory name or a url using
-http(s), ftp, or scp. The documentation for C<tlmgr> has the details
+http(s), ftp, rsync, or scp. The documentation for C<tlmgr> has the details
 (L<http://tug.org/texlive/doc/tlmgr.html#OPTIONS>).
 
 For installation, the default is to pick a mirror automatically, using
diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index 262b525d3a7..9edca78afff 100755
--- a/Master/texmf-dist/scripts/texlive/tlmgr.pl
+++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl
@@ -4462,9 +4462,9 @@ sub action_repository {
       return ($F_ERROR);
     }
     # check if it is either url or absolute path
-    if (($p !~ m!^(https?|ftp)://!i) && ($p !~ m!$TeXLive::TLUtils::SshURIRegex!) && 
+    if (($p !~ m!^(https?|rsync|ftp)://!i) && ($p !~ m!$TeXLive::TLUtils::SshURIRegex!) && 
         !File::Spec->file_name_is_absolute($p)) {
-      tlwarn("$prg: neither https?/ftp/ssh/scp/file URI nor absolute path, no action: $p\n");
+      tlwarn("$prg: neither https?/ftp/ssh/scp/rsync/file URI nor absolute path, no action: $p\n");
       return ($F_ERROR);
     }
     my $t = shift @ARGV;
@@ -6578,7 +6578,7 @@ sub init_local_db {
   # we normalize the path only if it is
   # - a url starting with neither http or ftp
   # - if we are on Windows, it does not start with Drive:[\/]
-  if (! ( $location =~ m!^(https?|ftp)://!i  || 
+  if (! ( $location =~ m!^(https?|rsync|ftp)://!i  || 
           $location =~ m!$TeXLive::TLUtils::SshURIRegex!i ||
           (win32() && (!(-e $location) || ($location =~ m!^.:[\\/]!) ) ) ) ) {
     # seems to be a local path, try to normalize it
@@ -6836,7 +6836,7 @@ sub setup_one_remotetlpdb {
   #   not work
 
   my $local_copy_tlpdb_used = 0;
-  if ($location =~ m;^(https?|ftp)://;) {
+  if ($location =~ m;^(https?|rsync|ftp)://;) {
     # first check that the saved tlpdb is present at all
     my $loc_digest = TeXLive::TLCrypto::tl_short_digest($location);
     my $loc_copy_of_remote_tlpdb =
@@ -6998,7 +6998,7 @@ FROZEN
   # save remote database if it is a net location
   # make sure that the writeout of the tlpdb is done in UNIX mode
   # since otherwise the checksum will change.
-  if (!$local_copy_tlpdb_used && $location =~ m;^(https?|ftp)://;) {
+  if (!$local_copy_tlpdb_used && $location =~ m;^(https?|rsync|ftp)://;) {
     my $loc_digest = TeXLive::TLCrypto::tl_short_digest($location);
     my $loc_copy_of_remote_tlpdb =
       "$Master/$InfraLocation/texlive.tlpdb.$loc_digest";
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