diff options
Diffstat (limited to 'Master/tlpkg/TeXLive/TLUtils.pm')
| -rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 219 |
1 files changed, 163 insertions, 56 deletions
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 "ewords &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=@_; |