summaryrefslogtreecommitdiff
path: root/Master
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2016-01-12 03:24:41 +0000
committerNorbert Preining <preining@logic.at>2016-01-12 03:24:41 +0000
commitab71272dc887ec428cdf2868adfd2c77431bdc48 (patch)
tree9ce9760ca852bd504a36886cab3c11cbe130d1d0 /Master
parentf4b76f9ebfdadf174da0ada9d6d48c71e40bf47d (diff)
Re-apply temporary removed changes to installer and tlmgr
The changes in svn 39284-39294 have been reverted in svn 39298 to fix a bug in TLDownload that slipped out (svn 39300). Reapply these changes. git-svn-id: svn://tug.org/texlive/trunk@39362 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rwxr-xr-xMaster/install-tl14
-rwxr-xr-xMaster/texmf-dist/scripts/texlive/tlmgr.pl15
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm53
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm429
4 files changed, 156 insertions, 355 deletions
diff --git a/Master/install-tl b/Master/install-tl
index 6264b543852..121a55673ad 100755
--- a/Master/install-tl
+++ b/Master/install-tl
@@ -747,6 +747,9 @@ sub do_installation {
calc_depends();
save_options_into_tlpdb();
+ # we need to do that dir, since we use the TLPDB->install_package which
+ # might change into texmf-dist for relocated packages
+ mkdirhier "$vars{'TEXDIR'}/texmf-dist";
do_install_packages();
if ($opt_custom_bin) {
$vars{'this_platform'} = "custom";
@@ -1626,6 +1629,13 @@ sub do_install_packages {
foreach my $package (sort keys %install) {
push @what, $package if ($install{$package} == 1);
}
+ # temporary unset the localtlpdb options responsible for
+ # running all kind of postactions, since install_packages
+ # would call them without the PATH already set up
+ # we are doing this anyway in do_postinstall_actions
+ $localtlpdb->option ("desktop_integration", "0");
+ $localtlpdb->option ("file_assocs", "0");
+ $localtlpdb->option ("post_code", "0");
if (!install_packages($tlpdb,$media,$localtlpdb,\@what,
$vars{'option_src'},$vars{'option_doc'})) {
my $profile_name = "installation.profile";
@@ -1641,6 +1651,10 @@ sub do_install_packages {
flushlog();
exit(1);
}
+ $localtlpdb->option ("desktop_integration", $vars{'option_desktop_integration'} ? "1" : "0");
+ $localtlpdb->option ("file_assocs", $vars{'option_file_assocs'});
+ $localtlpdb->option ("post_code", $vars{'option_post_code'} ? "1" : "0");
+ $localtlpdb->save;
}
# for later complete removal we want to save some options and values
diff --git a/Master/texmf-dist/scripts/texlive/tlmgr.pl b/Master/texmf-dist/scripts/texlive/tlmgr.pl
index 7619e353e31..c683e4a5263 100755
--- a/Master/texmf-dist/scripts/texlive/tlmgr.pl
+++ b/Master/texmf-dist/scripts/texlive/tlmgr.pl
@@ -3182,8 +3182,9 @@ sub action_update {
$remove_unwind_container = 1;
$unwind_package = $newname;
}
- my $instret = TeXLive::TLPDB->_install_package("$unwind_package", 0,
- [], $localtlpdb);
+
+ my ($instret, $msg) = TeXLive::TLUtils::unpack("$unwind_package",
+ $localtlpdb->root);
if ($instret) {
# now we have to include the tlpobj
my $tlpobj = TeXLive::TLPOBJ->new;
@@ -3196,6 +3197,7 @@ sub action_update {
} else {
logpackage("failed restore: $pkg ($rev)");
tlwarn("$prg: Restoring of old package did NOT succeed.\n");
+ tlwarn("$prg: Error message from unpack: $msg\n");
tlwarn("$prg: Most likely repair: run tlmgr install $pkg and hope.\n");
# TODO_ERRORCHECKING
# should we return F_ERROR here??? If we would do this, then
@@ -3668,9 +3670,12 @@ sub action_install {
info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg$tagstr [${kb}k]\n");
}
if (!$opts{"dry-run"}) {
- $remotetlpdb->install_package($pkg, $localtlpdb,
- ($packs{$pkg} ? $packs{$pkg} : undef) );
- logpackage("${re}install: $pkg$tagstr");
+ if ($remotetlpdb->install_package($pkg, $localtlpdb,
+ ($packs{$pkg} ? $packs{$pkg} : undef) )) {
+ logpackage("${re}install: $pkg$tagstr");
+ } else {
+ logpackage("failed ${re}install: $pkg$tagstr");
+ }
}
$donesize += $sizes{$pkg};
$currnr++;
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 90738ee0d54..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/
@@ -1404,9 +1407,9 @@ sub install_package_files {
#
# remove the RELOC prefix, but do NOT replace it with RelocTree
@installfiles = map { s!^$TeXLive::TLConfig::RelocPrefix/!!; $_; } @installfiles;
- # if the first argument of _install_package is scalar, it is the
+ # if the first argument of _install_data is scalar, it is the
# place from where files should be installed
- if (!_install_package ($tmpdir, \@installfiles, $reloc, \@installfiles, $self)) {
+ if (!_install_data ($tmpdir, \@installfiles, $reloc, \@installfiles, $self)) {
tlwarn("TLPDB::install_package_files: couldn't install $what!\n");
next;
}
@@ -1535,18 +1538,16 @@ sub not_virtual_install_package {
if ($media eq 'local_uncompressed') {
$container = \@installfiles;
} elsif ($media eq 'local_compressed') {
- if (-r "$root/$Archive/$pkg.zip") {
- $container = "$root/$Archive/$pkg.zip";
- } elsif (-r "$root/$Archive/$pkg.tar.xz") {
+ if (-r "$root/$Archive/$pkg.tar.xz") {
$container = "$root/$Archive/$pkg.tar.xz";
} else {
- tlwarn("TLPDB: cannot find package $pkg (.zip or .xz) in $root/$Archive\n");
+ tlwarn("TLPDB: cannot find package $pkg.tar.xz) in $root/$Archive\n");
next;
}
} elsif (&media eq 'NET') {
$container = "$root/$Archive/$pkg.$TeXLive::TLConfig::DefaultContainerExtension";
}
- $self->_install_package ($container, $reloc, \@installfiles, $totlpdb)
+ $self->_install_data ($container, $reloc, \@installfiles, $totlpdb, $tlpobj->containersize, $tlpobj->containermd5)
|| return(0);
# if we are installing from local_compressed or NET we have to fetch the respective
# source and doc packages $pkg.source and $pkg.doc and install them, too
@@ -1565,13 +1566,13 @@ sub not_virtual_install_package {
if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
my $srccontainer = $container;
$srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
- $self->_install_package ($srccontainer, $reloc, \@installfiles, $totlpdb)
+ $self->_install_data ($srccontainer, $reloc, \@installfiles, $totlpdb, $tlpobj->srccontainersize, $tlpobj->srccontainermd5)
|| return(0);
}
if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
my $doccontainer = $container;
$doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
- $self->_install_package ($doccontainer, $reloc, \@installfiles, $totlpdb)
+ $self->_install_data ($doccontainer, $reloc, \@installfiles, $totlpdb, $tlpobj->doccontainersize, $tlpobj->doccontainermd5)
|| return(0);
}
#
@@ -1614,8 +1615,13 @@ sub not_virtual_install_package {
# archives (.tar.xz) but at DVD install time we don't have them
my $tlpod = $totlpdb->root . "/tlpkg/tlpobj";
mkdirhier( $tlpod );
- open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or
- die("Cannot open tlpobj file for ".$tlpobj->name);
+ my $count = 0;
+ until (open(TMP,">$tlpod/".$tlpobj->name.".tlpobj")) {
+ # 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);
$totlpdb->add_tlpobj($tlpobj);
@@ -1642,12 +1648,15 @@ sub not_virtual_install_package {
}
#
-# _install_package
+# _install_data
# actually does the installation work
# returns 1 on success and 0 on error
#
-sub _install_package {
- my ($self, $what, $reloc, $filelistref, $totlpdb) = @_;
+# if the first argument is a string, then files are taken from this directory
+# otherwise it is a tlpdb from where to install
+#
+sub _install_data {
+ my ($self, $what, $reloc, $filelistref, $totlpdb, $whatsize, $whatcheck) = @_;
my $target = $totlpdb->root;
my $tempdir = "$target/temp";
@@ -1658,7 +1667,7 @@ sub _install_package {
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);
}
@@ -1689,15 +1698,15 @@ sub _install_package {
}
# we always assume that copy will work
return(1);
- } elsif ($what =~ m,\.tar(\.xz)?$,) {
+ } elsif ($what =~ m,\.tar\.xz$,) {
if ($reloc) {
if (!$totlpdb->setting("usertree")) {
$target .= "/$TeXLive::TLConfig::RelocTree";
}
}
- my $pkg = TeXLive::TLUtils::unpack($what, $target);
- 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 b2c74c3a6ca..e1c85f049b8 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -77,7 +77,6 @@ C<TeXLive::TLUtils> -- 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);
@@ -1341,96 +1340,9 @@ sub install_packages {
foreach my $h (@::install_packages_hook) {
&$h($n,$totalnr);
}
- 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);
+ # TODO TODO
+ # we do NOT check the return value!!!
+ $fromtlpdb->install_package($package, $totlpdb);
$donesize += $tlpsizes{$package};
}
my $totaltime = time() - $starttime;
@@ -1442,173 +1354,6 @@ sub install_packages {
return 1;
}
-
-=item C<install_package($what, $reloc, $size, $md5, $filelistref, $target, $platform)>
-
-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<http://> or C<ftp://> then C<$what> is
-downloaded from the net and piped through C<xzdec> and C<tar>.
-
-If $what ends with C<.tar.xz> (but does not start with C<http://> or
-C<ftp://>, but possibly with C<file:/>) it is assumed to be a readable
-file on the system and is likewise piped through C<xzdec> and C<tar>.
-
-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<do_postaction($how, $tlpobj, $do_fileassocs, $do_menu, $do_desktop, $do_script)>
Evaluates the C<postaction> fields in the C<$tlpobj>. The first parameter
@@ -2203,102 +1948,130 @@ sub w32_remove_from_path {
=pod
-=item C<unpack($what, $targetdir>
+=item C<check_file($what, $checksum, $checksize>
+
+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<unpack($what, $targetdir, @opts>
If necessary, downloads C$what>, and then unpacks it into C<$targetdir>.
-Returns the name of the unpacked package (determined from the name of C<$what>)
-in case of success, otherwise undefined.
+C<@opts> is assigned to a hash and can contain the following
+options: C<tmpdir> (use this directory for downloaded files),
+C<checksum> (check downloaded file against this checksum),
+C<size> (check downloaded file against this size),
+C<remove> (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.
=cut
sub unpack {
- my ($what, $target) = @_;
+ 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);
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)?$,) {
- $type = defined($what) ? "xz" : "tar";
- } else {
- tlwarn("TLUtils::unpack: don't know how to unpack this: $what\n");
- return;
+ if ($what !~ m/\.tar\.xz$/) {
+ return(0, "don't know how to unpack");
}
- 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_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;
+ 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");
}
- } 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 {
- $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";
+ # 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");
} else {
- return;
+ return (0, "untar failed");
}
}