diff options
author | Karl Berry <karl@freefriends.org> | 2016-04-13 22:30:20 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2016-04-13 22:30:20 +0000 |
commit | b9b0dce9293c9bd6d12ff53d088dfdb8fd33fef5 (patch) | |
tree | f968612769077b5f00a5d7bbc1bae35c7466d607 /Build/source/texk/tests | |
parent | b9b417030377e161a8e9a259bb04cd5bc27773dd (diff) |
doc,regen,sync
git-svn-id: svn://tug.org/texlive/trunk@40492 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/tests')
-rw-r--r-- | Build/source/texk/tests/TeXLive/TLConfig.pm | 25 | ||||
-rw-r--r-- | Build/source/texk/tests/TeXLive/TLUtils.pm | 240 |
2 files changed, 254 insertions, 11 deletions
diff --git a/Build/source/texk/tests/TeXLive/TLConfig.pm b/Build/source/texk/tests/TeXLive/TLConfig.pm index 4d35866893d..972f708f893 100644 --- a/Build/source/texk/tests/TeXLive/TLConfig.pm +++ b/Build/source/texk/tests/TeXLive/TLConfig.pm @@ -5,7 +5,7 @@ package TeXLive::TLConfig; -my $svnrev = '$Revision: 40251 $'; +my $svnrev = '$Revision: 40475 $'; my $_modulerevision; if ($svnrev =~ m/: ([0-9]+) /) { $_modulerevision = $1; @@ -49,6 +49,9 @@ BEGIN { $NetworkTimeout $PartialEngineSupport $F_OK $F_WARNING $F_ERROR $F_NOPOSTACTION + $ChecksumLength + $ChecksumProgram + $ChecksumExtension ); @EXPORT = @EXPORT_OK; } @@ -57,9 +60,10 @@ BEGIN { # network packages, and in menu names, and other places. $ReleaseYear = 2016; -# users can upgrade from this year to the current year; maybe a spread -# of more than one year will be useful at some point, but not now. -$MinRelease = 2013; # upgrade from 2013 to 2015 should work, we'll see +# 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; # users can NOT upgrade due to internal changes, force a full installation #$MinRelease = $ReleaseYear; @@ -193,7 +197,7 @@ our %TLPDBSettings = ( our $WindowsMainMenuName = "TeX Live $ReleaseYear"; # Comma-separated list of engines which do not exist on all platforms. -our $PartialEngineSupport = "luajittex"; +our $PartialEngineSupport = "luajittex,mfluajit"; # timeout for network connections (wget, LWP) in seconds our $NetworkTimeout = 30; @@ -211,6 +215,17 @@ our $F_ERROR = 2; # all fine, but no need to run post actions 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 +$ChecksumLength = 128; + +# The program generating the checksum for the file given as first +# argument +$ChecksumProgram = "sha512sum"; + +# The extension of the checksum file +$ChecksumExtension = "sha512"; 1; diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm index ac14adf3f3e..bc4ab402d9d 100644 --- a/Build/source/texk/tests/TeXLive/TLUtils.pm +++ b/Build/source/texk/tests/TeXLive/TLUtils.pm @@ -5,7 +5,7 @@ package TeXLive::TLUtils; -my $svnrev = '$Revision: 40251 $'; +my $svnrev = '$Revision: 40460 $'; my $_modulerevision; if ($svnrev =~ m/: ([0-9]+) /) { $_modulerevision = $1; @@ -98,6 +98,10 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure 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); @@ -172,6 +176,10 @@ BEGIN { &create_mirror_list &extract_mirror_entry &tlmd5 + &tlchecksum + &setup_gpg + &verify_checksum + &verify_signature &wsystem &xsystem &run_cmd @@ -198,6 +206,7 @@ BEGIN { use Cwd; use Digest::MD5; +use Digest::SHA; use Getopt::Long; use File::Temp; @@ -1957,7 +1966,7 @@ not agree. Does nothing if neither of the check arguments is given. sub check_file { my ($xzfile, $checksum, $size) = @_; if ($checksum) { - if (tlmd5($xzfile) ne $checksum) { + if (tlchecksum($xzfile) ne $checksum) { tlwarn("TLUtils::check_file: found $xzfile, but hashsums differ, removing it.\n"); unlink($xzfile); return; @@ -2239,7 +2248,7 @@ sub setup_programs { # Return 0 if failure, 1 if success. # sub setup_unix_one { - my ($p, $def, $arg) = @_; + my ($p, $def, $arg, $donotwarn) = @_; our $tmp; my $test_fallback = 0; if (-r $def) { @@ -2313,9 +2322,13 @@ sub setup_unix_one { if ($ret == 0) { debug("Using system $p (tested).\n"); } else { - tlwarn("$0: Initialization failed (in setup_unix_one):\n"); - tlwarn("$0: could not find a usable $p.\n"); - tlwarn("$0: Please install $p and try again.\n"); + if ($donotwarn) { + debug("$0: initialization of $p failed but ignored!\n"); + } else { + tlwarn("$0: Initialization failed (in setup_unix_one):\n"); + tlwarn("$0: could not find a usable $p.\n"); + tlwarn("$0: Please install $p and try again.\n"); + } return 0; } } else { @@ -3578,6 +3591,221 @@ sub tlmd5 { } } +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) >> + +Reads the whole file and returns the content in a scalar. + +=cut + +sub slurp_file { + my $file = shift; + my $file_data = do { + local $/ = undef; + open my $fh, "<", $file || die "open($file) failed: $!"; + <$fh>; + }; + 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) >> + +If C<$url> tries to download the file into a temporary file. +In both cases returns the local file. + +Returns the local file name if succeeded, otherwise undef. + +=cut + +sub download_to_temp_or_file { + my $url = shift; + my ($url_fh, $url_file); + if ($url =~ m,^(http|ftp|file)://,) { + ($url_fh, $url_file) = File::Temp::tempfile(UNLINK => 1); + # now $url_fh filehandle is open, the file created + # TLUtils::download_file will just overwrite what is there + # on windows that doesn't work, so we close the fh immediately + # this creates a short loophole, but much better than before anyway + close($url_fh); + $ret = download_file($url, $url_file); + } else { + $url_file = $url; + $ret = 1; + } + if ($ret && (-r "$url_file")) { + return $url_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 |