doc,sync

git-svn-id: svn://tug.org/texlive/trunk@52634 c570f23f-e606-0410-a88d-b1316a301751

3 files changed, 247 insertions, 145 deletions

diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm
index 121b6db5f6e..0aab6a6248c 100644
--- a/Build/source/texk/tests/TeXLive/TLUtils.pm
+++ b/Build/source/texk/tests/TeXLive/TLUtils.pm
@@ -5,7 +5,7 @@
 
 package TeXLive::TLUtils;
 
-my $svnrev = '$Revision: 50493 $';
+my $svnrev = '$Revision: 52568 $';
 my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
 sub module_revision { return $_modulerevision; }
 
@@ -38,7 +38,7 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure
   TeXLive::TLUtils::wsystem($msg,@args);
   TeXLive::TLUtils::xsystem(@args);
   TeXLive::TLUtils::run_cmd($cmd);
-  TeXLive::TLUtils::system_pipe($prog, $infile, $outfile, $removeIn, @extraargs);
+  TeXLive::TLUtils::system_pipe($prog, $infile, $outfile, $removeIn, @args);
 
 =head2 File utilities
 
@@ -79,6 +79,19 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure
   TeXLive::TLUtils::w32_remove_from_path($bindir, $multiuser);
   TeXLive::TLUtils::setup_persistent_downloads();
 
+=head2 Logging and debugging
+
+  TeXLive::TLUtils::info($str1, ...);    # output unless -q
+  TeXLive::TLUtils::debug($str1, ...);   # output if -v
+  TeXLive::TLUtils::ddebug($str1, ...);  # output if -vv
+  TeXLive::TLUtils::dddebug($str1, ...); # output if -vvv
+  TeXLive::TLUtils::log($str1, ...);     # only to log file
+  TeXLive::TLUtils::tlwarn($str1, ...);  # warn on stderr and log
+  TeXLive::TLUtils::tldie($str1, ...);   # tlwarn and die
+  TeXLive::TLUtils::debug_hash($label, HASH);   # warn stringified HASH
+  TeXLive::TLUtils::backtrace();                # return call stack as string
+  TeXLive::TLUtils::process_logging_options($texdir); # handle -q -v* -logfile
+
 =head2 Miscellaneous
 
   TeXLive::TLUtils::sort_uniq(@list);
@@ -114,7 +127,7 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure
 # avoid -warnings.
 our $PERL_SINGLE_QUOTE; # we steal code from Text::ParseWords
 use vars qw(
-  $::LOGFILENAME @::LOGLINES 
+  $::LOGFILE $::LOGFILENAME @::LOGLINES 
     @::debug_hook @::ddebug_hook @::dddebug_hook @::info_hook 
     @::install_packages_hook @::warn_hook
   $TeXLive::TLDownload::net_lib_avail
@@ -1088,18 +1101,25 @@ sub rmtree {
 
 =item C<copy("-f", $file, $destfile)>
 
+=item C<copy("-L", $file, $destfile)>
+
 Copy file C<$file> to directory C<$target_dir>, or to the C<$destfile>
-in the second case.  No external programs are involved.  Since we need
-C<sysopen()>, the Perl module C<Fcntl.pm> is required.  The time stamps
-are preserved and symlinks are created on Unix systems.  On Windows,
-C<(-l $file)> will never return 'C<true>' and so symlinks will be
-(uselessly) copied as regular files.
+if the first argument is C<"-f">. No external programs are involved.
+Since we need C<sysopen()>, the Perl module C<Fcntl.pm> is required. The
+time stamps are preserved and symlinks are created on Unix systems. On
+Windows, C<(-l $file)> will never return 'C<true>' and so symlinks will
+be (uselessly) copied as regular files.
+
+If the argument is C<"-L"> and C<$file> is a symlink, the link is
+dereferenced before the copying is done. (If both C<"-f"> and C<"-L">
+are desired, they must be given in that order, although the current code
+has no need to do this.)
 
 C<copy> invokes C<mkdirhier> if target directories do not exist.  Files
 have mode C<0777> if they are executable and C<0666> otherwise, with
 the set bits in I<umask> cleared in each case.
 
-C<$file> can begin with a file:/ prefix.
+C<$file> can begin with a C<file:/> prefix.
 
 If C<$file> is not readable, we return without copying anything.  (This
 can happen when the database and files are not in perfect sync.)  On the
@@ -1111,12 +1131,21 @@ that is a fatal error.
 sub copy {
   my $infile = shift;
   my $filemode = 0;
+  my $dereference = 0;
   if ($infile eq "-f") { # second argument is a file
     $filemode = 1;
     $infile = shift;
   }
+  if ($infile eq "-L") {
+    $dereference = 1;
+    $infile = shift;
+  }
   my $destdir=shift;
 
+  # while we're trying to figure out the versioned containers.
+  #debug("copy($infile, $destdir, filemode=$filemode)\n");
+  #debug("copy: backtrace:\n", backtrace(), "copy: end backtrace\n");
+
   my $outfile;
   my @stat;
   my $mode;
@@ -1141,9 +1170,24 @@ sub copy {
     die "mkdirhier($destdir) failed: $err\n" if ! $ret;
   }
 
-  if (-l "$infile") {
-    symlink (readlink $infile, "$destdir/$filename")
-    || die "symlink(readlink $infile, $destdir/$filename) failed: $!";
+  # if we should dereference, change $infile to refer to the link target.
+  if (-l $infile && $dereference) {
+    my $linktarget = readlink($infile);
+    # The symlink target should always be relative, and we need to
+    # prepend the directory containing the link in that case.
+    # (Although it should never happen, if the symlink target happens
+    # to already be absolute, do not prepend.)
+    if ($linktarget !~ m,^/,) {
+      $infile = Cwd::abs_path(dirname($infile)) . "/$linktarget";
+    }
+  }
+
+  if (-l $infile) {
+    my $linktarget = readlink($infile);
+    my $dest = "$destdir/$filename";
+    debug("TLUtils::copy: doing symlink($linktarget,$dest)"
+          . " [from readlink($infile)]\n");
+    symlink($linktarget, $dest) || die "symlink($linktarget,$dest) failed: $!";
   } else {
     if (! open (IN, $infile)) {
       warn "open($infile) failed, not copying: $!";
@@ -2101,14 +2145,21 @@ sub w32_remove_from_path {
 
 =pod
 
-=item C<check_file($what, $checksum, $checksize>
+=item C<check_file_and_remove($what, $checksum, $checksize>
 
-Remove C<$what> if either the given C<$checksum> or C<$checksize> does
-not agree. If a check argument is not given, that check is not performed.
+Remove the file C<$what> if either the given C<$checksum> or
+C<$checksize> for C<$what> does not agree with our recomputation using
+C<TLCrypto::tlchecksum> and C<stat>, respectively. If a check argument
+is not given, that check is not performed. If the checksums agree, the
+size is not checked. The return status is random.
+
+This unusual behavior (removing the given file) is because this is used
+for newly-downloaded files; see the calls in the C<unpack> routine
+(which is the only caller).
 
 =cut
 
-sub check_file {
+sub check_file_and_remove {
   my ($xzfile, $checksum, $checksize) = @_;
   debug("check_file $xzfile, $checksum, $checksize\n");
   if (!$checksum && !$checksize) {
@@ -2116,12 +2167,23 @@ sub check_file {
            "available for $xzfile, cannot check integrity"); 
     return;
   }
+  
+  # The idea is that if one of the tests fail, we want to save a copy of
+  # the input file for debugging. But we can't just omit removing the
+  # file, since the caller depends on the removal. So we copy it to a
+  # new temporary directory, which we want to persist, so can't use tl_tmpdir.
+  my $check_file_tmpdir = undef;
+
   # only run checksum tests if we can actually compute the checksum
   if ($checksum && ($checksum ne "-1") && $::checksum_method) {
     my $tlchecksum = TeXLive::TLCrypto::tlchecksum($xzfile);
     if ($tlchecksum ne $checksum) {
-      tlwarn("TLUtils::check_file: removing $xzfile, checksums differ:\n");
-      tlwarn("TLUtils::check_file:   TL=$tlchecksum, arg=$checksum\n");
+      tlwarn("TLUtils::check_file: checksums differ for $xzfile:\n");
+      tlwarn("TLUtils::check_file:   tlchecksum=$tlchecksum, arg=$checksum\n");
+      (undef,$check_file_tmpdir) = File::temp::tempdir("tlcheckfileXXXXXXXX");
+      tlwarn("TLUtils::check_file:   removing $xzfile, "
+             . "but saving copy in $check_file_tmpdir\n");
+      copy($xzfile, $check_file_tmpdir);
       unlink($xzfile);
       return;
     } else {
@@ -2134,7 +2196,14 @@ sub check_file {
     my $filesize = (stat $xzfile)[7];
     if ($filesize != $checksize) {
       tlwarn("TLUtils::check_file: removing $xzfile, sizes differ:\n");
-      tlwarn("TLUtils::check_file:   TL=$filesize, arg=$checksize\n");
+      tlwarn("TLUtils::check_file:   tlfilesize=$filesize, arg=$checksize\n");
+      if (!defined($check_file_tmpdir)) {
+        # the tmpdir should always be undefined, since we shouldn't get
+        # here if the checksums failed, but test anyway.
+        $check_file_tmpdir = File::temp::tempdir("tlcheckfileXXXXXXXX");
+        tlwarn("TLUtils::check_file:  saving copy in $check_file_tmpdir\n");
+        copy($xzfile, $check_file_tmpdir);
+      }
       unlink($xzfile);
       return;
     }
@@ -2149,10 +2218,11 @@ sub check_file {
 
 If necessary, downloads C$what>, and then unpacks it into C<$targetdir>.
 C<@opts> is assigned to a hash and can contain the following 
-options: C<tmpdir> (use this directory for downloaded files), 
+keys: C<tmpdir> (use this directory for downloaded files), 
 C<checksum> (check downloaded file against this checksum), 
 C<size> (check downloaded file against this size),
 C<remove> (remove temporary files after operation).
+
 Returns a pair of values: in case of error return 0 and an additional
 explanation, in case of success return 1 and the name of the package.
 
@@ -2202,26 +2272,26 @@ sub unpack {
     # we are installing from the NET
     # check for the presence of $what in $tempdir
     if (-r $containerfile) {
-      check_file($containerfile, $checksum, $size);
+      check_file_and_remove($containerfile, $checksum, $size);
     }
     # if the file is now not present, we can use it
     if (! -r $containerfile) {
       # try download the file and put it into temp
       if (!download_file($what, $containerfile)) {
-        return(0, "downloading did not succeed");
+        return(0, "downloading did not succeed (download_file failed)");
       }
       # remove false downloads
-      check_file($containerfile, $checksum, $size);
+      check_file_and_remove($containerfile, $checksum, $size);
       if ( ! -r $containerfile ) {
-        return(0, "downloading did not succeed");
+        return(0, "downloading did not succeed (check_file_and_remove failed)");
       }
     }
   } else {
     # we are installing from local compressed files
-    # copy it to temp
-    TeXLive::TLUtils::copy($what, $tempdir);
+    # copy it to temp with dereferencing of link target
+    TeXLive::TLUtils::copy("-L", $what, $tempdir);
 
-    check_file($containerfile, $checksum, $size);
+    check_file_and_remove($containerfile, $checksum, $size);
     if (! -r $containerfile) {
       return (0, "consistency checks failed");
     }
@@ -3210,124 +3280,21 @@ sub parse_AddFormat_line {
   return %ret;
 }
 
-
 =back
 
-=head2 Miscellaneous
-
-Ideas from Fabrice Popineau's C<FileUtils.pm>.
-
-=over 4
-
-=item C<sort_uniq(@list)>
-
-The C<sort_uniq> function sorts the given array and throws away multiple
-occurrences of elements. It returns a sorted and unified array.
-
-=cut
-
-sub sort_uniq {
-  my (@l) = @_;
-  my ($e, $f, @r);
-  $f = "";
-  @l = sort(@l);
-  foreach $e (@l) {
-    if ($e ne $f) {
-      $f = $e;
-      push @r, $e;
-    }
-  }
-  return @r;
-}
-
-
-=item C<push_uniq(\@list, @new_items)>
-
-The C<push_uniq> function pushes the last argument @ITEMS to the $LIST
-referenced by the first argument, if they are not already in the list.
-
-=cut
-
-sub push_uniq {
-  my ($l, @new_items) = @_;
-  for my $e (@new_items) {
-    if (! &member($e, @$l)) {
-      push (@$l, $e);
-    }
-  }
-}
-
-=item C<member($item, @list)>
-
-The C<member> function returns true if the first argument 
-is also inclued in the list of the remaining arguments.
-
-=cut
-
-sub member {
-  my $what = shift;
-  return scalar grep($_ eq $what, @_);
-}
-
-
-=item C<merge_into(\%to, \%from)>
-
-Merges the keys of %from into %to.
-
-=cut
-
-sub merge_into {
-  my ($to, $from) = @_;
-  foreach my $k (keys %$from) {
-    if (defined($to->{$k})) {
-      push @{$to->{$k}}, @{$from->{$k}};
-    } else {
-      $to->{$k} = [ @{$from->{$k}} ];
-    }
-  }
-}
+=head2 Logging
 
+Logging and debugging messages.
 
-=item C<texdir_check($texdir)>
-
-Test whether installation with TEXDIR set to $texdir would succeed due to
-writing permissions.
+=item C<logit($out,$level,@rest)>
 
-Writable or not, we will not allow installation to the root
-directory (Unix) or the root of a drive (Windows).
+Internal routine to write message to both C<$out> (references to
+filehandle) and C<$::LOGFILE>, at level C<$level>, of concatenated items
+in C<@rest>. If the log file is not initialized yet, the message is
+saved to be logged later (unless the log file never comes into existence).
 
 =cut
 
-sub texdir_check {
-  my $texdir = shift;
-  return 0 unless defined $texdir;
-  # convert to absolute, for safer parsing.
-  # The return value may still contain symlinks,
-  # but no unnecessary terminating '/'.
-  $texdir = tl_abs_path($texdir);
-  return 0 unless defined $texdir;
-  # also reject the root of a drive,
-  # assuming that only the canonical form of the root ends with /
-  return 0 if $texdir =~ m!/$!;
-  # win32: for now, reject the root of a samba share
-  return 0 if win32() && $texdir =~ m!^//[^/]+/[^/]+$!;
-  my $texdirparent;
-  my $texdirpparent;
-
-  return dir_writable($texdir) if (-d $texdir);
-  ($texdirparent = $texdir) =~ s!/[^/]*$!!;
-  #print STDERR "Checking $texdirparent".'[/]'."\n";
-  return  dir_creatable($texdirparent) if -d dir_slash($texdirparent);
-  # try another level up the tree
-  ($texdirpparent = $texdirparent) =~ s!/[^/]*$!!;
-  #print STDERR "Checking $texdirpparent".'[/]'."\n";
-  return dir_creatable($texdirpparent) if -d dir_slash($texdirpparent);
-  return 0;
-}
-
-
-# no newlines or spaces are added, multiple args are just concatenated.
-#
 sub logit {
   my ($out, $level, @rest) = @_;
   _logit($out, $level, @rest) unless $::opt_quiet;
@@ -3353,7 +3320,6 @@ sub _logit {
   }
 }
 
-
 =item C<info ($str1, $str2, ...)>
 
 Write a normal informational message, the concatenation of the argument
@@ -3377,7 +3343,6 @@ sub info {
   }
 }
 
-
 =item C<debug ($str1, $str2, ...)>
 
 Write a debugging message, the concatenation of the argument strings.
@@ -3399,7 +3364,6 @@ sub debug {
   }
 }
 
-
 =item C<ddebug ($str1, $str2, ...)>
 
 Write a deep debugging message, the concatenation of the argument
@@ -3495,7 +3459,7 @@ sub tldie {
   }
 }
 
-=item C<debug_hash ($label, hash))>
+=item C<debug_hash ($label, HASH)>
 
 Write LABEL followed by HASH elements, all on one line, to stderr.
 If HASH is a reference, it is followed.
@@ -3520,7 +3484,26 @@ sub debug_hash {
   warn "$str\n";
 }
 
-
+=item C<backtrace()>
+
+Return call(er) stack, as a string.
+
+=cut
+
+sub backtrace {
+  my $ret = "";
+
+  my ($line, $subr);
+  my $stackframe = 1;  # skip ourselves
+  while ((undef,$filename,$line,$subr) = caller ($stackframe)) {
+    # the undef is for the package, which is already included in $subr.
+    $ret .= " -> ${filename}:${line}: ${subr}\n";
+    $stackframe++;
+  }
+
+  return $ret;
+}
+
 =item C<process_logging_options ($texdir)>
 
 This function handles the common logging options for TeX Live scripts.
@@ -3593,6 +3576,118 @@ sub process_logging_options {
   }
 }
 
+=back
+
+=head2 Miscellaneous
+
+Some ideas from Fabrice Popineau's C<FileUtils.pm>.
+
+=over 4
+
+=item C<sort_uniq(@list)>
+
+The C<sort_uniq> function sorts the given array and throws away multiple
+occurrences of elements. It returns a sorted and unified array.
+
+=cut
+
+sub sort_uniq {
+  my (@l) = @_;
+  my ($e, $f, @r);
+  $f = "";
+  @l = sort(@l);
+  foreach $e (@l) {
+    if ($e ne $f) {
+      $f = $e;
+      push @r, $e;
+    }
+  }
+  return @r;
+}
+
+
+=item C<push_uniq(\@list, @new_items)>
+
+The C<push_uniq> function pushes the last argument @ITEMS to the $LIST
+referenced by the first argument, if they are not already in the list.
+
+=cut
+
+sub push_uniq {
+  my ($l, @new_items) = @_;
+  for my $e (@new_items) {
+    if (! &member($e, @$l)) {
+      push (@$l, $e);
+    }
+  }
+}
+
+=item C<member($item, @list)>
+
+The C<member> function returns true if the first argument 
+is also inclued in the list of the remaining arguments.
+
+=cut
+
+sub member {
+  my $what = shift;
+  return scalar grep($_ eq $what, @_);
+}
+
+=item C<merge_into(\%to, \%from)>
+
+Merges the keys of %from into %to.
+
+=cut
+
+sub merge_into {
+  my ($to, $from) = @_;
+  foreach my $k (keys %$from) {
+    if (defined($to->{$k})) {
+      push @{$to->{$k}}, @{$from->{$k}};
+    } else {
+      $to->{$k} = [ @{$from->{$k}} ];
+    }
+  }
+}
+
+=item C<texdir_check($texdir)>
+
+Test whether installation with TEXDIR set to $texdir would succeed due to
+writing permissions.
+
+Writable or not, we will not allow installation to the root
+directory (Unix) or the root of a drive (Windows).
+
+=cut
+
+sub texdir_check {
+  my $texdir = shift;
+  return 0 unless defined $texdir;
+  # convert to absolute, for safer parsing.
+  # The return value may still contain symlinks,
+  # but no unnecessary terminating '/'.
+  $texdir = tl_abs_path($texdir);
+  return 0 unless defined $texdir;
+  # also reject the root of a drive,
+  # assuming that only the canonical form of the root ends with /
+  return 0 if $texdir =~ m!/$!;
+  # win32: for now, reject the root of a samba share
+  return 0 if win32() && $texdir =~ m!^//[^/]+/[^/]+$!;
+  my $texdirparent;
+  my $texdirpparent;
+
+  return dir_writable($texdir) if (-d $texdir);
+  ($texdirparent = $texdir) =~ s!/[^/]*$!!;
+  #print STDERR "Checking $texdirparent".'[/]'."\n";
+  return  dir_creatable($texdirparent) if -d dir_slash($texdirparent);
+  # try another level up the tree
+  ($texdirpparent = $texdirparent) =~ s!/[^/]*$!!;
+  #print STDERR "Checking $texdirpparent".'[/]'."\n";
+  return dir_creatable($texdirpparent) if -d dir_slash($texdirpparent);
+  return 0;
+}
+
 =pod
 
 This function takes a single argument I<path> and returns it with
@@ -4165,6 +4260,7 @@ sub parse_line {
   return(@pieces);
 }
 
+
 =item C<mktexupd ()>
 
 Append entries to C<ls-R> files.  Usage example:
@@ -4262,7 +4358,7 @@ sub mktexupd {
   return $hash;
 }
 
-
+
 =item C<check_sys_user_mode($user,$sys,$tmfc, $tmfsc, $tmfv, $tmfsv)>
 
 =cut
@@ -4314,6 +4410,7 @@ sub setup_sys_user_mode {
   return ($texmfconfig, $texmfvar);
 }
 
+
 =item C<prepend_own_path()>
 
 Prepend the location of the TeX Live binaries to the PATH environment
@@ -4335,7 +4432,7 @@ sub prepend_own_path {
   }
 }
 
-
+
 =item C<repository_to_array($r)>
 
 Return hash of tags to urls for space-separated list of repositories
@@ -4376,6 +4473,7 @@ sub repository_to_array {
   return %r;
 }
 
+
 =item C<encode_json($ref)>
 
 Returns the JSON representation of the object C<$ref> is pointing at.
diff --git a/Master/texmf-dist/scripts/texlive/NEWS b/Master/texmf-dist/scripts/texlive/NEWS
index 7f71173ee2d..f4221025098 100644
--- a/Master/texmf-dist/scripts/texlive/NEWS
+++ b/Master/texmf-dist/scripts/texlive/NEWS
@@ -1,6 +1,10 @@
 (This file public domain.  Originally written by Norbert Preining and
 Karl Berry, 2010.)
 
+<p><b>tlmgr 52585 (released 31oct19):</b>
+<li>TLUtils.pm: try again with symlink change for backups.
+<li>small doc and implementation improvements.
+
 <p><b>tlmgr 52467 (released 21oct19):</b>
 <li>revert TLUtils.pm change, as it could cause symlinks to absolute paths
 to be in the bin/ directories, not just used for backups.
diff --git a/Master/tlpkg/bin/tl-update-asy b/Master/tlpkg/bin/tl-update-asy
index 7994b6343e0..b86006b2c22 100755
--- a/Master/tlpkg/bin/tl-update-asy
+++ b/Master/tlpkg/bin/tl-update-asy
@@ -17,13 +17,13 @@ renice +19 -p $$ >/dev/null 2>&1
 if false && $update_sources_from_ctan; then
   # this part is about copying the sources from CTAN to TL.
   cd $B/source/utils/
-  edit README for asymptote$ver
   (cd asymptote && make distclean; sup && sat)  # be sure no dregs
   \cp -arf /home/ftp/tex-archive/graphics/asymptote/ .
 
   cd asymptote
   ver=`awk -F\" '{print $2}' revision.cc | sed 1q` # the newly-released version
   echo $ver
+  edit ../README for $ver
 
   # show list of new files to add:
   svn status | sed -n 's/^\?//p' | fgrep -v binaries