#!/usr/local/bin/perl
# download.cgi
# Get a perl module from somewhere
require './cpan-lib.pl';
if ($ENV{REQUEST_METHOD} eq "POST") { &ReadParseMime(); }
else { &ReadParse(); $no_upload = 1; }
&error_setup($text{'download_err'});
if ($in{'source'} >= 2) {
&ui_print_unbuffered_header(undef, $text{'download_title'}, "");
}
else {
&ui_print_header(undef, $text{'download_title'}, "");
}
&tempname();
if ($in{'source'} == 0) {
# installing from local file (or maybe directory)
if (!$in{'local'})
{ &install_error($text{'download_elocal'}); }
if (!-r $in{'local'})
{ &install_error(&text('download_elocal2', $in{'local'})); }
$source = $in{'local'};
@pfile = ( $in{'local'} );
$need_unlink = 0;
}
elsif ($in{'source'} == 1) {
# installing from upload .. store file in temp location
if ($no_upload) {
&install_error($text{'download_eupload'});
}
$in{'upload_filename'} =~ /([^\/\\]+$)/;
@pfile = ( &tempname("$1") );
open(PFILE, ">$pfile[0]");
print PFILE $in{'upload'};
close(PFILE);
$source = $in{'upload_filename'};
$need_unlink = 1;
}
elsif ($in{'source'} == 2) {
# installing from URL.. store downloaded file in temp location
$in{'url'} =~ /\/([^\/]+)\/*$/;
@pfile = ( &tempname("$1") );
$progress_callback_url = $in{'url'};
if ($in{'url'} =~ /^(http|https):\/\/([^\/]+)(\/.*)$/) {
# Make a HTTP request
$ssl = $1 eq 'https';
$host = $2; $page = $3; $port = $ssl ? 443 : 80;
if ($host =~ /^(.*):(\d+)$/) { $host = $1; $port = $2; }
&http_download($host, $port, $page, $pfile[0], \$error,
\&progress_callback, $ssl);
}
elsif ($in{'url'} =~ /^ftp:\/\/([^\/]+)(:21)?(\/.*)$/) {
$host = $1; $file = $3;
&ftp_download($host, $file, $pfile[0], \$error,
\&progress_callback);
}
else { &install_error(&text('download_eurl', $in{'url'})); }
&install_error($error) if ($error);
$source = $in{'url'};
$need_unlink = 1;
}
elsif ($in{'source'} == 3) {
# installing from CPAN.. find the module, and then install it
$in{'cpan'} || &error($text{'download_emodname'});
$in{'cpan'} =~ s/^\s+//;
$in{'cpan'} =~ s/\s+$//;
@cpan = split(/\s+|\0/, $in{'cpan'});
# First check if YUM or APT can install this module for us
if ($config{'incyum'} && !$in{'forcecpan'}) {
@yum = &list_packaged_modules();
foreach $c (@cpan) {
($yum) = grep { lc($_->{'mod'}) eq lc($c) } @yum;
push(@cpanyum, $yum) if ($yum);
}
}
if (scalar(@cpan) == scalar(@cpanyum)) {
# Can install from YUM or APT .. do it!
$i = 0;
foreach $yum (@cpanyum) {
print &text('download_yum', "$cpan[$i]",
"$yum->{'package'}"),"
\n";
print "
\n";
# Make sure it is valid
open(PFILE, $packages_file);
read(PFILE, $two, 2);
close(PFILE);
if ($two ne "\037\213") {
&install_error(&text('download_ecpangz',
"$config{'packages'}"));
}
}
# Find each module in the modules list
open(LIST, "gunzip -c $packages_file |");
while( \n";
print &ui_form_start("install.cgi");
print &ui_hidden("source", $in{'source'});
print &ui_hidden("need_unlink", $need_unlink);
foreach $pfile (@pfile) {
print &ui_hidden("pfile", $pfile);
}
foreach $m (@mods) {
print &ui_hidden("mod", $m);
}
foreach $v (@vers) {
print &ui_hidden("ver", $v);
}
foreach $d (@dirs) {
print &ui_hidden("dir", $d);
}
print &ui_hidden("return", $in{'return'});
print &ui_hidden("returndesc", $in{'returndesc'});
print &ui_table_start($text{'download_header'}, undef, 2);
# Modules being installed
for($i=0; $i<@mods; $i++) {
$modmsg .= &html_escape($mods[$i])." ".&html_escape($vers[$i])." \n";
&ui_print_footer($in{'return'},
$in{'returndesc'} || $text{'index_return'});
exit;
}
) {
s/\r|\n//g;
if ($_ eq '') { $found_blank++; }
elsif ($found_blank && /^(\S+)\s+(\S+)\s+(.*)/) {
local $i = &indexof($1, @cpan);
if ($i >= 0 && !$source[$i]) {
$source[$i] = "$config{'cpan'}/$3";
$source[$i] =~ /\/perl-[0-9\.]+\.tar\.gz$/ &&
&install_error(&text('download_eisperl',
"$in{'cpan'}"));
$sourcec++;
}
}
}
close(LIST);
# Fail if any modules are missing from CPAN
for($i=0; $i<@cpan; $i++) {
push(@missing, "$cpan[$i]") if (!$source[$i]);
}
if ($in{'missingok'}) {
# If missing modules are OK, exclude them from the sources list
for($i=0; $i<@cpan; $i++) {
if (!$source[$i]) {
splice(@source, $i, 1);
splice(@cpan, $i, 1);
$i--;
}
}
@cpan || &install_error(&text('download_ecpan',
join(" ", @missing)));
}
elsif (@missing) {
# Fail due to missing modules
&install_error(&text('download_ecpan', join(" ", @missing)));
}
$source = join("
", @source);
# Download the actual modules
foreach $m (@source) {
$m =~ /\/([^\/]+)\/*$/;
$pfile = &tempname("$1");
$progress_callback_url = $m;
if ($m =~ /^http:\/\/([^\/]+)(\/.*)$/) {
# Make a HTTP request
$host = $1; $page = $2; $port = 80;
if ($host =~ /^(.*):(\d+)$/) { $host = $1; $port = $2; }
&http_download($host, $port, $page, $pfile, \$error,
\&progress_callback);
}
elsif ($m =~ /^ftp:\/\/([^\/]+)(:21)?(\/.*)$/) {
$host = $1; $file = $3;
&ftp_download($host, $file, $pfile, \$error,
\&progress_callback);
}
else { &install_error(&text('download_eurl', $m)); }
&install_error($error) if ($error);
push(@pfile, $pfile);
}
$need_unlink = 1;
}
else {
&error("Unknown source mode $in{'source'}");
}
# Check if the file looks like a perl module
foreach $pfile (@pfile) {
open(TAR, "( gunzip -c $pfile | tar tf - ) 2>&1 |");
while($line =
\n";
}
print &ui_table_row(@mods > 1 ? $text{'download_mods'} : $text{'download_mod'},
$modmsg);
# Missing modules
if (@missing) {
print &ui_table_row($text{'download_missingok'},
join(" ", @missing));
}
# Source
print &ui_table_row($text{'download_src'}, $source);
if (@allreqs) {
# Pre-requisited
@needreqs = grep { $needreqs{$_} } @allreqs;
foreach $n (@needreqs) {
print &ui_hidden("needreq", $n);
}
if (@needreqs) {
$nmsg = " (".&text('download_missing', scalar(@needreqs)).")";
}
else {
$nmsg = " ($text{'download_nomissing'})";
}
print &ui_table_row($text{'download_pres'},
join(" ", map { $needreqs{$_} ? "$_" : "$_" }
@allreqs).$nmsg);
}
# Install mode
$in{'mode'} = 3 if ($in{'mode'} eq '');
print &ui_table_row($text{'download_act'},
&ui_select("act", $in{'mode'},
[ [ 0, $text{'download_m'} ],
[ 1, $text{'download_mt'} ],
[ 2, $text{'download_mi'} ],
[ 3, $text{'download_mti'} ] ]));
# Command-line args to Makefile.PL
print &ui_table_row($text{'download_args'},
&ui_textbox("args", $config{'def_args'}, 40));
# Table of environment variables
$etable = &ui_columns_start([ $text{'download_name'},
$text{'download_value'} ]);
for($i=0; $i<4; $i++) {
$etable .= &ui_columns_row([ &ui_textbox("name_$i", undef, 15),
&ui_textbox("value_$i", undef, 30) ]);
}
$etable .= &ui_columns_end();
print &ui_table_row($text{'download_envs'}, $etable);
print &ui_table_end();
print &ui_form_end([ [ undef, $text{'download_cont'} ],
@needreqs && $in{'source'} == 3 ?
( [ "need", $text{'download_need'} ] ) : ( )
]);
&ui_print_footer($in{'return'},
$in{'returndesc'} || $text{'index_return'});
sub install_error
{
print "
$main::whatfailed : $_[0]