summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/TeXLive/TLCrypto.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/TeXLive/TLCrypto.pm
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/TeXLive/TLCrypto.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/TeXLive/TLCrypto.pm600
1 files changed, 600 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/TeXLive/TLCrypto.pm b/systems/texlive/tlnet/tlpkg/TeXLive/TLCrypto.pm
new file mode 100644
index 0000000000..293d9555b9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/TeXLive/TLCrypto.pm
@@ -0,0 +1,600 @@
+# $Id: TLCrypto.pm 51838 2019-08-07 21:53:30Z karl $
+# TeXLive::TLCrypto.pm - handle checksums and signatures.
+# Copyright 2016-2019 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 TeXLive::TLConfig;
+use TeXLive::TLUtils qw(debug ddebug win32 which platform
+ conv_to_w32_path tlwarn tldie);
+
+my $svnrev = '$Revision: 51838 $';
+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 Setup
+
+ TeXLive::TLCrypto::setup_checksum_method();
+
+=head2 Checksums
+
+ TeXLive::TLCrypto::tlchecksum($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
+ &tl_short_digest
+ &verify_checksum
+ &setup_gpg
+ &verify_signature
+ %VerificationStatusDescription
+ $VS_VERIFIED $VS_CHECKSUM_ERROR $VS_SIGNATURE_ERROR $VS_CONNECTION_ERROR
+ $VS_UNSIGNED $VS_GPG_UNAVAILABLE $VS_PUBKEY_MISSING $VS_UNKNOWN
+ $VS_EXPKEYSIG $VS_REVKEYSIG
+ );
+ @EXPORT = qw(
+ %VerificationStatusDescription
+ $VS_VERIFIED $VS_CHECKSUM_ERROR $VS_SIGNATURE_ERROR $VS_CONNECTION_ERROR
+ $VS_UNSIGNED $VS_GPG_UNAVAILABLE $VS_PUBKEY_MISSING $VS_UNKNOWN
+ $VS_EXPKEYSIG $VS_REVKEYSIG
+ );
+}
+
+=pod
+
+=over 4
+
+=item C<< setup_checksum_method() >>
+
+Tries to find a checksum method: check usability of C<Digest::SHA>,
+then the programs C<openssl>, C<sha512sum>, and C<shasum>, in that
+order. On old-enough Macs, C<openssl> is present but does not have
+the option C<-sha512>, while the separate program C<shasum> does suffice.
+
+Returns the checksum method as a string, and also sets
+C<<$::checksum_method>>, or false if none found.
+
+=cut
+
+sub setup_checksum_method {
+ # make it a noop if already defined
+ # the checksum method could also be "" meaning that there
+ # is none. We do not need to check again. Thus we check
+ # on defined.
+ return ($::checksum_method) if defined($::checksum_method);
+ # default is no checksum
+ $::checksum_method = "";
+ # for debugging
+ # $::checksum_method = "sha512sum";
+ # return($::checksum_method);
+ # try to load Digest::SHA, and if that fails, use our own slow modules
+ eval {
+ require Digest::SHA;
+ Digest::SHA->import('sha512_hex');
+ debug("Using checksum method digest::sha\n");
+ $::checksum_method = "digest::sha";
+ };
+ if ($@ && ($^O !~ /^MSWin/i)) {
+ # for unix like environments we test other programs (openssl, sha512sum,
+ # shasum), too
+ my $ret;
+
+ # first for openssl dgst -sha512
+ # old MacOS openssl does not support -sha512!
+ $ret = system("openssl dgst -sha512 >/dev/null 2>&1 </dev/null" );
+ if ($ret == 0) {
+ debug("Using checksum method openssl\n");
+ return($::checksum_method = "openssl");
+ }
+
+ # next for sha512sum, but this is not available on old MacOS
+ if (TeXLive::TLUtils::which("sha512sum")) {
+ debug("Using checksum method sha512sum\n");
+ return($::checksum_method = "sha512sum");
+ }
+
+ # shasum for old Macs
+ $ret = system("shasum -a 512 >/dev/null 2>&1 </dev/null" );
+ if ($ret == 0) {
+ debug("Using checksum method shasum\n");
+ return($::checksum_method = "shasum");
+ }
+
+ debug("Cannot find usable checksum method!\n");
+ }
+ return($::checksum_method);
+}
+
+
+=pod
+
+=item C<< tlchecksum($file) >>
+
+Return checksum of C<$file>.
+
+=cut
+
+sub tlchecksum {
+ my ($file) = @_;
+ # this is here for the case that a script forgets to
+ # set up the checksum method!
+ if (!$::checksum_method) {
+ setup_checksum_method();
+ }
+ tldie("no checksum method available\n") if (!$::checksum_method);
+ if (-r $file) {
+ my ($out, $ret);
+ if ($::checksum_method eq "openssl") {
+ ($out, $ret) = TeXLive::TLUtils::run_cmd("openssl dgst -sha512 $file");
+ chomp($out);
+ } elsif ($::checksum_method eq "sha512sum") {
+ ($out, $ret) = TeXLive::TLUtils::run_cmd("sha512sum $file");
+ chomp($out);
+ } elsif ($::checksum_method eq "shasum") {
+ ($out, $ret) = TeXLive::TLUtils::run_cmd("shasum -a 512 $file");
+ chomp($out);
+ } elsif ($::checksum_method eq "digest::sha") {
+ open(FILE, $file) || die "open($file) failed: $!";
+ binmode(FILE);
+ $out = Digest::SHA->new(512)->addfile(*FILE)->hexdigest;
+ close(FILE);
+ $ret = 0;
+ } else {
+ tldie("unknown checksum program: $::checksum_method\n");
+ }
+ if ($ret != 0) {
+ tlwarn("tlchecksum: cannot compute checksum: $file\n");
+ return "";
+ }
+ ddebug("tlchecksum: out = $out\n");
+ my $cs;
+ if ($::checksum_method eq "openssl") {
+ (undef,$cs) = split(/= /,$out);
+ } elsif ($::checksum_method eq "sha512sum") {
+ ($cs,undef) = split(' ',$out);
+ } elsif ($::checksum_method eq "shasum") {
+ ($cs,undef) = split(' ',$out);
+ } elsif ($::checksum_method eq "digest::sha") {
+ $cs = $out;
+ }
+ debug("tlchecksum($file): ===$cs===\n");
+ if (length($cs) != 128) {
+ tlwarn("unexpected output from $::checksum_method: $out\n");
+ return "";
+ }
+ return $cs;
+ } else {
+ tlwarn("tlchecksum: given file not readable: $file\n");
+ return "";
+ }
+}
+
+# sub tlchecksum {
+# my ($file) = @_;
+# if (-r $file) {
+# open(FILE, $file) || die "open($file) failed: $!";
+# binmode(FILE);
+# my $cshash = $dig->new(512)->addfile(*FILE)->hexdigest;
+# close(FILE);
+# return $cshash;
+# } else {
+# tlwarn("tlchecksum: given file not readable: $file\n");
+# return "";
+# }
+# }
+
+=pod
+
+=item C<< tl_short_digest($str) >>
+
+Return short digest (MD5) of C<$str>.
+
+=cut
+
+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
+C<$VS_VERIFIED> on success,
+C<$VS_CONNECTION_ERROR> on connection error,
+C<$VS_UNSIGNED> on missing signature file,
+C<$VS_GPG_UNAVAILABLE> if no gpg program is available,
+C<$VS_PUBKEY_MISSING> if the pubkey is not available,
+C<$VS_CHECKSUM_ERROR> on checksum errors,
+C<$VS_EXPKEYSIG> if the signature is good but was made with an expired key,
+C<$VS_REVKEYSIG> if the signature is good but was made with a revoked key,
+and C<$VS_SIGNATURE_ERROR> on signature errors.
+In case of errors returns an informal message as second argument.
+
+=cut
+
+sub verify_checksum {
+ my ($file, $checksum_url) = @_;
+ # don't do anything if we cannot determine a checksum method
+ # return -2 which is as much as missing signature
+ return($VS_UNSIGNED) if (!$::checksum_method);
+ 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) {
+ debug("verify_checksum: download did not succeed for $checksum_url\n");
+ return($VS_CONNECTION_ERROR, "download did not succeed: $checksum_url");
+ }
+
+ # check that we have a non-trivial size for the checksum file
+ # the size should be at least 128 + 1 + length(filename) > 129
+ {
+ my $css = -s $checksum_file;
+ if ($css <= 128) {
+ debug("verify_checksum: size of checksum file suspicious: $css\n");
+ return($VS_CONNECTION_ERROR, "download corrupted: $checksum_url");
+ }
+ }
+
+ # check the signature
+ my ($ret, $msg) = verify_signature($checksum_file, $checksum_url);
+
+ if ($ret != 0) {
+ debug("verify_checksum: returning $ret and $msg\n");
+ return ($ret, $msg)
+ }
+
+ # verify local data
+ open $cs_fh, "<$checksum_file" or die("cannot read file: $!");
+ if (read ($cs_fh, $remote_digest, $ChecksumLength) != $ChecksumLength) {
+ close($cs_fh);
+ debug("verify_checksum: incomplete read from\n $checksum_file\nfor\n $file\nand\n $checksum_url\n");
+ return($VS_CHECKSUM_ERROR, "incomplete read from $checksum_file");
+ } else {
+ close($cs_fh);
+ debug("verify_checksum: found remote digest\n $remote_digest\nfrom\n $checksum_file\nfor\n $file\nand\n $checksum_url\n");
+ }
+ $local_digest = tlchecksum($file);
+ debug("verify_checksum: local_digest = $local_digest\n");
+ if ($local_digest ne $remote_digest) {
+ return($VS_CHECKSUM_ERROR, "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 ";
+ #
+ # check for additional keyring
+ # originally we wanted to use TEXMFSYSCONFIG, but gnupg on Windows
+ # is so stupid that it *prepends* GNUPGHOME to paths starting with
+ # a drive letter like c:/
+ # Thus we switch to using repository-keys.gpg in GNUPGHOME!
+ my $addkr = "$gpghome/repository-keys.gpg";
+ if (-r $addkr) {
+ debug("setup_gpg: using additional keyring $addkr\n");
+ $::gpg .= "--keyring repository-keys.gpg ";
+ }
+ if ($ENV{'TL_GNUPGARGS'}) {
+ $::gpg .= $ENV{'TL_GNUPGARGS'};
+ } else {
+ $::gpg .= "--no-secmem-warning --no-permission-warning --lock-never ";
+ }
+ 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(" ... gpg ok! [$cmdline]\n");
+ return $prg;
+ } else {
+ debug(" ... gpg not ok! [$cmdline]\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
+$VS_VERIFIED on success,
+$VS_REVKEYSIG on good signature but from revoked key,
+$VS_EXPKEYSIG on good signature but from expired key,
+$VS_UNSIGNED on missing signature file,
+$VS_SIGNATURE_ERROR on signature error,
+$VS_GPG_UNAVAILABLE if no gpg is available, and
+$VS_PUBKEY_MISSING if a pubkey is missing.
+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) {
+ {
+ # we expect a signature to be at least
+ # 30 header line + 30 footer line + 256 > 300
+ my $sigsize = -s $signature_file;
+ if ($sigsize < 300) {
+ debug("cryptographic signature seems to be corrupted (size $sigsize<300): $signature_url, $signature_file\n");
+ return($VS_UNSIGNED, "cryptographic signature download seems to be corrupted (size $sigsize<300)");
+ }
+ }
+ # check also the first line of the signature file for
+ # -----BEGIN PGP SIGNATURE-----
+ {
+ open my $file, '<', $signature_file;
+ chomp(my $firstLine = <$file>);
+ close $file;
+ if ($firstLine !~ m/^-----BEGIN PGP SIGNATURE-----/) {
+ debug("cryptographic signature seems to be corrupted (first line not signature): $signature_url, $signature_file, $firstLine\n");
+ return($VS_UNSIGNED, "cryptographic signature download seems to be corrupted (first line of $signature_url not signature: $firstLine)");
+ }
+ }
+ my ($ret, $out) = gpg_verify_signature($file, $signature_file);
+ if ($ret == $VS_VERIFIED) {
+ # no need to show the output
+ debug("cryptographic signature of $url verified\n");
+ return($VS_VERIFIED);
+ } elsif ($ret == $VS_PUBKEY_MISSING) {
+ return($VS_PUBKEY_MISSING, $out);
+ } elsif ($ret == $VS_EXPKEYSIG) {
+ return($VS_EXPKEYSIG, $out);
+ } elsif ($ret == $VS_REVKEYSIG) {
+ return($VS_REVKEYSIG, $out);
+ } else {
+ return($VS_SIGNATURE_ERROR, <<GPGERROR);
+cryptographic signature verification of
+ $file
+against
+ $signature_url
+failed. Output was:
+$out
+Please try from a different mirror and/or wait a few minutes
+and try again; usually this is because of transient updates.
+If problems persist, feel free to report to texlive\@tug.org.
+GPGERROR
+ }
+ } else {
+ debug("no access to cryptographic signature $signature_url\n");
+ return($VS_UNSIGNED, "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($VS_GPG_UNAVAILABLE, "no gpg available");
+ }
+ # not reached
+ return ($VS_UNKNOWN);
+}
+
+=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 ($status_fh, $status_file) = TeXLive::TLUtils::tl_tmpfile();
+ close($status_fh);
+ my ($out, $ret)
+ = TeXLive::TLUtils::run_cmd("$::gpg --status-file \"$status_file\" --verify $sig_quote $file_quote 2>&1");
+ # read status file
+ open($status_fd, "<", $status_file) || die("Cannot open status file: $!");
+ my @status_lines = <$status_fd>;
+ close($status_fd);
+ chomp(@status_lines);
+ debug(join("\n", "STATUS OUTPUT", @status_lines));
+ if ($ret == 0) {
+ # verification still might return success but key is expired!
+ if (grep(/EXPKEYSIG/, @status_lines)) {
+ return($VS_EXPKEYSIG, "expired key");
+ }
+ if (grep(/REVKEYSIG/, @status_lines)) {
+ return($VS_REVKEYSIG, "revoked key");
+ }
+ debug("verification succeeded, output:\n$out\n");
+ return ($VS_VERIFIED, $out);
+ } else {
+ if (grep(/^\[GNUPG:\] NO_PUBKEY (.*)/, @status_lines)) {
+ debug("missing pubkey $1\n");
+ return ($VS_PUBKEY_MISSING, "missing pubkey $1");
+ }
+ # we could do more checks on what is the actual problem here!
+ return ($VS_SIGNATURE_ERROR, $out);
+ }
+}
+
+=pod
+
+=item C<< %VerificationStatusDescription >>
+
+Provides a textual representation for the verification status values.
+
+=cut
+
+our $VS_VERIFIED = 0;
+our $VS_CHECKSUM_ERROR = 1;
+our $VS_SIGNATURE_ERROR = 2;
+our $VS_CONNECTION_ERROR = -1;
+our $VS_UNSIGNED = -2;
+our $VS_GPG_UNAVAILABLE = -3;
+our $VS_PUBKEY_MISSING = -4;
+our $VS_EXPKEYSIG = -5;
+our $VS_EXPSIG = -6;
+our $VS_REVKEYSIG = -7;
+our $VS_UNKNOWN = -100;
+
+our %VerificationStatusDescription = (
+ $VS_VERIFIED => 'verified',
+ $VS_CHECKSUM_ERROR => 'checksum error',
+ $VS_SIGNATURE_ERROR => 'signature error',
+ $VS_CONNECTION_ERROR => 'connection error',
+ $VS_UNSIGNED => 'unsigned',
+ $VS_GPG_UNAVAILABLE => 'gpg unavailable',
+ $VS_PUBKEY_MISSING => 'pubkey missing',
+ $VS_EXPKEYSIG => 'valid signature with expired key',
+ $VS_EXPSIG => 'valid but expired signature',
+ $VS_UNKNOWN => 'unknown',
+);
+
+=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: #