cpan/download.cgi

   1 #!/usr/local/bin/perl
   2 # download.cgi
   3 # Get a perl module from somewhere
   4
   5 require './cpan-lib.pl';
   6
   7 if ($ENV{REQUEST_METHOD} eq "POST") { &ReadParseMime(); }
   8 else { &ReadParse(); $no_upload = 1; }
   9 &error_setup($text{'download_err'});
  10
  11 if ($in{'source'} >= 2) {
  12         &ui_print_unbuffered_header(undef, $text{'download_title'}, "");
  13         }
  14 else {
  15         &ui_print_header(undef, $text{'download_title'}, "");
  16         }
  17
  18 &tempname();
  19 if ($in{'source'} == 0) {
  20         # installing from local file (or maybe directory)
  21         if (!$in{'local'})
  22                 { &install_error($text{'download_elocal'}); }
  23         if (!-r $in{'local'})
  24                 { &install_error(&text('download_elocal2', $in{'local'})); }
  25         $source = $in{'local'};
  26         @pfile = ( $in{'local'} );
  27         $need_unlink = 0;
  28         }
  29 elsif ($in{'source'} == 1) {
  30         # installing from upload .. store file in temp location
  31         if ($no_upload) {
  32                 &install_error($text{'download_eupload'});
  33                 }
  34         $in{'upload_filename'} =~ /([^\/\\]+$)/;
  35         @pfile = ( &tempname("$1") );
  36         open(PFILE, ">$pfile[0]");
  37         print PFILE $in{'upload'};
  38         close(PFILE);
  39         $source = $in{'upload_filename'};
  40         $need_unlink = 1;
  41         }
  42 elsif ($in{'source'} == 2) {
  43         # installing from URL.. store downloaded file in temp location
  44         $in{'url'} =~ /\/([^\/]+)\/*$/;
  45         @pfile = ( &tempname("$1") );
  46         $progress_callback_url = $in{'url'};
  47         if ($in{'url'} =~ /^(http|https):\/\/([^\/]+)(\/.*)$/) {
  48                 # Make a HTTP request
  49                 $ssl = $1 eq 'https';
  50                 $host = $2; $page = $3; $port = $ssl ? 443 : 80;
  51                 if ($host =~ /^(.*):(\d+)$/) { $host = $1; $port = $2; }
  52                 &http_download($host, $port, $page, $pfile[0], \$error,
  53                                \&progress_callback, $ssl);
  54                 }
  55         elsif ($in{'url'} =~ /^ftp:\/\/([^\/]+)(:21)?(\/.*)$/) {
  56                 $host = $1; $file = $3;
  57                 &ftp_download($host, $file, $pfile[0], \$error,
  58                               \&progress_callback);
  59                 }
  60         else { &install_error(&text('download_eurl', $in{'url'})); }
  61         &install_error($error) if ($error);
  62         $source = $in{'url'};
  63         $need_unlink = 1;
  64         }
  65 elsif ($in{'source'} == 3) {
  66         # installing from CPAN.. find the module, and then install it
  67         $in{'cpan'} || &error($text{'download_emodname'});
  68         $in{'cpan'} =~ s/^\s+//;
  69         $in{'cpan'} =~ s/\s+$//;
  70         @cpan = split(/\s+|\0/, $in{'cpan'});
  71
  72         # First check if YUM or APT can install this module for us
  73         if ($config{'incyum'} && !$in{'forcecpan'}) {
  74                 @yum = &list_packaged_modules();
  75                 foreach $c (@cpan) {
  76                         ($yum) = grep { lc($_->{'mod'}) eq lc($c) } @yum;
  77                         push(@cpanyum, $yum) if ($yum);
  78                         }
  79                 }
  80         if (scalar(@cpan) == scalar(@cpanyum)) {
  81                 # Can install from YUM or APT .. do it!
  82                 $i = 0;
  83                 foreach $yum (@cpanyum) {
  84                         print &text('download_yum', "<tt>$cpan[$i]</tt>",
  85                                     "<tt>$yum->{'package'}</tt>"),"<br>\n";
  86                         print "<ul>\n";
  87                         &software::update_system_install($yum->{'package'});
  88                         print "</ul>\n";
  89                         $i++;
  90                         }
  91                 &ui_print_footer($in{'return'},
  92                                  $in{'returndesc'} || $text{'index_return'});
  93                 exit;
  94                 }
  95
  96         $progress_callback_url = $config{'packages'};
  97         if (!-r $packages_file || $in{'refresh'}) {
  98                 # Need to download the modules list from CPAN first
  99                 &download_packages_file(\&progress_callback);
 100                 print "<p>\n";
 101
 102                 # Make sure it is valid
 103                 open(PFILE, $packages_file);
 104                 read(PFILE, $two, 2);
 105                 close(PFILE);
 106                 if ($two ne "\037\213") {
 107                         &install_error(&text('download_ecpangz',
 108                                          "<tt>$config{'packages'}</tt>"));
 109                         }
 110                 }
 111
 112         # Find each module in the modules list
 113         open(LIST, "gunzip -c $packages_file |");
 114         while(<LIST>) {
 115                 s/\r|\n//g;
 116                 if ($_ eq '') { $found_blank++; }
 117                 elsif ($found_blank && /^(\S+)\s+(\S+)\s+(.*)/) {
 118                         local $i = &indexof($1, @cpan);
 119                         if ($i >= 0 && !$source[$i]) {
 120                                 $source[$i] = "$config{'cpan'}/$3";
 121                                 $source[$i] =~ /\/perl-[0-9\.]+\.tar\.gz$/ &&
 122                                     &install_error(&text('download_eisperl',
 123                                                 "<tt>$in{'cpan'}</tt>"));
 124                                 $sourcec++;
 125                                 }
 126                         }
 127                 }
 128         close(LIST);
 129
 130         # Fail if any modules are missing from CPAN
 131         for($i=0; $i<@cpan; $i++) {
 132                 push(@missing, "<tt>$cpan[$i]</tt>") if (!$source[$i]);
 133                 }
 134
 135         if ($in{'missingok'}) {
 136                 # If missing modules are OK, exclude them from the sources list
 137                 for($i=0; $i<@cpan; $i++) {
 138                         if (!$source[$i]) {
 139                                 splice(@source, $i, 1);
 140                                 splice(@cpan, $i, 1);
 141                                 $i--;
 142                                 }
 143                         }
 144                 @cpan || &install_error(&text('download_ecpan',
 145                                               join(" ", @missing)));
 146                 }
 147         elsif (@missing) {
 148                 # Fail due to missing modules
 149                 &install_error(&text('download_ecpan', join(" ", @missing)));
 150                 }
 151         $source = join("<br>", @source);
 152
 153         # Download the actual modules
 154         foreach $m (@source) {
 155                 $m =~ /\/([^\/]+)\/*$/;
 156                 $pfile = &tempname("$1");
 157                 $progress_callback_url = $m;
 158                 if ($m =~ /^http:\/\/([^\/]+)(\/.*)$/) {
 159                         # Make a HTTP request
 160                         $host = $1; $page = $2; $port = 80;
 161                         if ($host =~ /^(.*):(\d+)$/) { $host = $1; $port = $2; }
 162                         &http_download($host, $port, $page, $pfile, \$error,
 163                                        \&progress_callback);
 164                         }
 165                 elsif ($m =~ /^ftp:\/\/([^\/]+)(:21)?(\/.*)$/) {
 166                         $host = $1; $file = $3;
 167                         &ftp_download($host, $file, $pfile, \$error,
 168                                       \&progress_callback);
 169                         }
 170                 else { &install_error(&text('download_eurl', $m)); }
 171                 &install_error($error) if ($error);
 172                 push(@pfile, $pfile);
 173                 }
 174         $need_unlink = 1;
 175         }
 176 else {
 177         &error("Unknown source mode $in{'source'}");
 178         }
 179
 180 # Check if the file looks like a perl module
 181 foreach $pfile (@pfile) {
 182         open(TAR, "( gunzip -c $pfile | tar tf - ) 2>&1 |");
 183         while($line = <TAR>) {
 184                 if ($line =~ /^\.\/([^\/]+)\/(.*)$/ ||
 185                     $line =~ /^([^\/]+)\/(.*)$/) {
 186                         if (!$dirs{$1}) {
 187                                 $dirs{$1} = $pfile;
 188                                 push(@dirs, $1);
 189                                 }
 190                         $file{$2}++;
 191                         }
 192                 $tar .= $line;
 193                 }
 194         close(TAR);
 195         if ($?) {
 196                 unlink(@pfile) if ($need_unlink);
 197                 &install_error(&text('download_etar', "<tt>$tar</tt>"));
 198                 }
 199         }
 200 if (@dirs == 0 || $file{'Makefile.PL'}+$file{'Build.PL'} < @dirs) {
 201         # Not all files were Perl modules
 202         unlink(@pfile) if ($need_unlink);
 203         &install_error($text{'download_emod'});
 204         }
 205 if ($file{'Build.PL'} && $file{'Makefile.PL'} < @dirs) {
 206         # Make sure we have Module::Build if using Build.PL
 207         eval "use Module::Build";
 208         if ($@) {
 209                 unlink(@pfile) if ($need_unlink);
 210                 &install_error(&text('download_ebuild',
 211                                      "<tt>Module::Build</tt>"));
 212                 }
 213         }
 214 foreach $d (@dirs) {
 215         if ($d =~ /^(\S+)\-v?([0-9\.ab]+)$/) {
 216                 push(@mods, $1);
 217                 push(@vers, $2);
 218                 }
 219         else {
 220                 push(@mods, $m);
 221                 push(@vers, undef);
 222                 }
 223         $mods[$#mods] =~ s/-/::/g;
 224         }
 225
 226 # Extract all module files to look for depends
 227 $mtemp = &tempname();
 228 mkdir($mtemp, 0755);
 229 foreach $d (@dirs) {
 230         system("cd $mtemp ; gunzip -c $dirs{$d} | tar xf - >/dev/null");
 231         local $testargs;
 232         if ($d =~ /^Net_SSLeay/) {
 233                 $testargs = &has_command("openssl");
 234                 $testargs =~ s/\/bin\/openssl$//;
 235                 }
 236         local $cmd = "cd $mtemp/$d ; $perl_path Makefile.PL $testargs --skip";
 237         if (&foreign_check("proc")) {
 238                 # Run in a PTY, to handle CPAN prompting
 239                 &foreign_require("proc", "proc-lib.pl");
 240                 local ($fh, $fpid) = &proc::pty_process_exec($cmd);
 241                 &sysprint($fh, "no\n");    # For CPAN manual config question
 242                 while(<$fh>) {
 243                         # Wait till it completes
 244                         }
 245                 close($fh);
 246                 }
 247         else {
 248                 system("$cmd >/dev/null 2>&1 </dev/null");
 249                 }
 250         local @prereqs;
 251         open(MAKEFILE, "$mtemp/$d/Makefile");
 252         while(<MAKEFILE>) {
 253                 last if /MakeMaker post_initialize section/;
 254                 if (/^#\s+PREREQ_PM\s+=>\s+(.+)/) {
 255                         local $prereq = $1;
 256                         while($prereq =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g) {
 257                                 push(@prereqs, $1);
 258                                 }
 259                         }
 260                 }
 261         close(MAKEFILE);
 262         push(@allreqs, @prereqs);
 263         }
 264 system("rm -rf $mtemp");
 265
 266 # Work out which pre-requesites are missing
 267 @allreqs = &unique(@allreqs);
 268 %needreqs = map { eval "use $_"; $@ ? ($_, 1) : ($_, 0) } @allreqs;
 269 foreach $m (@mods) {
 270         # Don't need modules in tar files
 271         delete($needreqs{$m});
 272         }
 273 foreach $c (@cpan) {
 274         # Don't need modules we are getting from CPAN
 275         delete($needreqs{$c});
 276         }
 277
 278 # Display install options
 279 print "<p>\n";
 280 print &ui_form_start("install.cgi");
 281 print &ui_hidden("source", $in{'source'});
 282 print &ui_hidden("need_unlink", $need_unlink);
 283 foreach $pfile (@pfile) {
 284         print &ui_hidden("pfile", $pfile);
 285         }
 286 foreach $m (@mods) {
 287         print &ui_hidden("mod", $m);
 288         }
 289 foreach $v (@vers) {
 290         print &ui_hidden("ver", $v);
 291         }
 292 foreach $d (@dirs) {
 293         print &ui_hidden("dir", $d);
 294         }
 295 print &ui_hidden("return", $in{'return'});
 296 print &ui_hidden("returndesc", $in{'returndesc'});
 297 print &ui_table_start($text{'download_header'}, undef, 2);
 298
 299 # Modules being installed
 300 for($i=0; $i<@mods; $i++) {
 301         $modmsg .= &html_escape($mods[$i])." ".&html_escape($vers[$i])."<br>\n";
 302         }
 303 print &ui_table_row(@mods > 1 ? $text{'download_mods'} : $text{'download_mod'},
 304                     $modmsg);
 305
 306 # Missing modules
 307 if (@missing) {
 308         print &ui_table_row($text{'download_missingok'},
 309                             join(" ", @missing));
 310         }
 311
 312 # Source
 313 print &ui_table_row($text{'download_src'}, $source);
 314
 315 if (@allreqs) {
 316         # Pre-requisited
 317         @needreqs = grep { $needreqs{$_} } @allreqs;
 318         foreach $n (@needreqs) {
 319                 print &ui_hidden("needreq", $n);
 320                 }
 321         if (@needreqs) {
 322                 $nmsg = " (".&text('download_missing', scalar(@needreqs)).")";
 323                 }
 324         else {
 325                 $nmsg = " ($text{'download_nomissing'})";
 326                 }
 327         print &ui_table_row($text{'download_pres'},
 328               join(" ", map { $needreqs{$_} ? "<i>$_</i>" : "<tt>$_</tt>" }
 329                             @allreqs).$nmsg);
 330         }
 331
 332 # Install mode
 333 $in{'mode'} = 3 if ($in{'mode'} eq '');
 334 print &ui_table_row($text{'download_act'},
 335         &ui_select("act", $in{'mode'},
 336                    [ [ 0, $text{'download_m'} ],
 337                      [ 1, $text{'download_mt'} ],
 338                      [ 2, $text{'download_mi'} ],
 339                      [ 3, $text{'download_mti'} ] ]));
 340
 341 # Command-line args to Makefile.PL
 342 print &ui_table_row($text{'download_args'},
 343         &ui_textbox("args", $config{'def_args'}, 40));
 344
 345 # Table of environment variables
 346 $etable = &ui_columns_start([ $text{'download_name'},
 347                               $text{'download_value'} ]);
 348 for($i=0; $i<4; $i++) {
 349         $etable .= &ui_columns_row([ &ui_textbox("name_$i", undef, 15),
 350                                      &ui_textbox("value_$i", undef, 30) ]);
 351         }
 352 $etable .= &ui_columns_end();
 353 print &ui_table_row($text{'download_envs'}, $etable);
 354
 355 print &ui_table_end();
 356 print &ui_form_end([ [ undef, $text{'download_cont'} ],
 357                      @needreqs && $in{'source'} == 3 ?
 358                         ( [ "need", $text{'download_need'} ] ) : ( )
 359                    ]);
 360
 361 &ui_print_footer($in{'return'},
 362                  $in{'returndesc'} || $text{'index_return'});
 363
 364 sub install_error
 365 {
 366 print "<br><b>$main::whatfailed : $_[0]</b> <p>\n";
 367 &ui_print_footer($in{'return'},
 368                  $in{'returndesc'} || $text{'index_return'});
 369 exit;
 370 }
 371