diff options
| -rwxr-xr-x | Master/texmf-dist/scripts/texlive/tlmgr.pl | 7 | ||||
| -rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 10 | ||||
| -rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 10 |
3 files changed, 16 insertions, 11 deletions
diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl index 7431ebcb69c..8ee5ee58b33 100755 --- a/Master/texmf-dist/scripts/texlive/tlmgr.pl +++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl @@ -4434,9 +4434,9 @@ sub action_repository { 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 @@ 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?|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); diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index e8a6ca878ac..7c19c9a805e 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -116,10 +116,10 @@ my $_listdir; 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 @@ sub from_file { 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://*(.*)$,) { diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index d6c4a700677..b8151bf35de 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -198,6 +198,7 @@ BEGIN { &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 @@ use TeXLive::TLConfig; $::opt_verbosity = 0; # see process_logging_options +our $SshURIRegex = '^((ssh|scp)://([^@]*)@([^/]*)/|([^@]*)@([^:]*):).*$'; =head2 Platform detection @@ -2176,7 +2178,7 @@ sub unpack { $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 @@ sub download_file { } } - if ($relpath =~ m;([^@]*)@([^:]*):(.*)$;) { + if ($relpath =~ m!$SshURIRegex!) { my $downdest; if ($dest eq "|") { my ($fh, $fn) = TeXLive::TLUtils::tl_tmpfile(); @@ -2583,6 +2585,8 @@ sub download_file { } 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 @@ 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,^[^@]*@[^:]*:,) { + 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 |