# $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 TeXLive::TLConfig; use TeXLive::TLUtils qw(debug ddebug win32 which platform conv_to_w32_path); # try to load Digest::SHA, and if that fails, use our own slow modules my $dig; eval { require Digest::SHA; Digest::SHA->import('sha512_hex'); $dig = Digest::SHA->new(512); }; if ($@) { require TeXLive::SHA; TeXLive::SHA->import('sha512_hex'); $dig = TeXLive::SHA->new(512); } my $svnrev = '$Revision: 40650 $'; my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown"; sub module_revision { return $_modulerevision; } =pod =head1 NAME C -- 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 = $dig->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 = $dig->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 (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, -3 if no gpg program is available, 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; if that envvar is not set, first C, then C, then, on Windows only, C is looked for. Further adaptation of the invocation of C can be done using the two enviroment variables C, which is passed to C with C<--homedir>, and C, 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, and -3 if no gpg is available. 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, <> 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, L, etc., and the documentation in the repository: C. Also the standard modules L and L. =head1 AUTHORS AND COPYRIGHT This script and its documentation were written for the TeX Live distribution (L) 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: #