summaryrefslogtreecommitdiff
path: root/Master/tlpkg
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-04-16 10:30:44 +0000
committerNorbert Preining <preining@logic.at>2008-04-16 10:30:44 +0000
commit819a736f4a34367ec63da21b0c221cd4749ab0d1 (patch)
tree9a624ca46063606b55fb7923084f40f5dcd93302 /Master/tlpkg
parentcbcd661b4ec0163299c6494524dd5ad2afbdef38 (diff)
rework installation
git-svn-id: svn://tug.org/texlive/trunk@7445 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg')
-rw-r--r--Master/tlpkg/TeXLive/TLMedia.pm100
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm12
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm219
3 files changed, 216 insertions, 115 deletions
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
index 061e369b6a8..1d04b2233db 100644
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ b/Master/tlpkg/TeXLive/TLMedia.pm
@@ -280,36 +280,21 @@ sub install_package {
}
sub _install_package {
- sub mysystem {
- my $cmd = shift;
- # print "DEBUG: $cmd\n";
- system("$cmd");
- }
my ($self, $what, $filelistref, $totlpdb) = @_;
- my $buffer;
- my $offset;
- my $blocksize=2048;
+
my $media = $self->media;
my $target = $totlpdb->root;
- $blocksize=4096 if ($media eq 'NET');
-
my @filelist = @$filelistref;
- my $bindir = "$target/tlpkg/installer";
- my $platform = $totlpdb->option_platform;
- # unix defaults
- my $wget = "wget";
- my $lzmadec = "$bindir/lzmadec.$platform";
- my $tar = "tar";
- if (win32()) {
- $wget = conv_to_win_path("$bindir/wget.exe");
- #$tar = conv_to_win_path("$bindir/bsdtar.exe");
- # try Akira's tar.exe
- $tar = conv_to_win_path("$bindir/tar.exe");
- $lzmadec = conv_to_win_path("$lzmadec");
- $target =~ s!/!\\!g;
+ # 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)) {
+ die "Programs have not been set up properly, strange!";
}
+
if (ref $what) {
# we are getting a ref to a list of files, so install from DVD
my $location = $self->location;
@@ -320,43 +305,46 @@ sub _install_package {
mkdirhier("$target/$dn");
copy "$location/$file", "$target/$dn";
}
- } elsif ($what =~ m,http://|ftp://,) {
- # we are installing from the NET
- # currently the list of file @filelist is NOT EVALUATED!!!
- if (win32()) {
- # we need temporary files here
- # tmpdir is $target/temp
- my $fn = basename($what);
- my $tarfile = $fn;
- $tarfile =~ s/\.lzma$//;
- mkdirhier("$target/temp");
- tllog($::LOG_DEBUG, "Downloading $what to $target\\temp\\$fn\n");
- tllog($::LOG_DEBUG, `$wget --tries=2 --timeout=60 -q -O \"$target\\temp\\$fn\" \"$what\" 2>\&1`);
- tllog($::LOG_DEBUG, "Un-lzmaing $target\\temp\\$fn to $target\\temp\\$tarfile\n");
- #tllog($::LOG_DEBUG, `type \"$target\\temp\\$fn\" | $lzmadec > \"$target\\temp\\$tarfile\" 2>&1`);
- tllog($::LOG_DEBUG, `$lzmadec < \"$target\\temp\\$fn\" > \"$target\\temp\\$tarfile\" 2>&1`);
- tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
- tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
- unlink("$target/temp/$tarfile", "$target/temp/$fn");
- } else {
- tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
- tllog($::LOG_NORMAL, `$wget --tries=2 --timeout=60 -q -O- \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\"`);
- }
} elsif ($what =~ m,\.tar.lzma$,) {
+ # this is the case when we install from CD or the NET
+ #
+ # in all other cases we create temp files .tar.lzma (or use the present
+ # one), lzmadec them, and then call tar
+
+ my $fn = basename($what);
+ mkdirhier("$target/temp");
+ my $lzmafile = "$target/temp/$fn";
+ my $tarfile = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
+ my $lzmafile_quote = $lzmafile;
+ my $tarfile_quote = $tarfile;
+ my $target_quote = $target;
if (win32()) {
- my $fn = basename($what);
- my $tarfile = $fn;
- $tarfile =~ s/\.lzma$//;
- mkdirhier("$target/temp");
- tllog($::LOG_DEBUG, "Un-lzmaing $what to $target\\temp\\$tarfile\n");
- tllog($::LOG_DEBUG, `$lzmadec < \"$what\" > \"$target\\temp\\$tarfile\" 2>&1`);
- tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
- tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
- unlink("$target/temp/$tarfile");
+ $lzmafile =~ s!/!\\!g;
+ $lzmafile_quote = "\"$lzmafile\"";
+ $tarfile =~ s!/!\\!g;
+ $tarfile_quote = "\"$tarfile\"";
+ $target =~ s!/!\\!g;
+ $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, $lzmafile) || (! -r $lzmafile)) {
+ die "Downloading $what did not succeed, please retry!";
+ }
} else {
- tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
- tllog($::LOG_DEBUG, `cat \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\" 2>&1`);
+ # we are installing from CD
+ # copy it to temp
+ copy($what, "$target/temp");
+ }
+ tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tarfile\n");
+ system("$lzmadec < $lzmafile_quote > $tarfile_quote");
+ if (! -f $tarfile) {
+ die "Unpacking $lzmafile did not succeed, please retry!";
}
+ tllog($::LOG_DEBUG, "Unpacking $tarfile\n");
+ system($tar,"-x","-C",$target,"-f",$tarfile);
+ unlink($tarfile, $lzmafile);
} else {
die "Don't know how to install $what!\n";
}
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 135e5856104..fc8d7b1ac58 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -181,18 +181,24 @@ sub from_file {
} else {
$self->root($root_from_path);
}
+ my $retfh;
if ($path =~ /^(http|ftp):\/\//) {
tllog($::LOG_DDDEBUG, "TLPDB.pm: trying to initialize from $path\n");
- open(TMP, "wget -q --output-document=- $path|")
- || die("Cannot open tlpdb file: $path");
+ $retfh = TeXLive::TLUtils::download_file($path, "|");
+ #open(TMP, "wget -q --output-document=- $path|")
+ # || die("Cannot open tlpdb file: $path");
+ if (!$retfh) {
+ die("Cannot open tlpdb file: $path");
+ }
} else {
open(TMP,"<$path") || die("Cannot open tlpdb file: $path");
+ $retfh = \*TMP;
}
my $found = 0;
do {
my $tlp = TeXLive::TLPOBJ->new;
tllog($::LOG_DDDEBUG, "creating tlp from $path...\n");
- $found = $tlp->from_fh(\*TMP,1);
+ $found = $tlp->from_fh($retfh,1);
if ($found) {
$self->add_tlpobj($tlp);
}
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index ccc464bfde9..a1d455295fe 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -39,6 +39,8 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::dirname_and_basename($path);
TeXLive::TLUtils::mkdirhier($path);
TeXLive::TLUtils::copy($file, $target_dir);
+ TeXLive::TLUtils::download_file( $path, $destination [, $progs ] );
+ TeXLive::TLUtils::setup_programs( $bindir, $platform);
=head2 Installer Functions
@@ -105,8 +107,10 @@ BEGIN {
&kpsewhich
&quotewords
&conv_to_win_path
+ &setup_programs
+ &download_file
);
- @EXPORT = qw(tllog);
+ @EXPORT = qw(tllog setup_programs download_file);
}
@@ -633,32 +637,16 @@ is not taken into account (should be fixed!).
=cut
sub install_package {
- sub mysystem {
- my $cmd = shift;
- # print "DEBUG: $cmd\n";
- system("$cmd");
- }
my ($what, $filelistref, $target, $platform) = @_;
- my $buffer;
- my $offset;
- my $blocksize=2048;
-
- $blocksize=4096 if ($::_media_ eq 'NET');
my @filelist = @$filelistref;
- my $bindir = "$::installerdir/tlpkg/installer";
- # unix defaults
- my $wget = "wget";
- my $lzmadec = "$bindir/lzmadec.$::_platform_";
- my $tar = "tar";
- if (win32()) {
- $wget = conv_to_win_path("$bindir/wget.exe");
- #$tar = conv_to_win_path("$bindir/bsdtar.exe");
- # try Akira's tar.exe
- $tar = conv_to_win_path("$bindir/tar.exe");
- $lzmadec = conv_to_win_path("$lzmadec");
- $target =~ s!/!\\!g;
+ # 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)) {
+ die "Programs have not been set up properly, strange!";
}
if (ref $what) {
# we are getting a ref to a list of files, so install from DVD
@@ -669,48 +657,167 @@ sub install_package {
mkdirhier("$target/$dn");
copy "$file", "$target/$dn";
}
- } elsif ($what =~ m,http://|ftp://,) {
- # we are installing from the NET
- # currently the list of file @filelist is NOT EVALUATED!!!
- if (win32()) {
- # we need temporary files here
- # tmpdir is $target/temp
- my $fn = basename($what);
- my $tarfile = $fn;
- $tarfile =~ s/\.lzma$//;
- mkdirhier("$target/temp");
- tllog($::LOG_DEBUG, "Downloading $what to $target\\temp\\$fn\n");
- tllog($::LOG_DEBUG, `$wget -q -O \"$target\\temp\\$fn\" \"$what\" 2>\&1`);
- tllog($::LOG_DEBUG, "Un-lzmaing $target\\temp\\$fn to $target\\temp\\$tarfile\n");
- #tllog($::LOG_DEBUG, `type \"$target\\temp\\$fn\" | $lzmadec > \"$target\\temp\\$tarfile\" 2>&1`);
- tllog($::LOG_DEBUG, `$lzmadec < \"$target\\temp\\$fn\" > \"$target\\temp\\$tarfile\" 2>&1`);
- tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
- tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
- unlink("$target/temp/$tarfile", "$target/temp/$fn");
- } else {
- tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
- tllog($::LOG_NORMAL, `$wget -q -O- \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\"`);
- }
} elsif ($what =~ m,\.tar.lzma$,) {
+ # this is the case when we install from CD or the NET
+ #
+ # in all other cases we create temp files .tar.lzma (or use the present
+ # one), lzmadec them, and then call tar
+
+ my $fn = basename($what);
+ mkdirhier("$target/temp");
+ my $lzmafile = "$target/temp/$fn";
+ my $tarfile = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//;
+ my $lzmafile_quote = $lzmafile;
+ my $tarfile_quote = $tarfile;
+ my $target_quote = $target;
if (win32()) {
- my $fn = basename($what);
- my $tarfile = $fn;
- $tarfile =~ s/\.lzma$//;
- mkdirhier("$target/temp");
- tllog($::LOG_DEBUG, "Un-lzmaing $what to $target\\temp\\$tarfile\n");
- tllog($::LOG_DEBUG, `$lzmadec < \"$what\" > \"$target\\temp\\$tarfile\" 2>&1`);
- tllog($::LOG_DEBUG, "Unpacking temp\\$tarfile\n");
- tllog($::LOG_DEBUG, `pushd \"$target\" & $tar -xf \"temp\\$tarfile\" 2>&1`);
- unlink("$target/temp/$tarfile");
+ $lzmafile =~ s!/!\\!g;
+ $lzmafile_quote = "\"$lzmafile\"";
+ $tarfile =~ s!/!\\!g;
+ $tarfile_quote = "\"$tarfile\"";
+ $target =~ s!/!\\!g;
+ $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, $lzmafile) || (! -r $lzmafile)) {
+ die "Downloading $what did not succeed, please retry!";
+ }
} else {
- tllog($::LOG_DEBUG, "downloading/unlzma-ing/unpacking $what\n");
- tllog($::LOG_DEBUG, `cat \"$what\"|\"$lzmadec\"|$tar -xf - -C \"$target\" 2>&1`);
+ # we are installing from CD
+ # copy it to temp
+ copy($what, "$target/temp");
+ }
+ tllog($::LOG_DEBUG, "Un-lzmaing $lzmafile to $tarfile\n");
+ system("$lzmadec < $lzmafile_quote > $tarfile_quote");
+ if (! -f $tarfile) {
+ die "Unpacking $lzmafile did not succeed, please retry!";
}
+ tllog($::LOG_DEBUG, "Unpacking $tarfile\n");
+ system($tar,"-x","-C",$target,"-f",$tarfile);
+ unlink($tarfile, $lzmafile);
} else {
die "Don't know how to install $what!\n";
}
}
+=pod
+
+=item C<setup_programs( $bindir, $platform )>
+
+Sets up the global $::progs hash containing the pathes to the
+programs C<wget>, C<tar>, C<lzmadec>. The C<$bindir> argument specifies
+the path to the location of the C<lzmadec> binaries, the C<$platform>
+gives the extension for the C<lzmadec> binary.
+
+=cut
+
+sub setup_programs {
+ my ($bindir, $platform) = @_;
+ $::progs{'wget'} = "wget";
+ $::progs{'lzmadec'} = "$bindir/lzmadec.$platform";
+ $::progs{'tar'} = "tar";
+ if (win32()) {
+ $::progs{'wget'} = conv_to_win_path("$bindir/wget.exe");
+ $::progs{'tar'} = conv_to_win_path("$bindir/tar.exe");
+ $::progs{'lzmadec'} = conv_to_win_path($::progs{'lzmadec'});
+ }
+}
+
+=pod
+
+=item C<download_file( $path, $destination [, $progs ] )>
+
+Try to download the file given in C<$relpath> from either C<$TeXLiveURL>
+or C<TeXLiveAlternativeURL> into C<$destination> (a filename!).
+
+The optional argument C<$progs> is a hash giving full pathes to the
+respective programs, at least C<wget>. In case that C<$progs> is not given
+the C<%::progs> is consulted, and if this also does not exist we try "wget".
+
+=cut
+
+sub download_file {
+ my ($relpath, $dest, $progs) = @_;
+ my $wget;
+ if (defined($progs) && defined($progs->{'wget'})) {
+ $wget = $progs->{'wget'};
+ } elsif (defined($::progs{'wget'})) {
+ $wget = $::progs{'wget'};
+ } else {
+ warn ("Programs have not been set up, trying simply wget");
+ $wget = "wget";
+ }
+ if (win32()) {
+ $dest =~ s!/!\\!g;
+ }
+ my $url;
+ if ($relpath =~ /^(http|ftp):\/\//) {
+ $url = $relpath;
+ } else {
+ $url = "$TeXLiveURL/$relpath";
+ }
+
+ tllog($::LOG_DEBUG, "Trying to download $url\n");
+ my $ret;
+ if ($dest eq "|") {
+ open(RETFH, "$wget --tries=2 --timeout=60 -q --output-document=- $url|") or
+ die("Cannot open $url via wget for reading");
+ # opening to a pipe always succeeds, so we return immediately
+ return \*RETFH;
+ } else {
+ $ret = system $wget, "-q", "--tries=2", "--timeout=60", "-O", $dest, $url;
+ # we have to reverse the meaning of ret because systems returns
+ # the inverse
+ $ret = ($ret ? 0 : 1);
+ }
+ if (!$ret) {
+ tllog($::LOG_DEBUG, "Download/Opening $url did not succeed\n");
+ if ($relpath =~ /^(http|ftp):\/\//) {
+ # we did get a full url, give up immediately
+ return undef;
+ }
+
+ # First we try the alternative URL
+ if ($TeXLiveAlternativeURL) {
+ $url = "$TeXLiveAlternativeURL/$relpath";
+ tllog($::LOG_DEBUG, "Trying to download $url\n");
+ if ($dest eq "|") {
+ open(RETFH, "$wget --tries=2 --timeout=60 -q --output-document=- $url|") or
+ die("Cannot open $url via wget for reading");
+ # opening to a pipe always succeeds, so we return immediately
+ return \*RETFH;
+ } else {
+ $ret = system $wget, "-q", "--tries=2", "--timeout=60", "-O", $dest, $url;
+ if ($ret) {
+ $ret = 0;
+ }
+ }
+ if ($ret) {
+ # ok, we give up
+ tllog($::LOG_DEBUG, "Download/Open $url did not succeed, giving up\n");
+ return;
+ } else {
+ tllog($::LOG_DEBUG, "Download/Open $url did succeed\n");
+ if ($dest eq "|") {
+ return \*RETFH;
+ } else {
+ return 1;
+ }
+ }
+ }
+ # could we try something else?
+ return undef;
+ }
+ tllog($::LOG_DEBUG, "Download $url did succeed\n");
+ if ($dest eq "|") {
+ return \*RETFH;
+ } else {
+ return 1;
+ }
+}
+
sub install_package_old {
# either a list of files or a name of one .zip or .tar.lzma file.
my @what=@_;