texlive[52634] trunk: doc,sync
commits+karl at tug.org
commits+karl at tug.org
Mon Nov 4 18:43:40 CET 2019
Revision: 52634
http://tug.org/svn/texlive?view=revision&revision=52634
Author: karl
Date: 2019-11-04 18:43:40 +0100 (Mon, 04 Nov 2019)
Log Message:
-----------
doc,sync
Modified Paths:
--------------
trunk/Build/source/texk/tests/TeXLive/TLUtils.pm
trunk/Master/texmf-dist/scripts/texlive/NEWS
trunk/Master/tlpkg/bin/tl-update-asy
Modified: trunk/Build/source/texk/tests/TeXLive/TLUtils.pm
===================================================================
--- trunk/Build/source/texk/tests/TeXLive/TLUtils.pm 2019-11-04 00:53:44 UTC (rev 52633)
+++ trunk/Build/source/texk/tests/TeXLive/TLUtils.pm 2019-11-04 17:43:40 UTC (rev 52634)
@@ -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 @@
TeXLive::TLUtils::wsystem($msg, at 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 @@
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 @@
# 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 @@
=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 @@
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 @@
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 @@
=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 @@
"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 @@
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 @@
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 @@
# 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 @@
return %ret;
}
-
=back
-=head2 Miscellaneous
+=head2 Logging
-Ideas from Fabrice Popineau's C<FileUtils.pm>.
+Logging and debugging messages.
-=over 4
+=item C<logit($out,$level, at rest)>
-=item C<sort_uniq(@list)>
+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).
-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;
-}
-
-
-# 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 @@
}
}
-
=item C<info ($str1, $str2, ...)>
Write a normal informational message, the concatenation of the argument
@@ -3377,7 +3343,6 @@
}
}
-
=item C<debug ($str1, $str2, ...)>
Write a debugging message, the concatenation of the argument strings.
@@ -3399,7 +3364,6 @@
}
}
-
=item C<ddebug ($str1, $str2, ...)>
Write a deep debugging message, the concatenation of the argument
@@ -3495,7 +3459,7 @@
}
}
-=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 @@
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 @@
}
}
+=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 @@
return(@pieces);
}
+
=item C<mktexupd ()>
Append entries to C<ls-R> files. Usage example:
@@ -4262,7 +4358,7 @@
return $hash;
}
-
+
=item C<check_sys_user_mode($user,$sys,$tmfc, $tmfsc, $tmfv, $tmfsv)>
=cut
@@ -4314,6 +4410,7 @@
return ($texmfconfig, $texmfvar);
}
+
=item C<prepend_own_path()>
Prepend the location of the TeX Live binaries to the PATH environment
@@ -4335,7 +4432,7 @@
}
}
-
+
=item C<repository_to_array($r)>
Return hash of tags to urls for space-separated list of repositories
@@ -4376,6 +4473,7 @@
return %r;
}
+
=item C<encode_json($ref)>
Returns the JSON representation of the object C<$ref> is pointing at.
Modified: trunk/Master/texmf-dist/scripts/texlive/NEWS
===================================================================
--- trunk/Master/texmf-dist/scripts/texlive/NEWS 2019-11-04 00:53:44 UTC (rev 52633)
+++ trunk/Master/texmf-dist/scripts/texlive/NEWS 2019-11-04 17:43:40 UTC (rev 52634)
@@ -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.
Modified: trunk/Master/tlpkg/bin/tl-update-asy
===================================================================
--- trunk/Master/tlpkg/bin/tl-update-asy 2019-11-04 00:53:44 UTC (rev 52633)
+++ trunk/Master/tlpkg/bin/tl-update-asy 2019-11-04 17:43:40 UTC (rev 52634)
@@ -17,7 +17,6 @@
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/ .
@@ -24,6 +23,7 @@
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
More information about the tex-live-commits
mailing list