texlive[47812] Master/tlpkg/TeXLive: trial on ssh support

commits+preining at tug.org commits+preining at tug.org
Wed May 23 04:41:08 CEST 2018


Revision: 47812
          http://tug.org/svn/texlive?view=revision&revision=47812
Author:   preining
Date:     2018-05-23 04:41:08 +0200 (Wed, 23 May 2018)
Log Message:
-----------
trial on ssh support

Modified Paths:
--------------
    trunk/Master/tlpkg/TeXLive/TLPDB.pm
    trunk/Master/tlpkg/TeXLive/TLUtils.pm

Modified: trunk/Master/tlpkg/TeXLive/TLPDB.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPDB.pm	2018-05-23 02:34:02 UTC (rev 47811)
+++ trunk/Master/tlpkg/TeXLive/TLPDB.pm	2018-05-23 02:41:08 UTC (rev 47812)
@@ -283,6 +283,8 @@
   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 @@
   $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

Modified: trunk/Master/tlpkg/TeXLive/TLUtils.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLUtils.pm	2018-05-23 02:34:02 UTC (rev 47811)
+++ trunk/Master/tlpkg/TeXLive/TLUtils.pm	2018-05-23 02:41:08 UTC (rev 47812)
@@ -2574,6 +2574,32 @@
       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 @@
 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



More information about the tex-live-commits mailing list