summaryrefslogtreecommitdiff
path: root/Build/source/texk/tests
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2018-07-04 21:19:25 +0000
committerKarl Berry <karl@freefriends.org>2018-07-04 21:19:25 +0000
commita2dda8b02b5516aca742efff690705ee720d810a (patch)
treed93ca539e1ece6e3e27e96fb7182c730d608a05f /Build/source/texk/tests
parent9d5e239b66f12f75c7e0b7c869bbacd18429130d (diff)
doc,sync,exec
git-svn-id: svn://tug.org/texlive/trunk@48133 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/tests')
-rw-r--r--Build/source/texk/tests/TeXLive/TLConfig.pm48
-rw-r--r--Build/source/texk/tests/TeXLive/TLUtils.pm96
2 files changed, 82 insertions, 62 deletions
diff --git a/Build/source/texk/tests/TeXLive/TLConfig.pm b/Build/source/texk/tests/TeXLive/TLConfig.pm
index afafeea13c3..3efef6a5c96 100644
--- a/Build/source/texk/tests/TeXLive/TLConfig.pm
+++ b/Build/source/texk/tests/TeXLive/TLConfig.pm
@@ -1,4 +1,4 @@
-# $Id: TLConfig.pm 47938 2018-06-06 01:35:10Z preining $
+# $Id: TLConfig.pm 48093 2018-06-26 21:03:56Z preining $
# TeXLive::TLConfig.pm - module exporting configuration values
# Copyright 2007-2018 Norbert Preining
# This file is licensed under the GNU General Public License version 2
@@ -6,7 +6,7 @@
package TeXLive::TLConfig;
-my $svnrev = '$Revision: 47938 $';
+my $svnrev = '$Revision: 48093 $';
my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
sub module_revision { return $_modulerevision; }
@@ -27,14 +27,8 @@ BEGIN {
%FallbackDownloaderProgram
%FallbackDownloaderArgs
$DefaultCompressorFormat
- $DefaultContainerExtension
- @AcceptedCompressors
- $AcceptedCompressorsRegexp
- %CompressorProgram
- %DecompressorProgram
- %CompressorArgs
- %DecompressorArgs
- %CompressorExtension
+ $CompressorExtRegexp
+ %Compressors
$InfraLocation
$DatabaseName
$PackageBackupDir
@@ -122,22 +116,36 @@ our $DefaultFallbackDownloader = "wget";
our @AcceptedFallbackDownloaders = qw/curl wget/;
our %FallbackDownloaderProgram = ( 'wget' => 'wget', 'curl' => 'curl');
our %FallbackDownloaderArgs = (
- 'curl' => ['--user-agent', 'texlive/curl', '--retry', '10',
+ 'curl' => ['--user-agent', 'texlive/curl', '--retry', '10', '--fail', '--location',
'--connect-timeout', "$NetworkTimeout", '--silent', '--output'],
'wget' => ['--user-agent=texlive/wget', '--tries=10',
"--timeout=$NetworkTimeout", '-q', '-O'],
);
# the way we package things on the web
our $DefaultCompressorFormat = "xz";
-our $DefaultContainerExtension = "tar.$DefaultCompressorFormat";
-# mind that the order here is important as gives also the preference!
-our @AcceptedCompressors = qw/lz4 gzip xz/;
-our $AcceptedCompressorsRegexp = "(xz|lz4|gzip)";
-our %CompressorProgram = ( 'xz' => 'xz', 'gzip' => 'gzip', 'lz4' => 'lz4');
-our %CompressorExtension = ( 'xz' => 'xz', 'gzip' => 'gz', 'lz4' => 'lz4');
-our %CompressorArgs = ( 'xz' => ['-zf'], 'gzip' => [ '-f' ], 'lz4' => ['-zfm', '--rm', '-q']);
-our %DecompressorProgram = ( 'xz' => 'xz', 'gzip' => 'gzip', 'lz4' => 'lz4');
-our %DecompressorArgs = ( 'xz' => ['-dcf'], 'gzip' => ['-dcf'], 'lz4' => ['-dcf']);
+# priority defines which compressor is selected for backups/rollback containers
+# less is better
+our %Compressors = (
+ "lz4" => {
+ "decompress_args" => ["-dcf"],
+ "compress_args" => ["-zfmq", "--rm"],
+ "extension" => "lz4",
+ "priority" => 10,
+ },
+ "gzip" => {
+ "decompress_args" => ["-dcf"],
+ "compress_args" => ["-f"],
+ "extension" => "gz",
+ "priority" => 20,
+ },
+ "xz" => {
+ "decompress_args" => ["-dcf"],
+ "compress_args" => ["-zf"],
+ "extension" => "xz",
+ "priority" => 30,
+ },
+);
+our $CompressorExtRegexp = "(" . join("|", map { $Compressors{$_}{'extension'} } keys(%Compressors)) . ")";
# archive (not user) settings.
# these can be overridden by putting them into 00texlive.config.tlpsrc
diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm
index 0c3f8419fcc..372009d16c1 100644
--- a/Build/source/texk/tests/TeXLive/TLUtils.pm
+++ b/Build/source/texk/tests/TeXLive/TLUtils.pm
@@ -1,4 +1,4 @@
-# $Id: TLUtils.pm 47887 2018-05-31 16:50:47Z karl $
+# $Id: TLUtils.pm 48130 2018-07-03 22:24:07Z preining $
# TeXLive::TLUtils.pm - the inevitable utilities for TeX Live.
# Copyright 2007-2018 Norbert Preining, Reinhard Kotucha
# This file is licensed under the GNU General Public License version 2
@@ -6,7 +6,7 @@
package TeXLive::TLUtils;
-my $svnrev = '$Revision: 47887 $';
+my $svnrev = '$Revision: 48130 $';
my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
sub module_revision { return $_modulerevision; }
@@ -39,6 +39,7 @@ C<TeXLive::TLUtils> -- 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<system_pipe($prog, $infile, $outfile, $removeIn, @extraargs)>
+
+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
@@ -2136,31 +2169,23 @@ sub unpack {
return (0, "nothing to unpack");
}
- my $type;
+ my $decompressorType;
my $compressorextension;
- for my $comptype (@AcceptedCompressors) {
- my $ext = $CompressorExtension{$comptype};
- if ($what =~ m/\.tar\.$ext$/) {
- $type = $comptype;
- $compressorextension = $ext;
- }
+ if ($what =~ m/\.tar\.$CompressorExtRegexp$/) {
+ $compressorextension = $1;
+ $decompressorType = $1 eq "gz" ? "gzip" : $1;
}
- if (!$type) {
+ if (!$decompressorType) {
return(0, "don't know how to unpack");
}
# make sure that the found uncompressor type is also available
- if (!member($type, @{$::progs{'working_compressors'}})) {
- return(0, "unsupported container format $type");
+ if (!member($decompressorType, @{$::progs{'working_compressors'}})) {
+ return(0, "unsupported container format $decompressorType");
}
# only check the necessary compressor program
- my $decompressor = TeXLive::TLUtils::quotify_path_with_spaces(
- $::progs{$DecompressorProgram{$type}});
- my @decompressorArgs = @{$DecompressorArgs{$type}};
- if (!defined($decompressor)) {
- return (0, "programs not set up properly");
- }
-
+ my $decompressor = $::progs{$decompressorType};
+ my @decompressorArgs = @{$Compressors{$decompressorType}{'decompress_args'}};
my $fn = basename($what);
my $pkg = $fn;
@@ -2169,17 +2194,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 +2224,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 {
@@ -2364,16 +2376,15 @@ sub setup_programs {
}
$::progs{'working_downloaders'} = [ @working_downloaders ];
my @working_compressors;
- for my $comptype (@AcceptedCompressors) {
- my $defprog = $CompressorProgram{$comptype};
+ for my $defprog (sort {$Compressors{$a}{'priority'} <=> $Compressors{$b}{'priority'}} keys %Compressors) {
# do not warn on errors
if (setup_one(($isWin ? "w32" : "unix"), $defprog,
- "$bindir/$comptype/$defprog.$platform", "--version", 1)) {
- push @working_compressors, $comptype;
+ "$bindir/$defprog/$defprog.$platform", "--version", 1)) {
+ push @working_compressors, $defprog;
# also set up $::{'compressor'} if not already done
# this selects the first one, but we might reset this depending on
# TEXLIVE_COMPRESSOR setting, see below
- defined($::progs{'compressor'}) || ($::progs{'compressor'} = $comptype);
+ defined($::progs{'compressor'}) || ($::progs{'compressor'} = $defprog);
}
}
$::progs{'working_compressors'} = [ @working_compressors ];
@@ -3897,7 +3908,8 @@ sub slurp_file {
=item C<< download_to_temp_or_file($url) >>
-If C<$url> tries to download the file into a temporary file.
+If C<$url> is a url, tries to download the file into a temporary file.
+Otherwise assume that C<$url> is a local file.
In both cases returns the local file.
Returns the local file name if succeeded, otherwise undef.