From 5aa28567dca799a746db5c20e400edcfc4031be1 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Thu, 21 Apr 2016 19:08:52 +0000 Subject: 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 --- Master/tlpkg/TeXLive/TLConfig.pm | 18 +- Master/tlpkg/TeXLive/TLCrypto.pm | 372 +++++++++++++++++++++++++++++++++++++++ Master/tlpkg/TeXLive/TLPDB.pm | 22 +-- Master/tlpkg/TeXLive/TLPOBJ.pm | 26 ++- Master/tlpkg/TeXLive/TLUtils.pm | 290 +----------------------------- 5 files changed, 404 insertions(+), 324 deletions(-) create mode 100644 Master/tlpkg/TeXLive/TLCrypto.pm (limited to 'Master/tlpkg') 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". =head1 SEE ALSO -The modules L, L, -L, L, L. +All the other TeX Live modules and scripts, especially C and +C, and the documentation in the repository: +C. =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 -- 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; 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. +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: # 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, L, -L, L and the -document L and the specification in the TeX Live -repository trunk/Master/tlpkg/doc/. +The modules L, L, L, +L, etc., and the documentation in the repository: +C. =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, L, L, -L, L, L. +The modules L, L, +L, L, L, +L, L, etc., and the +documentation in the repository: C. =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 -- 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 and returns it with C<"> chars surrounding it on Unix. On Windows, the C<"> chars are only -added if I a few special characters, since unconditional quoting +added if I contains special characters, since unconditional quoting leads to errors there. In all cases, any C<"> chars in I 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; 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 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, <&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, L, -L, L, and the -document L and the specification in the TeX Live -repository trunk/Master/tlpkg/doc/. +The modules L, L, +L, L, etc., and the +documentation in the repository: C. =head1 AUTHORS AND COPYRIGHT -- cgit v1.2.3