summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2008-11-12 01:42:17 +0000
committerKarl Berry <karl@freefriends.org>2008-11-12 01:42:17 +0000
commita59da517d583ed0ae1bdafedd5c8d37c6d9e0965 (patch)
tree80d8bbee9a0ba8837d53dfd1cc347f34af4a92a5
parente0fa36719ae8b943d0c515ccc2a4f1e2670cc614 (diff)
* TeXLive/TLMedia.pm (install_package): call untar; debugging msg wording.
* TeXLive/TLUtils.pm (untar): new fn, so we have the tar invocation in one place, and use just the generic "xf", no -C, so hopefully it will work everywhere. (_install_package): call it. (Cwd): use. (copy): do not die "...\n", we want line number info. git-svn-id: svn://tug.org/texlive/trunk@11263 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Master/tlpkg/TeXLive/TLMedia.pm26
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm84
2 files changed, 66 insertions, 44 deletions
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 218987dbcb3..7102bbf2766 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -84,7 +84,6 @@ sub new
return $self;
}
-#
# returns a scalar (0) on error
# returns a reference to a hash with actions on success
sub install_package {
@@ -96,7 +95,7 @@ sub install_package {
if (!defined($tlpobj)) {
if (defined($fallbackmedia)) {
if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nopostinstall)) {
- debug("installed $pkg from fallback");
+ debug("installed $pkg from fallback\n");
return $ret;
} else {
tlwarn("$0: Cannot find package $pkg (in fallback, either)\n");
@@ -119,7 +118,7 @@ sub install_package {
$real_opt_doc = 1;
}
foreach my $h (@::install_packages_hook) {
- &$h("install: $package");
+ &$h("install: $pkg");
}
my $container;
my @installfiles;
@@ -234,8 +233,7 @@ sub _install_package {
# we assume that $::progs has been set up!
my $wget = $::progs{'wget'};
my $lzmadec = $::progs{'lzmadec'};
- my $tar = $::progs{'tar'};
- if (!defined($wget) || !defined($lzmadec) || !defined($tar)) {
+ if (!defined($wget) || !defined($lzmadec)) {
tlwarn("_install_package: programs not set up properly, strange.\n");
return(0);
}
@@ -293,10 +291,10 @@ sub _install_package {
# copy it to temp
copy($what, "$target/temp");
}
- debug("Un-lzmaing $lzmafile to $tarfile\n");
+ debug("un-lzmaing $lzmafile to $tarfile\n");
system("$lzmadec < $lzmafile_quote > $tarfile_quote");
if (! -f $tarfile) {
- tlwarn("Unpacking $lzmafile did not succeed, please retry!\n");
+ tlwarn("_install_package: Unpacking $lzmafile failed, please retry.\n");
unlink($tarfile, $lzmafile);
return(0);
}
@@ -307,7 +305,7 @@ sub _install_package {
if (!download_file($what, $tarfile) || (! -r $tarfile)) {
tlwarn("Downloading \n");
tlwarn(" $what\n");
- tlwarn("did not succeed, please retry!\n");
+ tlwarn("failed, please retry.\n");
unlink($tarfile);
return(0);
}
@@ -316,17 +314,9 @@ sub _install_package {
$remove_tarfile = 0;
}
}
- debug("Unpacking $tarfile\n");
- if (system($tar,"-x","-C",$target,"-f",$tarfile) != 0) {
- tlwarn("Untarring $tarfile did not succeed, please retry!\n");
- unlink($tarfile) if $remove_tarfile;
- return(0);
- }
- # we are still here, so success!
- unlink($tarfile) if $remove_tarfile;
- return(1);
+ return TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile);
} else {
- tlwarn("Don't know how to install $what!\n");
+ tlwarn("_install_package: Don't know how to install $what\n");
return(0);
}
}
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 9f1f6b5ed30..34e01d5bb07 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -5,7 +5,6 @@
# This file is licensed under the GNU General Public License version 2
# or any later version.
-
package TeXLive::TLUtils;
=pod
@@ -70,7 +69,6 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
=cut
-
BEGIN {
use Exporter ();
use vars qw( @ISA @EXPORT_OK @EXPORT);
@@ -105,6 +103,7 @@ BEGIN {
&member
&quotewords
&conv_to_w32_path
+ &untar
&setup_programs
&download_file
&merge_into
@@ -118,12 +117,12 @@ BEGIN {
process_logging_options win32);
}
-
-use TeXLive::TLConfig;
-use Getopt::Long;
+use Cwd;
use Digest::MD5;
+use Getopt::Long;
-$::opt_verbosity = 0;
+use TeXLive::TLConfig;
+$::opt_verbosity = 0; # see process_logging_options
=pod
@@ -706,7 +705,6 @@ sub copy {
my $dirmode=0755;
my $blocksize=2048;
-
$infile =~ s!^file://*!/!i;
$filename=basename "$infile";
if ($filemode) {
@@ -722,13 +720,13 @@ sub copy {
if (-l "$infile") {
symlink readlink "$infile", "$destdir/$filename";
} else {
- open IN, "$infile" or die "Can't open '$infile': $!\n";
+ open (IN, $infile) || die "open($infile) failed: $!";
binmode IN;
$mode=(-x "$infile")? oct("0777"):oct("0666");
$mode-=umask;
- open OUT, ">$outfile" or die "Can't open '$outfile': $!\n";
+ open (OUT, ">$outfile") || die "open(>$outfile) failed: $!";
binmode OUT;
chmod $mode, "$outfile";
@@ -873,10 +871,10 @@ sub install_packages {
}
$totlpdb->save;
}
-
+
=pod
-=item C<install_package($what, $size, $filelistref, $target, $platform)>
+=item C<install_package($what, $size, $md5, $filelistref, $target, $platform)>
This function installs the files given in @$filelistref from C<$what>
into C<$target>.
@@ -894,10 +892,9 @@ downloaded from the net and piped through C<lzmadec> and C<tar>.
If $what ends with C<.tar.lzma> (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
-piped through C<lzmadec> and C<tar> in the very same way.
+file on the system and is likewise piped through C<lzmadec> and C<tar>.
-In both of the last cases currently the list C<$@filelistref> currently
+In both of these cases currently the list C<$@filelistref> currently
is not taken into account (should be fixed!).
=cut
@@ -910,8 +907,7 @@ sub install_package {
# we assume that $::progs has been set up!
my $wget = $::progs{'wget'};
my $lzmadec = $::progs{'lzmadec'};
- my $tar = $::progs{'tar'};
- if (!defined($wget) || !defined($lzmadec) || !defined($tar)) {
+ if (!defined($wget) || !defined($lzmadec)) {
die "install_package: programs not set up properly, strange";
}
if (ref $what) {
@@ -936,7 +932,6 @@ sub install_package {
my $tarfile = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
my $lzmafile_quote = $lzmafile;
my $tarfile_quote = $tarfile;
- my $target_quote = $target;
if (win32()) {
$lzmafile =~ s!/!\\!g;
$tarfile =~ s!/!\\!g;
@@ -944,7 +939,6 @@ sub install_package {
}
$lzmafile_quote = "\"$lzmafile\"";
$tarfile_quote = "\"$tarfile\"";
- $target_quote = "\"$target\"";
my $gotfiledone = 0;
if (-r $lzmafile) {
# check that the downloaded file is not partial
@@ -1012,16 +1006,54 @@ sub install_package {
if (! -f $tarfile) {
die "Unpacking $lzmafile did not succeed, please retry";
}
- debug("unpacking $tarfile\n");
- system($tar,"-x","-C",$target,"-f",$tarfile);
- unlink($tarfile);
- debug("keeping $lzmafile for restarting ...\n");
- # unlink($lzmafile);
+ TeXLive::TLUtils::untar($tarfile, $target, 1);
} else {
- die "Don't know how to install $what!\n";
+ die "sorry, don't know how to install $what";
}
}
+
+=pod
+
+=item C<untar($tarfile,$targetdir, $remove_tarfile)>
+
+Unpacked C<$tarfile> in C<$targetdir> (changing directories to
+C<$targetdir> and then back to the original directory). If
+C<$remove_tarfile> is true, unlink C<$tarfile> after unpacking.
+
+Assumes the global C<$::progs{"tar"}> has been set up.
+
+=cut
+
+# return 1 if success, 0 if failure.
+sub untar {
+ my ($tarfile, $targetdir, $remove_tarfile) = @_;
+ my $ret;
+
+ my $tar = $::progs{'tar'}; # assume it's been set up
+
+ # don't use the -C option to tar since Solaris tar et al. don't support it.
+ # don't use system("cd ... && $tar ...") since that opens us up to
+ # quoting issues.
+ # so fall back on chdir in Perl.
+ #
+ debug("unpacking $tarfile in $targetdir\n");
+ my $cwd = cwd();
+ chdir($targetdir) || die "chdir($targetdir) failed: $!";
+
+ if (system($tar, "xf", $tarfile) != 0) {
+ tlwarn("untarring $tarfile failed, please retry\n");
+ $ret = 0;
+ } else {
+ $ret = 1;
+ }
+ unlink($tarfile) if $remove_tarfile;
+
+ chdir($cwd) || die "chdir($cwd) failed: $!";
+ return $ret;
+}
+
+
=pod
=item C<setup_programs( $bindir, $platform )>
@@ -1756,9 +1788,9 @@ sub give_ctan_mirror
}
sub tlmd5 {
- my $file = shift;
+ my ($file) = @_;
if (-r $file) {
- open(FILE, $file) or die "Can't open '$file': $!";
+ open(FILE, $file) || die "open($file) failed: $!";
binmode(FILE);
return Digest::MD5->new->addfile(*FILE)->hexdigest;
close(FILE);