From ebf0dca7678cef41dbc45a184a5e1c7966961a33 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 6 Jan 2016 04:21:37 +0000 Subject: unpack: return pair of 0,1 and msg, use it git-svn-id: svn://tug.org/texlive/trunk@39294 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLPDB.pm | 17 +++++++------ Master/tlpkg/TeXLive/TLUtils.pm | 53 ++++++++++++++++------------------------- 2 files changed, 30 insertions(+), 40 deletions(-) (limited to 'Master/tlpkg') diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index 89d0441c7ed..fa4c0965e51 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -1369,9 +1369,12 @@ sub install_package_files { # - create a tmp directory my $tmpdir = TeXLive::TLUtils::tl_tmpdir(); # - unpack everything there - if (!TeXLive::TLUtils::unpack($f, $tmpdir)) { - tlwarn("TLPDB::install_package_files: couldn't install $f\n"); - next; + { + my ($ret, $msg) = TeXLive::TLUtils::unpack($f, $tmpdir); + if (!$ret) { + tlwarn("TLPDB::install_package_files: $msg\n"); + next; + } } # we are still here, so the files have been unpacked properly # we need now to find the tlpobj in $tmpdir/tlpkg/tlpobj/ @@ -1664,7 +1667,7 @@ sub _install_data { my $wget = $::progs{'wget'}; my $xzdec = TeXLive::TLUtils::quotify_path_with_spaces($::progs{'xzdec'}); if (!defined($wget) || !defined($xzdec)) { - tlwarn("TLPDB::_install_package: programs not set up properly; hmm.\n"); + tlwarn("TLPDB::_install_data: programs not set up properly; hmm.\n"); return(0); } @@ -1701,9 +1704,9 @@ sub _install_data { $target .= "/$TeXLive::TLConfig::RelocTree"; } } - my $pkg = TeXLive::TLUtils::unpack($what, $target, 'size' => $whatsize, 'checksum' => $whatcheck); - if (!$pkg) { - tlwarn("TLPDB::_install_package: couldn't unpack $what to $target\n"); + my ($ret, $pkg) = TeXLive::TLUtils::unpack($what, $target, 'size' => $whatsize, 'checksum' => $whatcheck); + if (!$ret) { + tlwarn("TLPDB::_install_package: $pkg\n"); return(0); } # remove the $pkg.tlpobj, we recreate it anyway again diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 74ff59a0a52..e1c85f049b8 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -1959,24 +1959,21 @@ sub check_file { my ($xzfile, $checksum, $size) = @_; if ($checksum) { if (tlmd5($xzfile) ne $checksum) { - tlwarn("Found $xzfile, but hashsums differ, removing it.\n"); + tlwarn("TLUtils::check_file: found $xzfile, but hashsums differ, removing it.\n"); unlink($xzfile); + return; } - } elsif ($size) { + } + if ($size) { my $filesize = (stat $xzfile)[7]; if ($filesize != $size) { - tlwarn("Found $xzfile, but sizes differ, removing it.\n"); + tlwarn("TLUtils::check_file: found $xzfile, but sizes differ, removing it.\n"); unlink($xzfile); - } else { - tlwarn("Found $xzfile, with equal size, continuing fingers crossed.\n"); + return; } - } else { - # We cannot remove the file here, otherwise restoring of backups - # or unwind packages might die. - # - #tlwarn("Found $xzfile but no size or checksum information, removing it.\n"); - # unlink($xzfile); - } + } + # We cannot remove the file here, otherwise restoring of backups + # or unwind packages might die. } =pod @@ -1989,8 +1986,8 @@ 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 the name of the unpacked package (determined from the name of C<$what>) -in case of success, otherwise undefined. +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. =cut @@ -2003,22 +2000,19 @@ sub unpack { my $size = (defined($opts{'size'}) ? $opts{'size'} : 0); if (!defined($what)) { - tlwarn("TLUtils::unpack: nothing to unpack!\n"); - return; + return (0, "nothing to unpack"); } # 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)) { - tlwarn("_install_package: programs not set up properly, strange.\n"); - return; + return (0, "programs not set up properly"); } my $type; if ($what !~ m/\.tar\.xz$/) { - tlwarn("TLUtils::unpack: don't know how to unpack this: $what\n"); - return; + return(0, "don't know how to unpack"); } my $fn = basename($what); @@ -2051,11 +2045,8 @@ sub unpack { download_file($what, $xzfile); # remove false downloads check_file($xzfile, $checksum, $size); - if ( -r $xzfile ) { - tlwarn("Downloading\n"); - tlwarn(" $what\n"); - tlwarn("did not succeed, please retry.\n"); - return; + if ( ! -r $xzfile ) { + return(0, "downloading did not succeed"); } } } else { @@ -2065,10 +2056,7 @@ sub unpack { check_file($xzfile, $checksum, $size); if (! -r $xzfile) { - tlwarn("Your local copy of\n"); - tlwarn(" $what\n"); - tlwarn("does fail consistency checks (see above). Stopping here.\n"); - return; + return (0, "consistency checks failed"); } # we can remove it afterwards $remove_xzfile = 1; @@ -2076,15 +2064,14 @@ sub unpack { 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; + return(0, "Unpacking $xzfile failed"); } unlink($xzfile) if $remove_xzfile; if (untar($tarfile, $target, 1)) { - return "$pkg"; + return (1, "$pkg"); } else { - return; + return (0, "untar failed"); } } -- cgit v1.2.3