texlive[47823] Master: support ssh://user at host/path as well as

[commits+preining at tug.org]

Revision: 47823
          http://tug.org/svn/texlive?view=revision&revision=47823
Author:   preining
Date:     2018-05-24 05:08:27 +0200 (Thu, 24 May 2018)
Log Message:
-----------
support ssh://user@host/path as well as scp://...

Modified Paths:
--------------
    trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
    trunk/Master/tlpkg/TeXLive/TLPDB.pm
    trunk/Master/tlpkg/TeXLive/TLUtils.pm

Modified: trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
===================================================================
--- trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2018-05-24 00:24:33 UTC (rev 47822)
+++ trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl	2018-05-24 03:08:27 UTC (rev 47823)
@@ -4434,9 +4434,9 @@
       return ($F_ERROR);
     }
     # check if it is either url or absolute path
-    if (($p !~ m!^(https?|ftp)://!i) && 
+    if (($p !~ m!^(https?|ftp)://!i) && ($p !~ m!$TeXLive::TLUtils::SshURIRegex!) && 
         !File::Spec->file_name_is_absolute($p)) {
-      tlwarn("$prg: neither https?/ftp URL nor absolute path, no action: $p\n");
+      tlwarn("$prg: neither https?/ftp/ssh/scp/file URI nor absolute path, no action: $p\n");
       return ($F_ERROR);
     }
     my $t = shift @ARGV;
@@ -6550,7 +6550,8 @@
   # 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?|ftp)://!i  || 
+          $location =~ m!$TeXLive::TLUtils::SshURIRegex!i ||
           (win32() && (!(-e $location) || ($location =~ m!^.:[\\/]!) ) ) ) ) {
     # seems to be a local path, try to normalize it
     my $testloc = abs_path($location);

Modified: trunk/Master/tlpkg/TeXLive/TLPDB.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPDB.pm	2018-05-24 00:24:33 UTC (rev 47822)
+++ trunk/Master/tlpkg/TeXLive/TLPDB.pm	2018-05-24 03:08:27 UTC (rev 47823)
@@ -116,10 +116,10 @@
 
 C<< TeXLive::TLPDB->new >> creates a new C<TLPDB> object. If the
 argument C<root> is given it will be initialized from the respective
-location starting at $path. If C<$path> begins with C<http://> or
-C<ftp://>, the program C<wget> is used to download the file.  The
-C<$path> can also start with C<file:/> in which case it is treated as a
-file on the filesystem in the usual way.
+location starting at $path. If C<$path> begins with C<http://>, C<https://>,
+C<ftp://>, C<scp://>, C<ssh://> or C<I<user>@I<host>:>, the respective file
+is downloaded.  The C<$path> can also start with C<file:/> in which case it
+is treated as a file on the filesystem in the usual way.
 
 Returns an object of type C<TeXLive::TLPDB>, or undef if the root was
 given but no package could be read from that location.
@@ -283,7 +283,7 @@
   my $rootpath = $self->root;
   if ($rootpath =~ m,https?://|ftp://,) {
     $media = 'NET';
-  } elsif ($rootpath =~ m,^[^@]*@[^:]*:,) {
+  } elsif ($rootpath =~ m,$TeXLive::TLUtils::SshURIRegex,) {
     $media = 'NET';
   } else {
     if ($rootpath =~ m,file://*(.*)$,) {

Modified: trunk/Master/tlpkg/TeXLive/TLUtils.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLUtils.pm	2018-05-24 00:24:33 UTC (rev 47822)
+++ trunk/Master/tlpkg/TeXLive/TLUtils.pm	2018-05-24 03:08:27 UTC (rev 47823)
@@ -198,6 +198,7 @@
     &encode_json
     &True
     &False
+    &SshURIRegex
   );
   @EXPORT = qw(setup_programs download_file process_logging_options
                tldie tlwarn info log debug ddebug dddebug debug_hash
@@ -213,6 +214,7 @@
 
 $::opt_verbosity = 0;  # see process_logging_options
 
+our $SshURIRegex = '^((ssh|scp)://([^@]*)@([^/]*)/|([^@]*)@([^:]*):).*$';
 
 =head2 Platform detection
 
@@ -2176,7 +2178,7 @@
   $containerfile_quote = "\"$containerfile\"";
   $tarfile_quote = "\"$tarfile\"";
   $target_quote = "\"$target\"";
-  if ($what =~ m,^(https?|ftp)://, || $what =~ m,^[^@]*@[^:]*:,) {
+  if ($what =~ m,^(https?|ftp)://, || $what =~ m!$SshURIRegex!) {
     # we are installing from the NET
     # check for the presence of $what in $tempdir
     if (-r $containerfile) {
@@ -2575,7 +2577,7 @@
     }
   }
 
-  if ($relpath =~ m;([^@]*)@([^:]*):(.*)$;) {
+  if ($relpath =~ m!$SshURIRegex!) {
     my $downdest;
     if ($dest eq "|") {
       my ($fh, $fn) = TeXLive::TLUtils::tl_tmpfile();
@@ -2583,6 +2585,8 @@
     } else {
       $downdest = $dest;
     }
+    # massage ssh:// into the scp acceptable scp://
+    $relpath =~ s!^ssh://!scp://!;
     my $retval = system("scp", "-q", $relpath, $downdest);
     if ($retval != 0) {
       $retval /= 256 if $retval > 0;
@@ -3834,7 +3838,7 @@
 sub download_to_temp_or_file {
   my $url = shift;
   my ($url_fh, $url_file);
-  if ($url =~ m,^(https?|ftp|file)://, || $url =~ m,^[^@]*@[^:]*:,) {
+  if ($url =~ m,^(https?|ftp|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