cgi-bin/download.pl

   1 #!/usr/bin/perl -T
   2 #
   3 # download.pl -- CGI interface for downloading files on packages.debian.org
   4 #
   5 # Copyright (C) 1998 (?) James Treacy
   6 # Copyright (C) 2001 Josip Rodin
   7 # Copyright (C) 2004 Frank Lichtenheld
   8 #
   9 # Licensed under the GPL or something.
  10
  11 use strict;
  12 use warnings;
  13
  14 use CGI ();
  15 use DB_File;
  16 use Benchmark ':hireswallclock';
  17
  18 use lib "../lib";
  19
  20 use Deb::Versions;
  21 use Packages::HTML ();
  22 use Packages::Search qw( :all );
  23 use Packages::Config qw( $HOME $DBDIR @SUITES @ARCHIVES @SECTIONS @ARCHITECTURES );
  24 use Packages::CGI;
  25 use Packages::DB;
  26
  27 &Packages::CGI::reset;
  28
  29 &Packages::Config::init( '../' );
  30 &Packages::DB::init();
  31
  32 # TODO: find a way to get the U.S. mirror list from a more authoritive
  33 # location automatically. might not be overly smart to automatize it
  34 # completely, since I hand pick sites that are up-to-date, fast, and
  35 # have HTTP on a reasonably short URL
  36 #   -- Joy
  37
  38 # hint:
  39 # grep-dctrl -F Site,Alias -e '(udel|bigfoot|kernel|crosslink|internap|cerias|lcs.mit|progeny)' Mirrors.masterlist | timestamps/archive_mirror_check.py
  40 my @north_american_sites = (
  41         "ftp.us.debian.org/debian",
  42         "http.us.debian.org/debian",
  43         "ftp.debian.org/debian",
  44 #       "ftp.ca.debian.org/debian",
  45         "ftp.egr.msu.edu/debian",
  46         "mirrors.kernel.org/debian",
  47         "archive.progeny.com/debian",
  48         "debian.crosslink.net/debian",
  49         "ftp-mirror.internap.com/pub/debian",
  50         "ftp.cerias.purdue.edu/pub/os/debian",
  51         "ftp.lug.udel.edu/debian",
  52         "debian.lcs.mit.edu/debian",
  53         "debian.teleglobe.net",
  54         "debian.rutgers.edu",
  55         "debian.oregonstate.edu/debian",
  56         );
  57 my @european_sites = (
  58         "ftp.de.debian.org/debian",
  59         "ftp.at.debian.org/debian",
  60         "ftp.bg.debian.org/debian",
  61         "ftp.cz.debian.org/debian",
  62         "ftp.dk.debian.org/debian",
  63         "ftp.ee.debian.org/debian",
  64         "ftp.fi.debian.org/debian",
  65         "ftp.fr.debian.org/debian",
  66         "ftp.hr.debian.org/debian",
  67         "ftp.hu.debian.org/debian",
  68         "ftp.ie.debian.org/debian",
  69         "ftp.is.debian.org/debian",
  70         "ftp.it.debian.org/debian",
  71         "ftp.nl.debian.org/debian",
  72         "ftp.no.debian.org/debian",
  73         "ftp.pl.debian.org/debian",
  74         "ftp.si.debian.org/debian",
  75         "ftp.es.debian.org/debian",
  76         "ftp.se.debian.org/debian",
  77         "ftp.tr.debian.org/debian",
  78         "ftp.uk.debian.org/debian",
  79         );
  80 my @south_american_sites = (
  81         "ftp.br.debian.org/debian",
  82         "ftp.cl.debian.org/debian",
  83         );
  84 my @australian_sites = (
  85         "ftp.au.debian.org/debian",
  86         "ftp.wa.au.debian.org/debian",
  87         "ftp.nz.debian.org/debian",
  88         );
  89 my @asian_sites = (
  90         "ftp.jp.debian.org/debian",
  91 #       "ftp.kr.debian.org/debian",
  92         "linux.csie.nctu.edu.tw/debian",
  93         "debian.linux.org.tw/debian",
  94         "linux.cdpa.nsysu.edu.tw/debian",
  95         );
  96
  97 my @volatile_european_sites = (
  98         "volatile.debian.net/debian-volatile",
  99         "ftp2.de.debian.org/debian-volatile",
 100         "ftp.sk.debian.org/debian-volatile",
 101                                );
 102 my @backports_european_sites = (
 103         "www.backports.org/debian",
 104         "debian.sil.at/backports.org/",
 105         "backports.debian.or.at/backports.org",
 106         "mirror.realroute.net/backports.org",
 107         "backports.cisbg.com",
 108         "backports.linuxdediziert.de/backports.org",
 109         "debian.netcologne.de/debian-backports",
 110         "ftp.de.debian.org/backports.org",
 111         "mirror.buildd.net/backports.org",
 112         "ftp.estpak.ee/backports.org",
 113         "debian.acantho.net/backports.org",
 114         "backports.essentkabel.com/backports.org",
 115         "backports.sipo.nl",
 116         "ftp.tuke.sk",
 117                                );
 118 my @backports_asian_sites = (
 119         "backports.mithril-linux.org",
 120                              );
 121 my @backports_australian_sites = (
 122         "mirror.linux.org.au/backports.org",
 123                                   );
 124 my @amd64_european_sites = (
 125         "amd64.debian.net/debian",
 126         "ftp.de.debian.org/debian-amd64/debian",
 127         "bach.hpc2n.umu.se/debian-amd64/debian",
 128         "bytekeeper.as28747.net/debian-amd64/debian",
 129         "mirror.switch.ch/debian-amd64/debian",
 130         "ftp.nl.debian.org/debian-amd64/debian",
 131                             );
 132 my @amd64_asian_sites = (
 133         "hanzubon.jp/debian-amd64/debian",
 134                          );
 135 my @amd64_north_american_sites = (
 136         "mirror.espri.arizona.edu/debian-amd64/debian",
 137                                   );
 138 my @kfreebsd_north_american_sites = (
 139         "www.gtlib.gatech.edu/pub/gnuab/debian",
 140                                      );
 141 my @kfreebsd_european_sites = (
 142         # master site, aka ftp.gnuab.org
 143         "kfreebsd-gnu.debian.net/debian",
 144         "ftp.easynet.be/ftp/gnuab/debian",
 145         "ftp.de.debian.org/debian-kfreebsd",
 146                                );
 147 my @nonus_north_american_sites = (
 148 #       "ftp.ca.debian.org/debian-non-US",
 149         "debian.yorku.ca/debian/non-US",
 150         "mirror.direct.ca/linux/debian-non-US",
 151         );
 152 my @nonus_european_sites = (
 153         "non-us.debian.org/debian-non-US",
 154         "ftp.de.debian.org/debian-non-US",
 155         "ftp.at.debian.org/debian-non-US",
 156         "ftp.bg.debian.org/debian-non-US",
 157         "ftp.cz.debian.org/debian-non-US",
 158         "ftp.fi.debian.org/debian-non-US",
 159         "ftp.fr.debian.org/debian-non-US",
 160         "ftp.hr.debian.org/debian-non-US",
 161         "ftp.hu.debian.org/debian-non-US",
 162         "ftp.ie.debian.org/debian-non-US",
 163         "ftp.is.debian.org/debian-non-US",
 164         "ftp.it.debian.org/debian-non-US",
 165         "ftp.nl.debian.org/debian-non-US",
 166         "ftp.no.debian.org/debian-non-US",
 167         "ftp.pl.debian.org/debian/non-US",
 168         "ftp.si.debian.org/debian-non-US",
 169         "ftp.es.debian.org/debian-non-US",
 170         "ftp.se.debian.org/debian-non-US",
 171         "ftp.tr.debian.org/debian-non-US",
 172         "ftp.uk.debian.org/debian/non-US",
 173         );
 174 my @nonus_australian_sites = (
 175         "ftp.au.debian.org/debian-non-US",
 176         "ftp.wa.au.debian.org/debian-non-US",
 177         "ftp.nz.debian.org/debian-non-US",
 178         );
 179 my @nonus_asian_sites = (
 180         "ftp.jp.debian.org/debian-non-US",
 181 #       "ftp.kr.debian.org/debian-non-US",
 182         "linux.csie.nctu.edu.tw/debian-non-US",
 183         "debian.linux.org.tw/debian-non-US",
 184         "linux.cdpa.nsysu.edu.tw/debian-non-US",
 185         );
 186 my @nonus_south_american_sites = (
 187         "ftp.br.debian.org/debian-non-US",
 188         "ftp.cl.debian.org/debian-non-US",
 189         );
 190
 191 # list of architectures
 192 my %arches = (
 193         i386    => 'Intel x86',
 194         m68k    => 'Motorola 680x0',
 195         sparc   => 'SPARC',
 196         alpha   => 'Alpha',
 197         powerpc => 'PowerPC',
 198         arm     => 'ARM',
 199         hppa    => 'HP PA-RISC',
 200         ia64    => 'Intel IA-64',
 201         mips    => 'MIPS',
 202         mipsel  => 'MIPS (DEC)',
 203         s390    => 'IBM S/390',
 204         "hurd-i386" => 'Hurd (i386)',
 205         amd64   => 'AMD64',
 206         "kfreebsd-i386" => 'GNU/kFreeBSD (i386)'
 207 );
 208
 209 $ENV{PATH} = "/bin:/usr/bin";
 210 # Read in all the variables set by the form
 211 my $input;
 212 if ($ARGV[0] && ($ARGV[0] eq 'php')) {
 213         $input = new CGI(\*STDIN);
 214 } else {
 215         $input = new CGI;
 216 }
 217
 218 my $pet0 = new Benchmark;
 219 my $tet0 = new Benchmark;
 220 # use this to disable debugging in production mode completly
 221 my $debug_allowed = 1;
 222 my $debug = $debug_allowed && $input->param("debug");
 223 $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
 224 $Packages::CGI::debug = $debug;
 225
 226 if (my $path = $input->param('path')) {
 227     my @components = map { lc $_ } split /\//, $path;
 228
 229     my %SUITES = map { $_ => 1 } @SUITES;
 230     my %ARCHIVES = map { $_ => 1 } @ARCHIVES;
 231     my %ARCHITECTURES = map { $_ => 1 } @ARCHITECTURES;
 232
 233     foreach (@components) {
 234         if ($SUITES{$_}) {
 235             $input->param('suite', $_);
 236         } elsif ($ARCHIVES{$_}) {
 237             $input->param('archive', $_);
 238         } elsif ($ARCHITECTURES{$_}) {
 239             $input->param('arch', $_);
 240         } elsif ($_ eq 'source') {
 241             $input->param('source', 1);
 242         }
 243     }
 244 }
 245
 246 my ( $pkg, $suite, @sections, $arch, @archives, $format );
 247 my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
 248                                 var => \$pkg },
 249                    suite => { default => undef, match => '^(\w+)$',
 250                               var => \$suite },
 251                    archive => { default => 'all', match => '^(\w+)$',
 252                                 array => ', ', var => \@archives,
 253                             replace => { all => [qw(us security non-US)] } },
 254                    arch => { default => undef, match => '^(\w+)$',
 255                              var => \$arch },
 256                    format => { default => 'html', match => '^(\w+)$',
 257                                var => \$format },
 258                    );
 259 my %opts;
 260 my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
 261
 262 #XXX: Don't use alternative output formats yet
 263 $format = 'html';
 264 if ($format eq 'html') {
 265     print $input->header( -charset => 'utf-8' );
 266 }
 267
 268 if ($params{errors}{package}) {
 269     fatal_error( "package not valid or not specified" );
 270     $pkg = '';
 271 }
 272 if ($params{errors}{suite}) {
 273     fatal_error( "suite not valid or not specified" );
 274     $suite = '';
 275 }
 276 if ($params{errors}{arch}) {
 277     fatal_error( "arch not valid or not specified" );
 278     $arch = '';
 279 }
 280
 281 $opts{h_suites} =   { $suite => 1 };
 282 $opts{h_archs} =    { $arch => 1 };
 283 $opts{h_sections} = { map { $_ => 1 } @SECTIONS };
 284 $opts{h_archives} = { map { $_ => 1 } @archives };
 285
 286 our (%packages_all);
 287 my (@results);
 288 my ($final_result, $file, $filen, $md5sum, @file_components, $archive) = ("")x5;
 289
 290 sub gettext { return $_[0]; };
 291
 292 my $st0 = new Benchmark;
 293 unless (@Packages::CGI::fatal_errors) {
 294     tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
 295     O_RDONLY, 0666, $DB_BTREE
 296         or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
 297
 298     read_entry( \%packages, $pkg, \@results, \%opts );
 299
 300     unless (@results) {
 301         fatal_error( "No such package".
 302                      "{insert link to search page with substring search}" );
 303
 304     } else {
 305         my $final_result = shift @results;
 306         foreach (@results) {
 307             if (version_cmp( $_->[7], $final_result->[7] ) > 0) {
 308                 $final_result = $_;
 309             }
 310         }
 311
 312         $archive = $final_result->[1];
 313         my %data = split /\000/, $packages_all{"$pkg $arch $final_result->[7]"};
 314         $file = $data{filename};
 315         @file_components = split('/', $file);
 316         $filen = pop(@file_components);
 317
 318         $md5sum = $data{md5sum};
 319     }
 320 }
 321
 322 my $arch_string = $arch ne 'all' ? "on $arches{$arch} machines" : "";
 323
 324 print Packages::HTML::header( title => "Package Download Selection",
 325                               lang => "en",
 326                               print_title_above => 1 );
 327
 328 print_errors();
 329 print_hints();
 330 print_msgs();
 331 print_debug();
 332 print_notes();
 333
 334 if ($file) {
 335     print "<h2>Download Page for <kbd>$filen</kbd> $arch_string</h2>\n".
 336         "<p>You can download the requested file from the <tt>";
 337     print join( '/', @file_components).'/';
 338     print "</tt> subdirectory at";
 339     print $archive ne 'security' ? " any of these sites:" : ":";
 340     print "</p>\n";
 341
 342     if ($archive eq 'security') {
 343
 344         print <<END;
 345 <ul>
 346     <li><a href="http://security.debian.org/debian-security/$file">security.debian.org/debian-security</a></li>
 347     </ul>
 348
 349     <p>Debian security updates are currently officially distributed only via
 350     security.debian.org.</p>
 351 END
 352 ;
 353     } elsif ($arch eq 'amd64') {
 354
 355         print_links( "North America", $file, @amd64_north_american_sites );
 356         print_links( "Europe", $file, @amd64_european_sites );
 357 #    print_links( "Australia and New Zealand", $file,
 358 #                @nonus_australian_sites );
 359         print_links( "Asia", $file, @amd64_asian_sites );
 360 #    print_links( "South America", $file, @nonus_south_american_sites );
 361
 362         print <<END;
 363 <p>Note that AMD64 is not officialy included in the Debian archive
 364     yet, but the AMD64 porter group keeps their archive in sync with
 365     the official archive as close as possible. See the
 366     <a href="http://www.debian.org/ports/amd64/">AMD64 ports page</a> for
 367     current information.</p>
 368 END
 369 ;
 370     } elsif ($arch eq 'kfreebsd-i386') {
 371
 372         print_links( "North America", $file, @kfreebsd_north_american_sites );
 373         print_links( "Europe", $file, @kfreebsd_european_sites );
 374 #    print_links( "Australia and New Zealand", $file,
 375 #                @nonus_australian_sites );
 376 #    print_links( "Asia", $file, @amd64_asian_sites );
 377 #    print_links( "South America", $file, @nonus_south_american_sites );
 378
 379         print <<END;
 380 <p>Note that GNU/kFreeBSD is not officialy included in the Debian archive
 381     yet, but the GNU/kFreeBSD porter group keeps their archive in sync with
 382     the official archive as close as possible. See the
 383     <a href="http://www.debian.org/ports/kfreebsd-gnu/">GNU/kFreeBSD ports page</a> for
 384     current information.</p>
 385 END
 386 ;
 387     } elsif ($archive eq 'non-US') {
 388
 389         print_links( "North America", $file, @nonus_north_american_sites );
 390         print_links( "Europe", $file, @nonus_european_sites );
 391         print_links( "Australia and New Zealand", $file,
 392                      @nonus_australian_sites );
 393         print_links( "Asia", $file, @nonus_asian_sites );
 394         print_links( "South America", $file, @nonus_south_american_sites );
 395
 396         print <<END;
 397 <p>If none of the above sites are fast enough for you, please see our
 398     <a href="http://www.debian.org/mirror/list-non-US">complete mirror list</a>.</p>
 399 END
 400 ;
 401     } elsif ($archive eq 'backports') {
 402
 403 #    print_links( "North America", $file, @nonus_north_american_sites );
 404         print '<div class="cardleft">';
 405         print_links( "Europe", $file, @backports_european_sites );
 406         print '</div><div class="cardright">';
 407         print_links( "Australia and New Zealand", $file,
 408                      @backports_australian_sites );
 409         print_links( "Asia", $file, @backports_asian_sites );
 410 #    print_links( "South America", $file, @nonus_south_american_sites );
 411         print '</div>';
 412
 413         print <<END;
 414 <p style="clear:both">If none of the above sites are fast enough for you, please see our
 415     <a href="http://www.backports.org/debian/README.mirrors.html">complete mirror list</a>.</p>
 416 END
 417 ;
 418         } elsif ($archive eq 'volatile') {
 419
 420 #    print_links( "North America", $file, @nonus_north_american_sites );
 421             print_links( "Europe", $file, @volatile_european_sites );
 422 #    print_links( "Australia and New Zealand", $file,
 423 #                @nonus_australian_sites );
 424 #    print_links( "Asia", $file, @nonus_asian_sites );
 425 #    print_links( "South America", $file, @nonus_south_american_sites );
 426
 427             print <<END;
 428 <p>If none of the above sites are fast enough for you, please see our
 429     <a href="http://volatile.debian.net/mirrors.html">complete mirror list</a>.</p>
 430 END
 431 ;
 432         } elsif ($archive eq 'us') {
 433
 434             print '<div class="cardleft">';
 435             print_links( "North America", $file, @north_american_sites );
 436             print '</div><div class="cardright">';
 437             print_links( "Europe", $file, @european_sites );
 438             print '</div><div class="cardleft">';
 439             print_links( "Australia and New Zealand", $file, @australian_sites );
 440             print '</div><div class="cardright">';
 441             print_links( "Asia", $file, @asian_sites );
 442             print '</div><div class="cardleft">';
 443             print_links( "South America", $file, @south_american_sites );
 444             print '</div>';
 445
 446             print <<END;
 447 <p style="clear:both">If none of the above sites are fast enough for you, please see our
 448     <a href="http://www.debian.org/mirror/list">complete mirror list</a>.</p>
 449 END
 450 ;
 451         }
 452
 453     print <<END;
 454 <p>Note that in some browsers you will need to tell your browser you want
 455     the file saved to a file. For example, in Netscape or Mozilla, you should
 456     hold the Shift key when you click on the URL.</p>
 457 END
 458 ;
 459     print "<p>The MD5sum for <tt>$filen</tt> is <strong>$md5sum</strong></p>\n"
 460         if $md5sum;
 461 }
 462
 463 my $trailer = Packages::HTML::trailer( ".." );
 464 $trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e;
 465 print $trailer;
 466
 467 exit;
 468
 469 sub print_links {
 470     my ( $title, $file, @servers ) = @_;
 471
 472     print "<p><em>$title</em></p>";
 473     print "<ul>";
 474     foreach (@servers) {
 475         print "<li><a href=\"http://$_/$file\">$_</a></li>\n";
 476         # print "<li><a href=\"ftp://$_/$file\">$_</a></li>\n";
 477     }
 478     print "</ul>";
 479
 480 }