summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2016-04-21 22:29:54 +0000
committerKarl Berry <karl@freefriends.org>2016-04-21 22:29:54 +0000
commit5dc186fe6daa8b33a9c71b690202cc95617ed309 (patch)
treeb2e0ed255401ec8fd6427b76dab28c0e25fd6fe4
parentae2800747ff22700bbc43b0b0d10066615bde629 (diff)
sync,doc
git-svn-id: svn://tug.org/texlive/trunk@40667 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Build/source/texk/tests/TeXLive/TLConfig.pm22
-rw-r--r--Build/source/texk/tests/TeXLive/TLUtils.pm357
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/texlive/tlmgr.pl42
-rwxr-xr-xBuild/source/texk/texlive/tests/updmap-cmdline-test.pl9
4 files changed, 126 insertions, 304 deletions
diff --git a/Build/source/texk/tests/TeXLive/TLConfig.pm b/Build/source/texk/tests/TeXLive/TLConfig.pm
index 1435bbbf003..767a173e6e5 100644
--- a/Build/source/texk/tests/TeXLive/TLConfig.pm
+++ b/Build/source/texk/tests/TeXLive/TLConfig.pm
@@ -5,16 +5,9 @@
package TeXLive::TLConfig;
-my $svnrev = '$Revision: 40600 $';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
- $_modulerevision = $1;
-} else {
- $_modulerevision = "unknown";
-}
-sub module_revision {
- return $_modulerevision;
-}
+my $svnrev = '$Revision: 40652 $';
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
+sub module_revision { return $_modulerevision; }
BEGIN {
use Exporter ();
@@ -63,7 +56,7 @@ $ReleaseYear = 2016;
# users can upgrade from this year to the current year; might be the
# same as the release year, or any number of releases earlier.
# Generally not tested.
-$MinRelease = 2013;
+$MinRelease = 2016;
# users can NOT upgrade due to internal changes, force a full installation
#$MinRelease = $ReleaseYear;
@@ -217,7 +210,7 @@ our $F_NOPOSTACTION = 4;
# The length of a checksum generated by tlchecksum and contained in
# texlive.tlpdb.checksum. Needs to be in agreement with the hash
-# method used in TLUtils::tlchecksum and TLUtils::tldigest
+# method used in TLCrypto::tlchecksum and TLCrypto::tldigest
$ChecksumLength = 128;
# The program generating the checksum for the file given as first
@@ -314,8 +307,9 @@ relocated, defaults to C<RELOC>".
=head1 SEE ALSO
-The modules L<TeXLive::TLUtils>, L<TeXLive::TLPSRC>,
-L<TeXLive::TLPDB>, L<TeXLive::TLTREE>, L<TeXLive::TeXCatalogue>.
+All the other TeX Live modules and scripts, especially C<tlmgr> and
+C<install-tl>, and the documentation in the repository:
+C<Master/tlpkg/doc/>.
=head1 AUTHORS AND COPYRIGHT
diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm
index bc4ab402d9d..432011f09e0 100644
--- a/Build/source/texk/tests/TeXLive/TLUtils.pm
+++ b/Build/source/texk/tests/TeXLive/TLUtils.pm
@@ -5,16 +5,9 @@
package TeXLive::TLUtils;
-my $svnrev = '$Revision: 40460 $';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
- $_modulerevision = $1;
-} else {
- $_modulerevision = "unknown";
-}
-sub module_revision {
- return $_modulerevision;
-}
+my $svnrev = '$Revision: 40652 $';
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
+sub module_revision { return $_modulerevision; }
=pod
@@ -97,11 +90,6 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure
TeXLive::TLUtils::forward_slashify($path_from_user);
TeXLive::TLUtils::give_ctan_mirror();
TeXLive::TLUtils::give_ctan_mirror_base();
- TeXLive::TLUtils::tlmd5($path);
- TeXLive::TLUtils::tlchecksum($path);
- TeXLive::TLUtils::setup_gpg();
- TeXLive::TLUtils::verify_checksum($file, $url);
- TeXLive::TLUtils::verify_signature($file, $url);
TeXLive::TLUtils::compare_tlpobjs($tlpA, $tlpB);
TeXLive::TLUtils::compare_tlpdbs($tlpdbA, $tlpdbB);
TeXLive::TLUtils::report_tlpdb_differences(\%ret);
@@ -175,11 +163,6 @@ BEGIN {
&give_ctan_mirror_base
&create_mirror_list
&extract_mirror_entry
- &tlmd5
- &tlchecksum
- &setup_gpg
- &verify_checksum
- &verify_signature
&wsystem
&xsystem
&run_cmd
@@ -205,8 +188,6 @@ BEGIN {
}
use Cwd;
-use Digest::MD5;
-use Digest::SHA;
use Getopt::Long;
use File::Temp;
@@ -221,7 +202,7 @@ $::opt_verbosity = 0; # see process_logging_options
=item C<platform>
-If C<$^O=~/MSWin(32|64)$/i> is true we know that we're on
+If C<$^O =~ /MSWin/i> is true we know that we're on
Windows and we set the global variable C<$::_platform_> to C<win32>.
Otherwise we call C<platform_name> with the output of C<config.guess>
as argument.
@@ -570,7 +551,7 @@ sub run_cmd {
=back
-=head2 File Utilities
+=head2 File utilities
=over 4
@@ -645,8 +626,8 @@ sub basename {
=item C<tl_abs_path($path)>
-# Other than Cwd::abs_path, tl_abs_path also works
-# if only the grandparent exists.
+# Other than Cwd::abs_path, tl_abs_path also works if the argument does not
+# yet exist as long as the path does not contain '..' components.
=cut
@@ -655,33 +636,34 @@ sub tl_abs_path {
if (win32) {
$path=~s!\\!/!g;
}
- my $ret;
- eval {$ret = Cwd::abs_path($path);}; # eval needed for w32
- return $ret if defined $ret;
- # $ret undefined: probably the parent does not exist.
- # But we also want an answer if only the grandparent exists.
- my ($parent, $base) = dirname_and_basename($path);
- return undef unless defined $parent;
- eval {$ret = Cwd::abs_path($parent);};
- if (defined $ret) {
- if ($ret =~ m!/$! or $base =~ m!^/!) {
- $ret = "$ret$base";
- } else {
- $ret = "$ret/$base";
- }
- return $ret;
- } else {
- my ($pparent, $pbase) = dirname_and_basename($parent);
- return undef unless defined $pparent;
- eval {$ret = Cwd::abs_path($pparent);};
- return undef unless defined $ret;
- if ($ret =~ m!/$!) {
- $ret = "$ret$pbase/$base";
- } else {
- $ret = "$ret/$pbase/$base";
- }
- return $ret;
+ if (-e $path) {
+ $path = Cwd::abs_path($path);
+ } elsif ($path eq '.') {
+ $path = Cwd::getcwd();
+ } else{
+ # collapse /./ components
+ $path =~ s!/\./!/!g;
+ # no support for .. path components or for win32 long-path syntax
+ # (//?/ path prefix)
+ die "Unsupported path syntax" if $path =~ m!/\.\./! || $path =~ m!/\.\.$!
+ || $path =~ m!^\.\.!;
+ die "Unsupported path syntax" if win32() && $path =~ m!^//\?/!;
+ if ($path !~ m!^(.:)?/!) { # relative path
+ if (win32() && $path =~ /^.:/) { # drive letter
+ my $dcwd;
+ # starts with drive letter: current dir on drive
+ $dcwd = Cwd::getdcwd ($1);
+ $dcwd .= '/' unless $dcwd =~ m!/$!;
+ return $dcwd.$path;
+ } else { # relative path without drive letter
+ my $cwd = Cwd::getcwd();
+ $cwd .= '/' unless $cwd =~ m!/$!;
+ return $cwd . $path;
+ }
+ } # else absolute path
}
+ $path =~ s!/$!! unless $path =~ m!^(.:)?/$!;
+ return $path;
}
@@ -703,13 +685,19 @@ sub dir_creatable {
#print STDERR "testing $path\n";
$path =~ s!\\!/!g if win32;
return 0 unless -d $path;
- $path =~ s!/$!!;
+ $path .= '/' unless $path =~ m!/$!;
#print STDERR "testing $path\n";
- my $i = 0;
- my $too_large = 100000;
- while ((-e $path . "/" . $i) and $i<$too_large) { $i++; }
- return 0 if $i>=$too_large;
- my $d = $path."/".$i;
+ my $d;
+ for my $i (1..100) {
+ $d = "";
+ # find a non-existent dirname
+ $d = $path . int(rand(1000000));
+ last unless -e $d;
+ }
+ if (!$d) {
+ tlwarn("Cannot find available testdir name\n");
+ return 0;
+ }
#print STDERR "creating $d\n";
return 0 unless mkdir $d;
return 0 unless -d $d;
@@ -728,10 +716,6 @@ a fileserver.
=cut
-# Theoretically, the test below, which uses numbers as names, might
-# lead to a race condition. OTOH, it should work even on a very
-# broken Perl.
-
# The Unix test gives the wrong answer when used under Windows Vista
# with one of the `virtualized' directories such as Program Files:
# lacking administrative permissions, it would write successfully to
@@ -742,14 +726,19 @@ sub dir_writable {
my ($path) = @_;
return 0 unless -d $path;
$path =~ s!\\!/!g if win32;
- $path =~ s!/$!!;
+ $path .= '/' unless $path =~ m!/$!;
my $i = 0;
- my $too_large = 100000;
- while ((-e "$path/$i") && $i < $too_large) {
- $i++;
+ my $f;
+ for my $i (1..100) {
+ $f = "";
+ # find a non-existent filename
+ $f = $path . int(rand(1000000));
+ last unless -e $f;
+ }
+ if (!$f) {
+ tlwarn("Cannot find available testfile name\n");
+ return 0;
}
- return 0 if $ i >= $too_large;
- my $f = "$path/$i";
return 0 if ! open (TEST, ">$f");
my $written = 0;
$written = (print TEST "\n");
@@ -1959,23 +1948,26 @@ sub w32_remove_from_path {
=item C<check_file($what, $checksum, $checksize>
Remove C<$what> if either the given C<$checksum> or C<$checksize> does
-not agree. Does nothing if neither of the check arguments is given.
+not agree. If a check argument is not given, that check is not performed.
=cut
sub check_file {
- my ($xzfile, $checksum, $size) = @_;
+ my ($xzfile, $checksum, $checksize) = @_;
if ($checksum) {
- if (tlchecksum($xzfile) ne $checksum) {
- tlwarn("TLUtils::check_file: found $xzfile, but hashsums differ, removing it.\n");
+ 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");
unlink($xzfile);
return;
}
}
- if ($size) {
+ if ($checksize) {
my $filesize = (stat $xzfile)[7];
- if ($filesize != $size) {
- tlwarn("TLUtils::check_file: found $xzfile, but sizes differ, removing it.\n");
+ if ($filesize != $checksize) {
+ tlwarn("TLUtils::check_file: removing $xzfile, sizes differ:\n");
+ tlwarn("TLUtils::check_file: TL=$filesize, arg=$checksize\n");
unlink($xzfile);
return;
}
@@ -2195,7 +2187,7 @@ sub setup_programs {
$::progs{'xz'} = "xz";
$::progs{'tar'} = "tar";
- if ($^O =~ /^MSWin(32|64)$/i) {
+ if ($^O =~ /^MSWin/i) {
$::progs{'wget'} = conv_to_w32_path("$bindir/wget/wget.exe");
$::progs{'tar'} = conv_to_w32_path("$bindir/tar.exe");
$::progs{'xzdec'} = conv_to_w32_path("$bindir/xz/xzdec.exe");
@@ -2251,9 +2243,11 @@ sub setup_unix_one {
my ($p, $def, $arg, $donotwarn) = @_;
our $tmp;
my $test_fallback = 0;
+ ddebug("trying to set up $p, default $def, arg $arg\n");
if (-r $def) {
my $ready = 0;
if (-x $def) {
+ ddebug("default $def is readable and executable!\n");
# checking only for the executable bit is not enough, we have
# to check for actualy "executability" since a "noexec" mount
# option may interfere, which is not taken into account by
@@ -2739,8 +2733,11 @@ sub _create_config_files {
@lines = <INFILE>;
close (INFILE);
} else {
- tlwarn("TLUtils::_create_config_files: $root/$headfile: "
- . " head file not found, ok in user mode");
+ tlwarn("TLUtils::_create_config_files: $root/$headfile missing!\n");
+ # TODO
+ # if we allow tlmgr generate to generate language.* file in usermode
+ # we need to remove the die here!
+ die ("Giving up.");
}
push @lines, @$tlpdblinesref;
if (defined($localconf) && -r $localconf) {
@@ -2997,13 +2994,16 @@ directory (Unix) or the root of a drive (Windows).
sub texdir_check {
my $texdir = shift;
return 0 unless defined $texdir;
- # convert to absolute/canonical, for safer parsing
- # tl_abs_path should work as long as grandparent exists
+ # 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/volume,
+ # 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;
@@ -3136,11 +3136,12 @@ sub dddebug {
}
}
-
=item C<log ($str1, $str2, ...)>
Write a message to the log file (and nowhere else), the concatenation of
-the argument strings.
+the argument strings. The log file may not ever be defined (e.g., the
+C<-logfile> option isn't given), in which case the message will never be
+written anywhere.
=cut
@@ -3151,7 +3152,6 @@ sub log {
$::opt_quiet = $savequiet;
}
-
=item C<tlwarn ($str1, $str2, ...)>
Write a warning message, the concatenation of the argument strings.
@@ -3284,7 +3284,7 @@ sub process_logging_options {
This function takes a single argument I<path> and returns it with
C<"> chars surrounding it on Unix. On Windows, the C<"> chars are only
-added if I<path> a few special characters, since unconditional quoting
+added if I<path> contains special characters, since unconditional quoting
leads to errors there. In all cases, any C<"> chars in I<path> itself
are (erroneously) eradicated.
@@ -3577,81 +3577,6 @@ sub extract_mirror_entry {
return $foo[$#foo] . "/" . $TeXLive::TLConfig::TeXLiveServerPath;
}
-sub tlmd5 {
- my ($file) = @_;
- if (-r $file) {
- open(FILE, $file) || die "open($file) failed: $!";
- binmode(FILE);
- my $md5hash = Digest::MD5->new->addfile(*FILE)->hexdigest;
- close(FILE);
- return $md5hash;
- } else {
- tlwarn("tlmd5, given file not readable: $file\n");
- return "";
- }
-}
-
-sub tldigest {
- return (Digest::SHA::sha512_hex(shift));
-}
-sub tl_short_digest {
- return (Digest::MD5::md5_hex(shift));
-}
-
-sub tlchecksum {
- my ($file) = @_;
- if (-r $file) {
- open(FILE, $file) || die "open($file) failed: $!";
- binmode(FILE);
- my $cshash = Digest::SHA->new(512)->addfile(*FILE)->hexdigest;
- close(FILE);
- return $cshash;
- } else {
- tlwarn("tlchecksum: given file not readable: $file\n");
- return "";
- }
-}
-
-sub tlchecksum_data {
- my ($data) = @_;
- my $cshash = Digest::SHA->new(512)->add($data)->hexdigest;
- return $cshash;
-}
-
-
-=pod
-
-=item C<< setup_gpg() >>
-
-Tries to set up gpg command line C<$::gpg> used for
-verification of downloads.
-
-Returns 1/0 on success/failure.
-
-=cut
-
-sub setup_gpg {
- my $master = shift;
- # first search for a gpg binary
- return 0 if (!setup_unix_one( 'gpg' , '/no/such/path', '--version', 1));
- # ok, we found one
- # Set up the gpg invocation:
- $::gpg = "$::progs{'gpg'} ";
- my $gpghome = ($ENV{'TL_GNUPGHOME'} ? $ENV{'TL_GNUPGHOME'} :
- "$master/tlpkg/gpg" );
- $gpghome =~ s!/!\\!g if win32();
- my $gpghome_quote = "\"$gpghome\"";
- # mind the final space for following args
- $::gpg .= "--homedir $gpghome_quote ";
- if ($ENV{'TL_GNUPGARGS'}) {
- $::gpg .= $ENV{'TL_GNUPGARGS'};
- } else {
- $::gpg .= "--no-secmem-warning --no-permission-warning ";
- }
- debug("gpg command line: $::gpg\n");
- return 1;
-}
-
=pod
=item C<< slurp_file($file) >>
@@ -3670,51 +3595,6 @@ sub slurp_file {
return($file_data);
}
-
-=pod
-
-=item C<< verify_checksum($file, $checksum_url) >>
-
-Verifies that C<$file> has checksum C<$checksum_url>.
-
-Returns 0 on success, -1 on connection error, 1 on checksum error.
-In case of errors returns an informal message as second argument.
-
-=cut
-
-sub verify_checksum {
- my ($file, $checksum_url) = @_;
- my $checksum_file = download_to_temp_or_file($checksum_url);
- # next step is verification of tlpdb checksum with checksum file
- # existenc of checksum_file was checked above
- if (!$checksum_file) {
- return(-1, "download did not succeed: $checksum_url");
- }
- # check the signature
- my ($ret, $msg) = verify_signature($checksum_file, $checksum_url);
- return ($ret, $msg) if ($ret != 0);
-
- # verify local data
- open $cs_fh, "<$checksum_file" or die("cannot read file: $!");
- if (read ($cs_fh, $remote_digest, $ChecksumLength) != $ChecksumLength) {
- close($cs_fh);
- return(1, "incomplete read from $checksum_file");
- } else {
- close($cs_fh);
- ddebug("found remote digest: $remote_digest\n");
- }
- $local_digest = tlchecksum($file);
- ddebug("local_digest = $local_digest\n");
- if ($local_digest ne $remote_digest) {
- return(1, "digest disagree");
- }
-
- # we are still here, so checksum also succeeded
- debug("checksum of local copy identical with remote hash\n");
-
- return(0);
-}
-
=pod
=item C<< download_to_temp_or_file($url) >>
@@ -3747,66 +3627,6 @@ sub download_to_temp_or_file {
return;
}
-=pod
-
-=item C<< verify_signature($file, $url) >>
-
-Verifies a download of C<$url> into C<$file> by cheking the
-gpg signature in C<$url.asc>.
-
-Returns 0 on success, -1 on connection error, 1 on checksum error.
-In case of errors returns an informal message as second argument.
-
-=cut
-
-sub verify_signature {
- my ($file, $url) = @_;
- my $signature_url = "$url.asc";
-
- # if we have $::gpg set, we try to verify cryptographic signatures
- if ($::gpg) {
- my $signature_file = download_to_temp_or_file($signature_url);
- if ($signature_file) {
- if (TeXLive::TLUtils::gpg_verify_signature($file, $signature_file)) {
- info("cryptographic signature of $url verified\n");
- } else {
- return(1, <<GPGERROR);
-cryptograpic verification of
- $file
-against
- $signature_url
-failed. Please report to texlive\@tug.org
-GPGERROR
- }
- } else {
- debug("no access to cryptographic signature $signature_url\n");
- }
- } else {
- debug("gpg prog not defined, no checking of signatures\n");
- }
- return (0);
-}
-
-sub gpg_verify_signature {
- my ($file, $sig) = @_;
- my ($file_quote, $sig_quote);
- if (win32()) {
- $file =~ s!/!\\!g;
- $sig =~ s!/!\\!g;
- }
- $file_quote = "\"$file\"";
- $sig_quote = "\"$sig\"";
- my ($out, $ret) = run_cmd("$::gpg --verify $sig_quote $file_quote 2>&1");
- if ($ret == 0) {
- debug("verification succeeded, output:\n$out\n");
- return 1;
- } else {
- tlwarn("verification failed, output:\n$out\n");
- return 0;
- }
-}
-
-#
# compare_tlpobjs
# returns a hash
# $ret{'revision'} = "leftRev:rightRev" if revision differ
@@ -4136,10 +3956,9 @@ __END__
=head1 SEE ALSO
-The modules L<TeXLive::TLPSRC>, L<TeXLive::TLPOBJ>,
-L<TeXLive::TLPDB>, L<TeXLive::TLTREE>, and the
-document L<Perl-API.txt> and the specification in the TeX Live
-repository trunk/Master/tlpkg/doc/.
+The modules L<TeXLive::TLConfig>, L<TeXLive::TLCrypto>,
+L<TeXLive::TLDownload>, L<TeXLive::TLWinGoo>, etc., and the
+documentation in the repository: C<Master/tlpkg/doc/>.
=head1 AUTHORS AND COPYRIGHT
diff --git a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
index a62571837ae..3661c885216 100755
--- a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
+++ b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
@@ -1,13 +1,13 @@
#!/usr/bin/env perl
-# $Id: tlmgr.pl 40640 2016-04-21 00:31:43Z preining $
+# $Id: tlmgr.pl 40652 2016-04-21 19:08:52Z karl $
#
# Copyright 2008-2016 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
-my $svnrev = '$Revision: 40640 $';
-my $datrev = '$Date: 2016-04-21 02:31:43 +0200 (Thu, 21 Apr 2016) $';
+my $svnrev = '$Revision: 40652 $';
+my $datrev = '$Date: 2016-04-21 21:08:52 +0200 (Thu, 21 Apr 2016) $';
my $tlmgrrevision;
my $prg;
if ($svnrev =~ m/: ([0-9]+) /) {
@@ -91,7 +91,6 @@ BEGIN {
use Cwd qw/abs_path/;
use File::Spec;
-use Digest::MD5;
use Pod::Usage;
use Getopt::Long qw(:config no_autoabbrev permute);
use strict;
@@ -103,6 +102,7 @@ use TeXLive::TLUtils;
use TeXLive::TLWinGoo;
use TeXLive::TLDownload;
use TeXLive::TLConfFile;
+use TeXLive::TLCrypto;
TeXLive::TLUtils->import(qw(member info give_ctan_mirror win32 dirname
mkdirhier copy debug tlcmp));
use TeXLive::TLPaper;
@@ -5710,7 +5710,7 @@ sub handle_gpg_config_settings {
}
# now we know whether we setup gpg or not
if ($do_setup_gpg) {
- if (TeXLive::TLUtils::setup_gpg($Master)) {
+ if (TeXLive::TLCrypto::setup_gpg($Master)) {
debug("will verify cryptographic signatures\n")
} else {
my $prefix = "$prg: No gpg found"; # just to shorten the strings
@@ -5722,8 +5722,9 @@ sub handle_gpg_config_settings {
# verification explicitely requested in config file, but not gpg, die
tldie("$prefix, verification explicitly requested in config file, quitting.\n");
}
- # it was requested via the default setting, so just warn
- info ("$prefix, verification implicitly requested, "
+ # it was requested via the default setting, so just debug it
+ # the list of repositories will contain verified/not verified statements
+ debug ("$prefix, verification implicitly requested, "
. "continuing without verification\n");
}
} else {
@@ -5819,12 +5820,15 @@ sub init_tlmedia {
# this "location-url" line should not be changed since GUI programs
# depend on it:
print "location-url\t$locstr\n" if $::machinereadable;
- info("$prg: package repositories" .
- ($::gpg ? " (all verified)" : "") . ":\n");
- info("\tmain = " . $repos{'main'} . "\n");
+ info("$prg: package repositories\n");
+ info("\tmain = " . $repos{'main'} . " (" .
+ ($remotetlpdb->virtual_get_tlpdb('main')->is_verified ? "" : "not ") .
+ "verified)\n");
for my $t (@tags) {
if ($t ne 'main') {
- info("\t$t = " . $repos{$t} . "\n");
+ info("\t$t = " . $repos{$t} . " (" .
+ ($remotetlpdb->virtual_get_tlpdb($t)->is_verified ? "" : "not ") .
+ "verified)\n");
}
}
return 1;
@@ -5859,8 +5863,8 @@ sub _init_tlmedia {
# this "location-url" line should not be changed since GUI programs
# depend on it:
print "location-url\t$location\n" if $::machinereadable;
- info("$prg: package repository $location" .
- ($::gpg ? " (verified)" : "") . "\n");
+ info("$prg: package repository $location (" .
+ ($remotetlpdb->is_verified ? "" : "not ") . "verified)\n");
return 1;
}
@@ -5890,7 +5894,7 @@ sub setup_one_remotetlpdb {
my $local_copy_tlpdb_used = 0;
if ($location =~ m;^(http|ftp)://;) {
# first check that the saved tlpdb is present at all
- my $loc_digest = TeXLive::TLUtils::tl_short_digest($location);
+ my $loc_digest = TeXLive::TLCrypto::tl_short_digest($location);
my $loc_copy_of_remote_tlpdb =
"$Master/$InfraLocation/texlive.tlpdb.$loc_digest";
ddebug("loc_digest = $loc_digest\n");
@@ -5902,8 +5906,9 @@ sub setup_one_remotetlpdb {
my $path = "$location/$InfraLocation/$DatabaseName.$TeXLive::TLConfig::ChecksumExtension";
ddebug("remote path of digest = $path\n");
- my ($ret, $msg) = TeXLive::TLUtils::verify_checksum($loc_copy_of_remote_tlpdb, $path);
- if ($ret < 0) {
+ my ($ret,$msg)
+ = TeXLive::TLCrypto::verify_checksum($loc_copy_of_remote_tlpdb, $path);
+ if ($ret == -1) {
info(<<END_NO_INTERNET);
No connection to the internet.
Unable to download the checksum of the remote TeX Live database,
@@ -5919,6 +5924,9 @@ END_NO_INTERNET
$remotetlpdb = TeXLive::TLPDB->new(root => $location,
tlpdbfile => $loc_copy_of_remote_tlpdb);
$local_copy_tlpdb_used = 1;
+ } elsif ($ret == -2) {
+ # the remote database has not be signed, warn
+ debug("$0: remote database is not signed, continuing anyway!\n");
} elsif ($ret == 1) {
# no problem, checksum is wrong, we need to get new tlpdb
} elsif ($ret == 2) {
@@ -6014,7 +6022,7 @@ FROZEN
# make sure that the writeout of the tlpdb is done in UNIX mode
# since otherwise the checksum will change.
if (!$local_copy_tlpdb_used && $location =~ m;^(http|ftp)://;) {
- my $loc_digest = TeXLive::TLUtils::tl_short_digest($location);
+ my $loc_digest = TeXLive::TLCrypto::tl_short_digest($location);
my $loc_copy_of_remote_tlpdb =
"$Master/$InfraLocation/texlive.tlpdb.$loc_digest";
my $tlfh;
diff --git a/Build/source/texk/texlive/tests/updmap-cmdline-test.pl b/Build/source/texk/texlive/tests/updmap-cmdline-test.pl
index fa209c95cff..955796f06cc 100755
--- a/Build/source/texk/texlive/tests/updmap-cmdline-test.pl
+++ b/Build/source/texk/texlive/tests/updmap-cmdline-test.pl
@@ -10,11 +10,12 @@ require "$srcdir/../tests/common-test.pl";
exit (&main ());
sub main {
- my $ret = &test_run ("$srcdir/linked_scripts/texlive/updmap.pl", "--version");
+ my $ret = &test_run ("$srcdir/linked_scripts/texlive/updmap.pl","--version");
+
+ # erroneous invocations we should check for and/or handle better:
+ # updmap foo
+ # updmap --enable Map
- # we aren't going to fix this in the current updmap.pl.
- # "foo", "--enable Map"
- # "-n", "--quiet",
my $bad = $ret != 0;
return $bad;
}