summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2016-04-21 19:08:52 +0000
committerKarl Berry <karl@freefriends.org>2016-04-21 19:08:52 +0000
commit5aa28567dca799a746db5c20e400edcfc4031be1 (patch)
tree58ef62fb29b5c4f38158036b3d640c42ce73f2df
parent525c559215b4d53a04b0f291b9c45619bc0f0f21 (diff)
TLCrypto.pm: new module with all the functions using digests/gpg,
extracted from TLUtils.pm. TLUtils.pm: functions moved from here, change calls. TLConfig.pm: doc. TLPDB.pm, TLPOBJ.pm, install-tl, tlmgr.pl: use TLCrypto, change calls, doc. git-svn-id: svn://tug.org/texlive/trunk@40652 c570f23f-e606-0410-a88d-b1316a301751
-rwxr-xr-xMaster/install-tl3
-rwxr-xr-xMaster/texmf-dist/scripts/texlive/tlmgr.pl40
-rw-r--r--Master/tlpkg/TeXLive/TLConfig.pm18
-rw-r--r--Master/tlpkg/TeXLive/TLCrypto.pm372
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm22
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm26
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm290
7 files changed, 427 insertions, 344 deletions
diff --git a/Master/install-tl b/Master/install-tl
index 9a1244898bf..85b7a9f8df2 100755
--- a/Master/install-tl
+++ b/Master/install-tl
@@ -54,6 +54,7 @@ use TeXLive::TLUtils qw(platform platform_desc sort_archs
use TeXLive::TLPOBJ;
use TeXLive::TLPDB;
use TeXLive::TLConfig;
+use TeXLive::TLCrypto;
use TeXLive::TLDownload;
use TeXLive::TLPaper;
@@ -342,7 +343,7 @@ if ($opt_print_arch) {
# try to setup gpg
if ($opt_verify_downloads) {
- if (TeXLive::TLUtils::setup_gpg($::installerdir)) {
+ if (TeXLive::TLCrypto::setup_gpg($::installerdir)) {
log("Trying to verify cryptographic signatures!\n")
} else {
tlwarn("Couldn't detect gpg so will proceed without verification!\n");
diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index 8efa365f719..5dc5f755f48 100755
--- a/Master/texmf-dist/scripts/texlive/tlmgr.pl
+++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl
@@ -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
@@ -5894,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");
@@ -5906,7 +5906,8 @@ 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);
+ 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.
@@ -6021,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;
@@ -7574,11 +7575,11 @@ a different hash), it's harmless to delete them.
=head1 CRYPTOGRAPHIC VERIFICATION
-If a working GnuPG binary (C<gpg>) is found (see below for how it is
-searched), by default verification of
-downloaded files is performed. This can be supressed by specifying
-C<--no-verify-downloads> on the command line, or adding an entry
-C<verify-downloads = 0> to a tlmgr config file.
+If a working GnuPG binary (C<gpg>) is found (see below for the search
+method), by default verification of downloaded files is performed. This
+can be suppressed by specifying C<--no-verify-downloads> on the command
+line, or adding an entry C<verify-downloads = 0> to a tlmgr config file
+(described in another section below).
Verification is performed as follows: For each C<texlive.tlpdb> loaded
for a repository, the respective checksum C<texlive.tlpdb.sha512> is
@@ -7586,11 +7587,12 @@ always downloaded, too, and C<tlmgr> confirms whether the checksum
of the download tlpdb file agrees with the download data. This is done
in any case.
-If cryptographic verification is done, then a signature of the checksum
-file is downloaded and the signature verified. The signature is done with
-the TeX Live Distribution GPG key 0x06BAB6BC, which in turn is signed
-by Karl Berry's key 0x9DEB46C0 and Norbert Preining's key 0x6CACA448.
-All of these keys are obtainable from the standard key servers.
+If cryptographic verification is also requested, then a signature of the
+checksum file is downloaded and the signature verified. The signature is
+done with the TeX Live Distribution GPG key 0x06BAB6BC, which in turn is
+signed by Karl Berry's key 0x9DEB46C0 and Norbert Preining's key
+0x6CACA448. All of these keys are obtainable from the standard key
+servers.
=head2 Configuration of GnuPG invocation
@@ -7598,10 +7600,10 @@ The executable used for GnuPG is searched as follows: If the environment
variable C<TL_GNUPG> is set, it is tested and used. Otherwise C<gpg> is
checked, and finally C<gpg2>.
-Further adaption of the invocation of C<gpg> can be done using the
-two enviroment variables C<TL_GNUPGHOME>, which is passed to
-C<gpg> with C<--homedir>, and C<TL_GNUPGARGS>, which replaces the
-default arguments C<--no-secmem-warning --no-permission-warning>.
+Further adaptation of the C<gpg> invocation can be made using the two
+enviroment variables C<TL_GNUPGHOME>, which is passed to C<gpg> as the
+value for C<--homedir>, and C<TL_GNUPGARGS>, which replaces the default
+arguments C<--no-secmem-warning --no-permission-warning>.
=head1 USER MODE
diff --git a/Master/tlpkg/TeXLive/TLConfig.pm b/Master/tlpkg/TeXLive/TLConfig.pm
index 80ba9acf0c8..2b980b2034a 100644
--- a/Master/tlpkg/TeXLive/TLConfig.pm
+++ b/Master/tlpkg/TeXLive/TLConfig.pm
@@ -7,15 +7,8 @@
package TeXLive::TLConfig;
my $svnrev = '$Revision$';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
- $_modulerevision = $1;
-} else {
- $_modulerevision = "unknown";
-}
-sub module_revision {
- return $_modulerevision;
-}
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
+sub module_revision { return $_modulerevision; }
BEGIN {
use Exporter ();
@@ -218,7 +211,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
@@ -315,8 +308,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/Master/tlpkg/TeXLive/TLCrypto.pm b/Master/tlpkg/TeXLive/TLCrypto.pm
new file mode 100644
index 00000000000..122e0b1818a
--- /dev/null
+++ b/Master/tlpkg/TeXLive/TLCrypto.pm
@@ -0,0 +1,372 @@
+# $Id$
+# TeXLive::TLcrypto.pm - handle checksums and signatures.
+# Copyright 2016 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+
+package TeXLive::TLCrypto;
+
+use Digest::MD5;
+use Digest::SHA;
+
+use TeXLive::TLConfig;
+use TeXLive::TLUtils qw(debug ddebug win32);
+
+my $svnrev = '$Revision: 40650 $';
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
+sub module_revision { return $_modulerevision; }
+
+=pod
+
+=head1 NAME
+
+C<TeXLive::TLCrypto> -- checksums and cryptographic signatures
+
+=head1 SYNOPSIS
+
+ use TeXLive::TLCrypto; # requires Digest::MD5 and Digest::SHA
+
+=head2 Checksums
+
+ TeXLive::TLCrypto::tlchecksum($path);
+ TeXLive::TLCrypto::tlmd5($path);
+ TeXLive::TLCrypto::verify_checksum($file, $url);
+
+=head2 Signatures
+
+ TeXLive::TLCrypto::setup_gpg();
+ TeXLive::TLCrypto::verify_signature($file, $url);
+
+=head1 DESCRIPTION
+
+=cut
+
+BEGIN {
+ use Exporter ();
+ use vars qw(@ISA @EXPORT_OK @EXPORT);
+ @ISA = qw(Exporter);
+ @EXPORT_OK = qw(
+ &tlchecksum
+ &tlmd5
+ &tldigest
+ &tl_short_digest
+ &tlmd5
+ &verify_checksum
+ &setup_gpg
+ &verify_signature
+ );
+}
+
+=pod
+
+=item C<< tlchecksum($file) >>
+
+Return checksum of C<$file>.
+
+=cut
+
+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<< tlmd5($file) >>
+
+Return md5, specifically, of C<$file>.
+
+=cut
+
+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 "";
+ }
+}
+
+=pod
+
+=item C<< tldigest($str) >>
+
+=item C<< tl_short_digest($str) >>
+
+Return full and short digests of C<$str>, respectively.
+
+=cut
+
+sub tldigest { return (Digest::SHA::sha512_hex(shift)); }
+sub tl_short_digest { return (Digest::MD5::md5_hex(shift)); }
+
+# emacs-page
+=pod
+
+=item C<< verify_checksum($file, $checksum_url) >>
+
+Verifies that C<$file> has checksum C<$checksum_url>, and if gpg is
+available also verifies that the checksum is signed.
+
+Returns 0 on success, -1 on connection error, -2 on missing signature
+file, 1 on checksum, and 2 on signature errors.
+In case of errors returns an informal message as second argument.
+
+=cut
+
+sub verify_checksum {
+ my ($file, $checksum_url) = @_;
+ my $checksum_file
+ = TeXLive::TLUtils::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);
+}
+
+# emacs-page
+=pod
+
+=item C<< setup_gpg() >>
+
+Tries to set up gpg command line C<$::gpg> used for verification of
+downloads. Checks for the environment variable C<TL_GNUPG>; if that
+envvar is not set, first C<gpg>, then C<gpg2>, then, on Windows only,
+C<tlpkg/installer/gpg/gpg.exe> is looked for. Further adaptation of the
+invocation of C<gpg> can be done using the two enviroment variables
+C<TL_GNUPGHOME>, which is passed to C<gpg> with C<--homedir>, and
+C<TL_GNUPGARGS>, which replaces the default arguments
+C<--no-secmem-warning --no-permission-warning>.
+
+Returns 1/0 on success/failure.
+
+=cut
+
+sub setup_gpg {
+ my $master = shift;
+ my $found = 0;
+ my $prg;
+ if ($ENV{'TL_GNUPG'}) {
+ # if envvar is set, don't look for anything else.
+ $prg = test_one_gpg($ENV{'TL_GNUPG'});
+ $found = 1 if ($prg);
+ } else {
+ # no envvar, look for gpg
+ $prg = test_one_gpg('gpg');
+ $found = 1 if ($prg);
+
+ # no gpg, look for gpg2
+ if (!$found) {
+ $prg = test_one_gpg('gpg2');
+ $found = 1 if ($prg);
+ }
+ if (!$found) {
+ # test also a shipped version from tlgpg
+ my $p = "$master/tlpkg/installer/gpg/gpg." .
+ ($^O =~ /^MSWin/i ? "exe" : platform()) ;
+ debug("Testing for gpg in $p\n");
+ if (-r $p) {
+ if ($^O =~ /^MSWin/i) {
+ $prg = conv_to_w32_path($p);
+ } else {
+ $prg = "\"$p\"";
+ }
+ $found = 1;
+ }
+ }
+ }
+ return 0 if (!$found);
+
+ # $prg is already properly quoted!
+
+ # ok, we found one
+ # Set up the gpg invocation:
+ 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 = "$prg --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;
+}
+
+sub test_one_gpg {
+ my $prg = shift;
+ my $cmdline;
+ debug("Testing for gpg in $prg\n");
+ if ($^O =~ /^MSWin/i) {
+ # Perl on Windows somehow does not allow calling a program
+ # without a full path - at least a call to "gpg" tells me
+ # that "c:/Users/norbert/gpg" is not recognized ...
+ # consequence - use which!
+ $prg = which($prg);
+ return "" if (!$prg);
+ $prg = conv_to_w32_path($prg);
+ $cmdline = "$prg --version >nul 2>&1";
+ } else {
+ $cmdline = "$prg --version >/dev/null 2>&1";
+ }
+ my $ret = system($cmdline);
+ if ($ret == 0) {
+ debug(" ... found!\n");
+ return $prg;
+ } else {
+ debug(" ... not found!\n");
+ return "";
+ }
+}
+
+# emacs-page
+=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, -2 on missing signature file, 2 on signature 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
+ = TeXLive::TLUtils::download_to_temp_or_file($signature_url);
+ if ($signature_file) {
+ my ($ret, $out) = gpg_verify_signature($file, $signature_file);
+ if ($ret) {
+ # no need to show the output
+ debug("cryptographic signature of $url verified\n");
+ return(0);
+ } else {
+ return(2, <<GPGERROR);
+cryptographic signature verification of
+ $file
+against
+ $signature_url
+failed. Output was
+$out
+Please report to texlive\@tug.org
+GPGERROR
+ }
+ } else {
+ debug("no access to cryptographic signature $signature_url\n");
+ return(-2, "no access to cryptographic signature");
+ }
+ } else {
+ debug("gpg prog not defined, no checking of signatures\n");
+ # we return 0 (= success) if not gpg is available
+ return(0);
+ }
+ # not reached
+ return (0);
+}
+
+=pod
+
+=item C<< gpg_verify_signature($file, $sig) >>
+
+Internal routine running gpg to verify signature C<$sig> of C<$file>.
+
+=cut
+
+sub gpg_verify_signature {
+ my ($file, $sig) = @_;
+ my ($file_quote, $sig_quote);
+ if (win32()) {
+ $file =~ s!/!\\!g;
+ $sig =~ s!/!\\!g;
+ }
+ $file_quote = TeXLive::TLUtils::quotify_path_with_spaces ($file);
+ $sig_quote = TeXLive::TLUtils::quotify_path_with_spaces ($sig);
+ my ($out, $ret)
+ = TeXLive::TLUtils::run_cmd("$::gpg --verify $sig_quote $file_quote 2>&1");
+ if ($ret == 0) {
+ debug("verification succeeded, output:\n$out\n");
+ return (1, $out);
+ } else {
+ return (0, $out);
+ }
+}
+
+=back
+=cut
+1;
+__END__
+
+=head1 SEE ALSO
+
+The modules L<TeXLive::Config>, L<TeXLive::TLUtils>, etc.,
+and the documentation in the repository: C<Master/tlpkg/doc/>.
+Also the standard modules L<Digest::MD5> and L<Digest::SHA>.
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 2e85fb82e1f..638ed15e826 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -7,15 +7,8 @@
package TeXLive::TLPDB;
my $svnrev = '$Revision$';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
- $_modulerevision = $1;
-} else {
- $_modulerevision = "unknown";
-}
-sub module_revision {
- return $_modulerevision;
-}
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
+sub module_revision { return $_modulerevision; }
=pod
@@ -370,7 +363,7 @@ sub from_file {
#
# before we open and proceed, verify the downloaded file
if ($params{'verify'} && $media ne 'local_uncompressed') {
- my ($r, $m) = TeXLive::TLUtils::verify_checksum($tlpdbfile, "$path.$TeXLive::TLConfig::ChecksumExtension");
+ my ($r, $m) = TeXLive::TLCrypto::verify_checksum($tlpdbfile, "$path.$TeXLive::TLConfig::ChecksumExtension");
if ($r == 1) {
tldie("$0: checksum error when downloading $tlpdbfile from $path: $m\n");
} elsif ($r == 2) {
@@ -388,7 +381,7 @@ sub from_file {
open($retfh, "<$tlpdbfile") || die "$0: open($tlpdbfile) failed: $!";
} else {
if ($params{'verify'} && $media ne 'local_uncompressed') {
- my ($r, $m) = TeXLive::TLUtils::verify_checksum($path, "$path.$TeXLive::TLConfig::ChecksumExtension");
+ my ($r, $m) = TeXLive::TLCrypto::verify_checksum($path, "$path.$TeXLive::TLConfig::ChecksumExtension");
if ($r == 1) {
tldie("$0: checksum error when downloading $tlpdbfile from $path: $m\n");
} elsif ($r == 2) {
@@ -2733,10 +2726,9 @@ C<00texlive.config.tlpsrc>.
=head1 SEE ALSO
-The modules L<TeXLive::TLPSRC>, L<TeXLive::TLPOBJ>,
-L<TeXLive::TLTREE>, L<TeXLive::TLUtils> and the
-document L<Perl-API.txt> and the specification in the TeX Live
-repository trunk/Master/tlpkg/doc/.
+The modules L<TeXLive::TLPSRC>, L<TeXLive::TLPOBJ>, L<TeXLive::TLTREE>,
+L<TeXLive::TLUtils>, etc., and the documentation in the repository:
+C<Master/tlpkg/doc/>.
=head1 AUTHORS AND COPYRIGHT
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 8cb9b6d4d79..f152f85d676 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -1,4 +1,4 @@
-# $Id: TLPOBJ.pm 40251 2016-04-05 21:18:12Z karl $
+# $Id$
# TeXLive::TLPOBJ.pm - module for using tlpobj files
# Copyright 2007-2016 Norbert Preining
# This file is licensed under the GNU General Public License version 2
@@ -6,6 +6,10 @@
package TeXLive::TLPOBJ;
+my $svnrev = '$Revision$';
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
+sub module_revision { return $_modulerevision; }
+
use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp
$MetaCategoriesRegexp $InfraLocation
$RelocPrefix $RelocTree);
@@ -15,16 +19,6 @@ use TeXLive::TLTREE;
our $_tmp;
my $_containerdir;
-my $svnrev = '$Revision: 40251 $';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
- $_modulerevision = $1;
-} else {
- $_modulerevision = "unknown";
-}
-sub module_revision {
- return $_modulerevision;
-}
sub new {
my $class = shift;
@@ -688,7 +682,7 @@ sub make_container {
return (0, 0, "");
}
my $size = (stat "$destdir/$containername") [7];
- my $checksum = TeXLive::TLUtils::tlchecksum("$destdir/$containername");
+ my $checksum = TeXLive::TLCrypto::tlchecksum("$destdir/$containername");
# cleaning up
unlink("$tlpobjdir/$self->{'name'}.tlpobj");
@@ -757,7 +751,7 @@ sub update_from_catalogue {
$foo =~ s/^.Date: //;
# trying to extract the interesting part of a subversion date
# keyword expansion here, e.g.,
- # $Date: 2016-04-06 06:18:12 +0900 (Wed, 06 Apr 2016) $
+ # $Date$
# ->2007-08-15 19:43:35 +0100
$foo =~ s/ \(.*\)( *\$ *)$//; # maybe nothing after parens
$self->cataloguedata->{'date'} = $foo;
@@ -1715,8 +1709,10 @@ lines for language.dat.lua that can be generated from the tlpobj.
=head1 SEE ALSO
-The modules L<TeXLive::TLConfig>, L<TeXLive::TLUtils>, L<TeXLive::TLPSRC>,
-L<TeXLive::TLPDB>, L<TeXLive::TLTREE>, L<TeXLive::TeXCatalogue>.
+The modules L<TeXLive::TLConfig>, L<TeXLive::TLCrypto>,
+L<TeXLive::TLUtils>, L<TeXLive::TLPSRC>, L<TeXLive::TLPDB>,
+L<TeXLive::TLTREE>, L<TeXLive::TeXCatalogue>, etc., and the
+documentation in the repository: C<Master/tlpkg/doc/>.
=head1 AUTHORS AND COPYRIGHT
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 2a6c4192395..eedc1175183 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -7,15 +7,8 @@
package TeXLive::TLUtils;
my $svnrev = '$Revision$';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
- $_modulerevision = $1;
-} else {
- $_modulerevision = "unknown";
-}
-sub module_revision {
- return $_modulerevision;
-}
+my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
+sub module_revision { return $_modulerevision; }
=pod
@@ -98,11 +91,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);
@@ -176,11 +164,6 @@ BEGIN {
&give_ctan_mirror_base
&create_mirror_list
&extract_mirror_entry
- &tlmd5
- &tlchecksum
- &setup_gpg
- &verify_checksum
- &verify_signature
&wsystem
&xsystem
&run_cmd
@@ -206,8 +189,6 @@ BEGIN {
}
use Cwd;
-use Digest::MD5;
-use Digest::SHA;
use Getopt::Long;
use File::Temp;
@@ -571,7 +552,7 @@ sub run_cmd {
=back
-=head2 File Utilities
+=head2 File utilities
=over 4
@@ -1975,7 +1956,7 @@ not agree. If a check argument is not given, that check is not performed.
sub check_file {
my ($xzfile, $checksum, $checksize) = @_;
if ($checksum) {
- my $tlchecksum = tlchecksum($xzfile);
+ 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");
@@ -3304,7 +3285,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.
@@ -3597,145 +3578,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. Checks for the environment variable C<TL_GNUPG>; if that
-envvar is not set, first C<gpg>, then C<gpg2>, then, on Windows only,
-C<tlpkg/installer/gpg/gpg.exe> is looked for. Further adaptation of the
-invocation of C<gpg> can be done using the two enviroment variables
-C<TL_GNUPGHOME>, which is passed to C<gpg> with C<--homedir>, and
-C<TL_GNUPGARGS>, which replaces the default arguments
-C<--no-secmem-warning --no-permission-warning>.
-
-Returns 1/0 on success/failure.
-
-=cut
-
-sub test_one_gpg {
- my $prg = shift;
- my $cmdline;
- debug("Testing for gpg in $prg\n");
- if ($^O =~ /^MSWin/i) {
- # Perl on Windows somehow does not allow calling a program
- # without a full path - at least a call to "gpg" tells me
- # that "c:/Users/norbert/gpg" is not recognized ...
- # consequence - use which!
- $prg = which($prg);
- return "" if (!$prg);
- $prg = conv_to_w32_path($prg);
- $cmdline = "$prg --version >nul 2>&1";
- } else {
- $cmdline = "$prg --version >/dev/null 2>&1";
- }
- my $ret = system($cmdline);
- if ($ret == 0) {
- debug(" ... found!\n");
- return $prg;
- } else {
- debug(" ... not found!\n");
- return "";
- }
-}
-
-sub setup_gpg {
- my $master = shift;
- my $found = 0;
- my $prg;
- if ($ENV{'TL_GNUPG'}) {
- # if envvar is set, don't look for anything else.
- $prg = test_one_gpg($ENV{'TL_GNUPG'});
- $found = 1 if ($prg);
- } else {
- # no envvar, look for gpg
- $prg = test_one_gpg('gpg');
- $found = 1 if ($prg);
-
- # no gpg, look for gpg2
- if (!$found) {
- $prg = test_one_gpg('gpg2');
- $found = 1 if ($prg);
- }
- if (!$found) {
- # test also a shipped version from tlgpg
- my $p = "$master/tlpkg/installer/gpg/gpg." .
- ($^O =~ /^MSWin/i ? "exe" : platform()) ;
- debug("Testing for gpg in $p\n");
- if (-r $p) {
- if ($^O =~ /^MSWin/i) {
- $prg = conv_to_w32_path($p);
- } else {
- $prg = "\"$p\"";
- }
- $found = 1;
- }
- }
- }
- return 0 if (!$found);
-
- # $prg is already properly quoted!
-
- # ok, we found one
- # Set up the gpg invocation:
- 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 = "$prg --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) >>
@@ -3754,53 +3596,6 @@ sub slurp_file {
return($file_data);
}
-
-=pod
-
-=item C<< verify_checksum($file, $checksum_url) >>
-
-Verifies that C<$file> has checksum C<$checksum_url>, and if gpg is
-available also verifies that the checksum is signed.
-
-Returns 0 on success, -1 on connection error, -2 on missing signature
-file, 1 on checksum, and 2 on signature errors.
-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) >>
@@ -3833,74 +3628,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, -2 on missing signature file, 2 on signature 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) {
- my ($ret, $out) = gpg_verify_signature($file, $signature_file);
- if ($ret) {
- # no need to show the output
- debug("cryptographic signature of $url verified\n");
- return(0);
- } else {
- return(2, <<GPGERROR);
-cryptographic signature verification of
- $file
-against
- $signature_url
-failed. Output was
-$out
-Please report to texlive\@tug.org
-GPGERROR
- }
- } else {
- debug("no access to cryptographic signature $signature_url\n");
- return(-2, "no access to cryptographic signature");
- }
- } else {
- debug("gpg prog not defined, no checking of signatures\n");
- # we return 0 (= success) if not gpg is available
- return(0);
- }
- # not reached
- 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, $out);
- } else {
- return (0, $out);
- }
-}
-
-#
# compare_tlpobjs
# returns a hash
# $ret{'revision'} = "leftRev:rightRev" if revision differ
@@ -4230,10 +3957,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