From 18c1c1221143104b11e67232f8fc6511efb1cefb Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 7 Jan 2016 02:44:29 +0000 Subject: revert changes in tlcritical to fix the TLDownload error git-svn-id: svn://tug.org/texlive/trunk@39298 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLUtils.pm | 429 ++++++++++++++++++++++++++++++---------- 1 file changed, 328 insertions(+), 101 deletions(-) (limited to 'Master/tlpkg/TeXLive/TLUtils.pm') diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index e1c85f049b8..b2c74c3a6ca 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -77,6 +77,7 @@ C -- utilities used in TeX Live infrastructure TeXLive::TLUtils::create_language_lua($tlpdb,$dest,$localconf); TeXLive::TLUtils::time_estimate($totalsize, $donesize, $starttime) TeXLive::TLUtils::install_packages($from_tlpdb,$media,$to_tlpdb,$what,$opt_src, $opt_doc)>); + TeXLive::TLUtils::install_package($what, $filelistref, $target, $platform); TeXLive::TLUtils::do_postaction($how, $tlpobj, $do_fileassocs, $do_menu, $do_desktop, $do_script); TeXLive::TLUtils::announce_execute_actions($how, @executes, $what); TeXLive::TLUtils::add_symlinks($root, $arch, $sys_bin, $sys_man, $sys_info); @@ -1340,9 +1341,96 @@ sub install_packages { foreach my $h (@::install_packages_hook) { &$h($n,$totalnr); } - # TODO TODO - # we do NOT check the return value!!! - $fromtlpdb->install_package($package, $totlpdb); + my $real_opt_doc = $opt_doc; + my $container; + my @installfiles; + push @installfiles, $tlpobj->runfiles; + push @installfiles, $tlpobj->allbinfiles; + push @installfiles, $tlpobj->srcfiles if ($opt_src); + push @installfiles, $tlpobj->docfiles if ($real_opt_doc); + if ($media eq 'local_uncompressed') { + $container = [ $root, @installfiles ]; + } elsif ($media eq 'local_compressed') { + if (-r "$root/$Archive/$package.zip") { + $container = "$root/$Archive/$package.zip"; + } elsif (-r "$root/$Archive/$package.tar.xz") { + $container = "$root/$Archive/$package.tar.xz"; + } else { + tlwarn("No package $package (.zip or .xz) in $root/$Archive\n"); + next; + } + } elsif ($media eq 'NET') { + $container = "$root/$Archive/$package.$DefaultContainerExtension"; + } + if (!install_package($container, $reloc, $tlpobj->containersize, + $tlpobj->containermd5, \@installfiles, + $totlpdb->root, $vars{'this_platform'})) { + # we already warn in install_package that something bad happened, + # so only return here + return 0; + } + # if we are installing from compressed media we have to fetch the respective + # source and doc packages $pkg.source and $pkg.doc and install them, too + if (($media eq 'NET') || ($media eq 'local_compressed')) { + # we install split containers under the following conditions: + # - the container were split generated + # - src/doc files should be installed + # (- the package is not already a split one (like .i386-linux)) + # the above test has been removed since that would mean that packages + # with a dot like texlive.infra will never have the docfiles installed + # that is already happening ...bummer. But since we already check + # whether there are src/docfiles present at all that is fine + # - there are actually src/doc files present + if ($container_src_split && $opt_src && $tlpobj->srcfiles) { + my $srccontainer = $container; + $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/; + if (!install_package($srccontainer, $reloc, $tlpobj->srccontainersize, + $tlpobj->srccontainermd5, \@installfiles, + $totlpdb->root, $vars{'this_platform'})) { + return 0; + } + } + if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) { + my $doccontainer = $container; + $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/; + if (!install_package($doccontainer, $reloc, + $tlpobj->doccontainersize, + $tlpobj->doccontainermd5, \@installfiles, + $totlpdb->root, $vars{'this_platform'})) { + return 0; + } + } + } + # we don't want to have wrong information in the tlpdb, so remove the + # src/doc files if they are not installed ... + if (!$opt_src) { + $tlpobj->clear_srcfiles; + } + if (!$real_opt_doc) { + $tlpobj->clear_docfiles; + } + # if a package is relocatable we have to cancel the reloc prefix + # before we save it to the local tlpdb + if ($tlpobj->relocated) { + $tlpobj->replace_reloc_prefix; + } + $totlpdb->add_tlpobj($tlpobj); + + # we have to write out the tlpobj file since it is contained in the + # archives (.tar.xz), but at uncompressed-media install time we + # don't have them. + my $tlpod = $totlpdb->root . "/tlpkg/tlpobj"; + mkdirhier($tlpod); + my $count = 0; + my $tlpobj_file = ">$tlpod/" . $tlpobj->name . ".tlpobj"; + until (open(TMP, $tlpobj_file)) { + # The open might fail for no good reason on Windows. + # Try again for a while, but not forever. + if ($count++ == 100) { die "$0: open($tlpobj_file) failed: $!"; } + select (undef, undef, undef, .1); # sleep briefly + } + $tlpobj->writeout(\*TMP); + close(TMP); $donesize += $tlpsizes{$package}; } my $totaltime = time() - $starttime; @@ -1354,6 +1442,173 @@ sub install_packages { return 1; } + +=item C + +This function installs the files given in @$filelistref from C<$what> +into C<$target>. + +C<$size> gives the size in bytes of the container, or -1 if we are +installing from uncompressed media, i.e., from a list of files to be copied. + +If C<$what> is a reference to a list of files then these files are +assumed to be readable and are copied to C<$target>, creating dirs on +the way. In this case the list C<@$filelistref> is not taken into +account. + +If C<$what> starts with C or C then C<$what> is +downloaded from the net and piped through C and C. + +If $what ends with C<.tar.xz> (but does not start with C or +C, but possibly with C) it is assumed to be a readable +file on the system and is likewise piped through C and C. + +In both of these cases currently the list C<$@filelistref> currently +is not taken into account (should be fixed!). + +if C<$reloc> is true the container (NET or local_compressed mode) is packaged in a way +that the initial texmf-dist is missing. + +Returns 1 on success and 0 on error. + +=cut + +sub install_package { + my ($what, $reloc, $whatsize, $whatmd5, $filelistref, $target, $platform) = @_; + + my @filelist = @$filelistref; + + my $tempdir = "$target/temp"; + + # we assume that $::progs has been set up! + my $wget = $::progs{'wget'}; + my $xzdec = quotify_path_with_spaces($::progs{'xzdec'}); + if (!defined($wget) || !defined($xzdec)) { + tlwarn("install_package: wget/xzdec programs not set up properly.\n"); + return 0; + } + if (ref $what) { + # we are getting a ref to a list of files, so install from uncompressed media + my ($root, @files) = @$what; + foreach my $file (@files) { + # @what is taken, not @filelist! + # is this still needed? + my $dn=dirname($file); + mkdirhier("$target/$dn"); + copy "$root/$file", "$target/$dn"; + } + } elsif ($what =~ m,\.tar.xz$,) { + # this is the case when we install from compressed media + # + # in all other cases we create temp files .tar.xz (or use the present + # one), xzdec them, and then call tar + + # if we are unpacking a relocated container we adjust the target + if ($reloc) { + $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc; + mkdir($target) if (! -d $target); + } + + my $fn = basename($what); + my $pkg = $fn; + $pkg =~ s/\.tar\.xz$//; + mkdirhier("$tempdir"); + my $xzfile = "$tempdir/$fn"; + my $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//; + my $xzfile_quote = $xzfile; + my $tarfile_quote = $tarfile; + if (win32()) { + $xzfile =~ s!/!\\!g; + $tarfile =~ s!/!\\!g; + $target =~ s!/!\\!g; + } + $xzfile_quote = "\"$xzfile\""; + $tarfile_quote = "\"$tarfile\""; + my $gotfiledone = 0; + if (-r $xzfile) { + # check that the downloaded file is not partial + if ($whatsize >= 0) { + # we have the size given, so check that first + my $size = (stat $xzfile)[7]; + if ($size == $whatsize) { + # we want to check also the md5sum if we have it present + if ($whatmd5) { + if (tlmd5($xzfile) eq $whatmd5) { + $gotfiledone = 1; + } else { + tlwarn("Downloaded $what, size equal, but md5sum differs;\n", + "downloading again.\n"); + } + } else { + # size ok, no md5sum + tlwarn("Downloaded $what, size equal, but no md5sum available;\n", + "continuing, with fingers crossed."); + $gotfiledone = 1; + } + } else { + tlwarn("Partial download of $what found, removing it.\n"); + unlink($tarfile, $xzfile); + } + } else { + # ok no size information, hopefully we have md5 sums + if ($whatmd5) { + if (tlmd5($xzfile) eq $whatmd5) { + $gotfiledone = 1; + } else { + tlwarn("Downloaded file, but md5sum differs, removing it.\n"); + } + } else { + tlwarn("Container found, but cannot verify size of md5sum;\n", + "continuing, with fingers crossed.\n"); + $gotfiledone = 1; + } + } + debug("Reusing already downloaded container $xzfile\n") + if ($gotfiledone); + } + if (!$gotfiledone) { + if ($what =~ m,http://|ftp://,) { + # we are installing from the NET + # download the file and put it into temp + if (!download_file($what, $xzfile) || (! -r $xzfile)) { + tlwarn("Downloading $what did not succeed.\n"); + return 0; + } + } else { + # we are installing from local compressed media + # copy it to temp + copy($what, $tempdir); + } + } + debug("un-xzing $xzfile to $tarfile\n"); + system("$xzdec < $xzfile_quote > $tarfile_quote"); + if (! -f $tarfile) { + tlwarn("Unpacking $xzfile did not succeed.\n"); + return 0; + } + if (!TeXLive::TLUtils::untar($tarfile, $target, 1)) { + tlwarn("untarring $tarfile failed, stopping install.\n"); + return 0; + } + # we remove the created .tlpobj it is recreated anyway in + # install_packages above in the right place. This way we also + # get rid of the $pkg.source.tlpobj which are useless + unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj") + if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj"); + if ($what =~ m,http://|ftp://,) { + # we downloaded the original .tar.lzma from the net, so we keep it + } else { + # we are downloading it from local compressed media, so we can unlink it to save + # disk space + unlink($xzfile); + } + } else { + tlwarn("Sorry, no idea how to install $what\n"); + return 0; + } + return 1; +} + =item C Evaluates the C fields in the C<$tlpobj>. The first parameter @@ -1948,130 +2203,102 @@ sub w32_remove_from_path { =pod -=item C - -Remove C<$what> if either the given C<$checksum> or C<$checksize> does -not agree. Does nothing if neither of the check arguments is given. - -=cut - -sub check_file { - my ($xzfile, $checksum, $size) = @_; - if ($checksum) { - if (tlmd5($xzfile) ne $checksum) { - tlwarn("TLUtils::check_file: found $xzfile, but hashsums differ, removing it.\n"); - unlink($xzfile); - return; - } - } - if ($size) { - my $filesize = (stat $xzfile)[7]; - if ($filesize != $size) { - tlwarn("TLUtils::check_file: found $xzfile, but sizes differ, removing it.\n"); - unlink($xzfile); - return; - } - } - # We cannot remove the file here, otherwise restoring of backups - # or unwind packages might die. -} - -=pod - -=item C +=item C If necessary, downloads C$what>, and then unpacks it into C<$targetdir>. -C<@opts> is assigned to a hash and can contain the following -options: C (use this directory for downloaded files), -C (check downloaded file against this checksum), -C (check downloaded file against this size), -C (remove temporary files after operation). -Returns a pair of values: in case of error return 0 and an additional -explanation, in case of success return 1 and the name of the package. +Returns the name of the unpacked package (determined from the name of C<$what>) +in case of success, otherwise undefined. =cut sub unpack { - my ($what, $target, %opts) = @_; - # remove by default - my $remove = (defined($opts{'remove'}) ? $opts{'remove'} : 1); - my $tempdir = (defined($opts{'tmpdir'}) ? $opts{'tmpdir'} : tl_tmpdir()); - my $checksum = (defined($opts{'checksum'}) ? $opts{'checksum'} : 0); - my $size = (defined($opts{'size'}) ? $opts{'size'} : 0); + my ($what, $target) = @_; if (!defined($what)) { - return (0, "nothing to unpack"); + tlwarn("TLUtils::unpack: nothing to unpack!\n"); + return; } # we assume that $::progs has been set up! my $wget = $::progs{'wget'}; my $xzdec = TeXLive::TLUtils::quotify_path_with_spaces($::progs{'xzdec'}); if (!defined($wget) || !defined($xzdec)) { - return (0, "programs not set up properly"); + tlwarn("_install_package: programs not set up properly, strange.\n"); + return; } my $type; - if ($what !~ m/\.tar\.xz$/) { - return(0, "don't know how to unpack"); + if ($what =~ m,\.tar(\.xz)?$,) { + $type = defined($what) ? "xz" : "tar"; + } else { + tlwarn("TLUtils::unpack: don't know how to unpack this: $what\n"); + return; } + my $tempdir = tl_tmpdir(); + + # we are still here, so something was handed in and we have either .tar or .tar.xz my $fn = basename($what); my $pkg = $fn; - $pkg =~ s/\.tar\.xz$//; + $pkg =~ s/\.tar(\.xz)?$//; my $tarfile; - my $remove_xzfile = $remove; - my $xzfile = "$tempdir/$fn"; - $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//; - my $xzfile_quote; - my $tarfile_quote; - my $target_quote; - if (win32()) { - $xzfile =~ s!/!\\!g; - $tarfile =~ s!/!\\!g; - $target =~ s!/!\\!g; - } - $xzfile_quote = "\"$xzfile\""; - $tarfile_quote = "\"$tarfile\""; - $target_quote = "\"$target\""; - if ($what =~ m,^(http|ftp)://,) { - # we are installing from the NET - # check for the presence of $what in $tempdir - if (-r $xzfile) { - check_file($xzfile, $checksum, $size); - } - # if the file is now not present, we can use it - if (! -r $xzfile) { - # try download the file and put it into temp - download_file($what, $xzfile); - # remove false downloads - check_file($xzfile, $checksum, $size); - if ( ! -r $xzfile ) { - return(0, "downloading did not succeed"); + my $remove_tarfile = 1; + if ($type eq "xz") { + my $xzfile = "$tempdir/$fn"; + $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//; + my $xzfile_quote = $xzfile; + my $tarfile_quote = $tarfile; + my $target_quote = $target; + if (win32()) { + $xzfile =~ s!/!\\!g; + $tarfile =~ s!/!\\!g; + $target =~ s!/!\\!g; + } + $xzfile_quote = "\"$xzfile\""; + $tarfile_quote = "\"$tarfile\""; + $target_quote = "\"$target\""; + if ($what =~ m,http://|ftp://,) { + # we are installing from the NET + # download the file and put it into temp + if (!download_file($what, $xzfile) || (! -r $xzfile)) { + tlwarn("Downloading \n"); + tlwarn(" $what\n"); + tlwarn("did not succeed, please retry.\n"); + unlink($tarfile, $xzfile); + return; } + } else { + # we are installing from local compressed files + # copy it to temp + TeXLive::TLUtils::copy($what, $tempdir); + } + debug("un-xzing $xzfile to $tarfile\n"); + system("$xzdec < $xzfile_quote > $tarfile_quote"); + if (! -f $tarfile) { + tlwarn("TLUtils::unpack: Unpacking $xzfile failed, please retry.\n"); + unlink($tarfile, $xzfile); + return; } + unlink($xzfile); } else { - # we are installing from local compressed files - # copy it to temp - TeXLive::TLUtils::copy($what, $tempdir); - - check_file($xzfile, $checksum, $size); - if (! -r $xzfile) { - return (0, "consistency checks failed"); - } - # we can remove it afterwards - $remove_xzfile = 1; - } - debug("un-xzing $xzfile to $tarfile\n"); - system("$xzdec < $xzfile_quote > $tarfile_quote"); - if (! -f $tarfile) { - unlink($tarfile, $xzfile); - return(0, "Unpacking $xzfile failed"); - } - unlink($xzfile) if $remove_xzfile; - if (untar($tarfile, $target, 1)) { - return (1, "$pkg"); + $tarfile = "$tempdir/$fn"; + if ($what =~ m,http://|ftp://,) { + if (!download_file($what, $tarfile) || (! -r $tarfile)) { + tlwarn("Downloading \n"); + tlwarn(" $what\n"); + tlwarn("failed, please retry.\n"); + unlink($tarfile); + return; + } + } else { + $tarfile = $what; + $remove_tarfile = 0; + } + } + if (untar($tarfile, $target, $remove_tarfile)) { + return "$pkg"; } else { - return (0, "untar failed"); + return; } } -- cgit v1.2.3