From de7c6a9c11e0edf5ce8a99d7c9338a05d9ddc5ef Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 6 Jun 2018 10:41:14 +0900 Subject: use unified system_pipe for decompressing instead of repeating code --- Master/tlpkg/TeXLive/TLPDB.pm | 20 +++------------ Master/tlpkg/TeXLive/TLPOBJ.pm | 6 ++++- Master/tlpkg/TeXLive/TLUtils.pm | 57 +++++++++++++++++++++++++++-------------- 3 files changed, 47 insertions(+), 36 deletions(-) diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index 0670a64c6f8..78cbe489323 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -99,7 +99,7 @@ use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation use TeXLive::TLCrypto; use TeXLive::TLPOBJ; use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug - tlwarn basename download_file merge_into tldie); + tlwarn basename download_file merge_into tldie system_pipe); use TeXLive::TLWinGoo; use Cwd 'abs_path'; @@ -316,11 +316,6 @@ sub from_file { ($tlpdbfh, $tlpdbfile) = TeXLive::TLUtils::tl_tmpfile(); # same as above close($tlpdbfh); - my $tlpdbfile_quote = $tlpdbfile; - if (win32()) { - $tlpdbfile =~ s!/!\\!g; - } - $tlpdbfile_quote = "\"$tlpdbfile\""; # if we have xz available we try the xz file my $xz_succeeded = 0 ; my $compressorextension = ""; @@ -328,12 +323,7 @@ sub from_file { # we first try the xz compressed file my ($xzfh, $xzfile) = TeXLive::TLUtils::tl_tmpfile(); close($xzfh); - my $xzfile_quote = $xzfile; - if (win32()) { - $xzfile =~ s!/!\\!g; - } - $xzfile_quote = "\"$xzfile\""; - my $decompressor = TeXLive::TLUtils::quotify_path_with_spaces($::progs{$DecompressorProgram{$DefaultCompressorFormat}}); + my $decompressor = $::progs{$DecompressorProgram{$DefaultCompressorFormat}}; $compressorextension = $CompressorExtension{$DefaultCompressorFormat}; my @decompressorArgs = @{$DecompressorArgs{$DefaultCompressorFormat}}; debug("trying to download $path.$compressorextension to $xzfile\n"); @@ -345,12 +335,10 @@ sub from_file { # xz *hopefully* returns 0 on success and anything else on failure # we don't have to negate since not zero means error in the shell # and thus in perl true - if (system("$decompressor @decompressorArgs <$xzfile_quote >$tlpdbfile_quote")) { + if (!system_pipe($decompressor, $xzfile, $tlpdbfile, 1, @decompressorArgs)) { debug("$decompressor $xzfile failed, trying plain file\n"); - # to be sure we unlink the xz file and the tlpdbfile - unlink($xzfile); + unlink($xzfile); # the above command only removes in case of success } else { - unlink($xzfile); $xz_succeeded = 1; debug("found the uncompressed $DefaultCompressorFormat file\n"); } diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index a0f3f10d675..32160a2c811 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -732,7 +732,11 @@ sub make_container { # compress it. if (-r "$destdir/$tarname") { - system($compressor, @compressorargs, "$destdir/$tarname"); + # system return 0 on success + if (system($compressor, @compressorargs, "$destdir/$tarname")) { + tlwarn("$0: Couldn't compress $destdir/$tarname\n"); + return (0,0, ""); + } } else { tlwarn("$0: Couldn't find $destdir/$tarname to run $compressor\n"); return (0, 0, ""); diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 46ac201c031..da59eb99bdd 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -39,6 +39,7 @@ C -- utilities used in TeX Live infrastructure TeXLive::TLUtils::wsystem($msg,@args); TeXLive::TLUtils::xsystem(@args); TeXLive::TLUtils::run_cmd($cmd); + TeXLive::TLUtils::system_pipe($prog, $infile, $outfile, $removeIn, @extraargs); =head2 File utilities @@ -177,6 +178,7 @@ BEGIN { &wsystem &xsystem &run_cmd + &system_pipe &announce_execute_actions &add_symlinks &remove_symlinks @@ -202,7 +204,7 @@ BEGIN { ); @EXPORT = qw(setup_programs download_file process_logging_options tldie tlwarn info log debug ddebug dddebug debug_hash - win32 xchdir xsystem run_cmd sort_archs); + win32 xchdir xsystem run_cmd system_pipe sort_archs); } use Cwd; @@ -623,6 +625,37 @@ sub run_cmd { return ($output,$retval); } +=item C + +Runs C<$prog> with C<@extraargs> redirecting stdin from C<$infile>, stdout to C<$outfile>. +Removes C<$infile> if C<$removeIn> is true. + +=cut + +sub system_pipe { + my ($prog, $infile, $outfile, $removeIn, @extraargs) = @_; + + my $progQuote = quotify_path_with_spaces($prog); + if (win32()) { + $infile =~ s!/!\\!g; + $outfile =~ s!/!\\!g; + } + my $infileQuote = "\"$infile\""; + my $outfileQuote = "\"$outfile\""; + debug("TLUtils::system_pipe: calling $progQuote @extraargs < $infileQuote > $outfileQuote\n"); + my $retval = system("$progQuote @extraargs < $infileQuote > $outfileQuote"); + if ($retval != 0) { + $retval /= 256 if $retval > 0; + debug("TLUtils::system_pipe: system exit code = $retval\n"); + return 0; + } else { + if ($removeIn) { + debug("TLUtils::system_pipe: removing $infile\n"); + unlink($infile); + } + return 1; + } +} =back @@ -2154,8 +2187,7 @@ sub unpack { } # only check the necessary compressor program - my $decompressor = TeXLive::TLUtils::quotify_path_with_spaces( - $::progs{$DecompressorProgram{$type}}); + my $decompressor = $::progs{$DecompressorProgram{$type}}; my @decompressorArgs = @{$DecompressorArgs{$type}}; if (!defined($decompressor)) { return (0, "programs not set up properly"); @@ -2169,17 +2201,6 @@ sub unpack { my $containerfile = "$tempdir/$fn"; my $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.$compressorextension$//; - my $containerfile_quote; - my $tarfile_quote; - my $target_quote; - if (win32()) { - $containerfile =~ s!/!\\!g; - $tarfile =~ s!/!\\!g; - $target =~ s!/!\\!g; - } - $containerfile_quote = "\"$containerfile\""; - $tarfile_quote = "\"$tarfile\""; - $target_quote = "\"$target\""; if ($what =~ m,^(https?|ftp)://, || $what =~ m!$SshURIRegex!) { # we are installing from the NET # check for the presence of $what in $tempdir @@ -2210,14 +2231,12 @@ sub unpack { # we can remove it afterwards $remove_containerfile = 1; } - debug("decompressing $containerfile to $tarfile\n"); - debug("calling $decompressor @decompressorArgs < $containerfile_quote > $tarfile_quote\n"); - system("$decompressor @decompressorArgs < $containerfile_quote > $tarfile_quote"); - if (! -f $tarfile) { + if (!system_pipe($decompressor, $containerfile, $tarfile, $remove_container, @decompressorArgs) + || + ! -f $tarfile) { unlink($tarfile, $containerfile); return(0, "Decompressing $containerfile failed"); } - unlink($containerfile) if $remove_containerfile; if (untar($tarfile, $target, 1)) { return (1, "$pkg"); } else { -- cgit v1.2.3