diff options
author | Norbert Preining <preining@logic.at> | 2018-05-23 02:41:08 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2018-05-23 02:41:08 +0000 |
commit | 49f362930a1775f1f824acb9598ccd94c924bb09 (patch) | |
tree | 56f63969b4cbf6dc1cc428dbaafacf7e13ba2349 | |
parent | ccc0b895a9b8b139cf5867d6f10e4e722580d5cd (diff) |
trial on ssh support
git-svn-id: svn://tug.org/texlive/trunk@47812 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 5 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 28 |
2 files changed, 31 insertions, 2 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index ea153fcf484..f766f176d69 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -283,6 +283,8 @@ sub from_file { my $rootpath = $self->root; if ($rootpath =~ m,https?://|ftp://,) { $media = 'NET'; + } elsif ($rootpath =~ m,^[^@]*@[^:]*:,) { + $media = 'NET'; } else { if ($rootpath =~ m,file://*(.*)$,) { $rootpath = "/$1"; @@ -304,7 +306,8 @@ sub from_file { $self->{'media'} = $media; # # actually load the TLPDB - if ($path =~ m;^((https?|ftp)://|file:\/\/*);) { + # if ($path =~ m;^((https?|ftp)://|file:\/\/*);) { + if ($media eq 'NET' || $path =~ m;^file:\/\/*;) { 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 dba3b8e22b9..0c4b30b95c0 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -2574,6 +2574,32 @@ sub download_file { return 0; } } + + if ($relpath =~ m;([^@]*)@([^:]*):(.*)$;) { + my $downdest; + if ($dest eq "|") { + my ($fh, $fn) = TeXLive::TLUtils::tl_tmpfile(); + $downdest = $fn; + } else { + $downdest = $dest; + } + my $retval = system("scp", "-q", $relpath, $downdest); + if ($retval != 0) { + $retval /= 256 if $retval > 0; + my $pwd = cwd (); + tlwarn("$0: system(scp -q $relpath $downdest) failed in $pwd, status $retval"); + return 0; + } + if ($dest eq "|") { + open(RETFH, "<$downdest") or + die("Cannot open $downdest for reading"); + # opening to a pipe always succeeds, so we return immediately + return \*RETFH; + } else { + return 1; + } + } + if ($relpath =~ /^(https?|ftp):\/\//) { $url = $relpath; } else { @@ -3808,7 +3834,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)://,) { + if ($url =~ m,^(https?|ftp|file)://, || $url =~ m,^[^@]*@[^:]*:,) { ($url_fh, $url_file) = tl_tmpfile(); # now $url_fh filehandle is open, the file created # TLUtils::download_file will just overwrite what is there |