+++ /dev/null
-#!/usr/bin/perl -T
-#
-# download.pl -- CGI interface for downloading files on packages.debian.org
-#
-# Copyright (C) 1998 (?) James Treacy
-# Copyright (C) 2001 Josip Rodin
-# Copyright (C) 2004 Frank Lichtenheld
-#
-# Licensed under the GPL or something.
-
-use strict;
-use warnings;
-
-use CGI ();
-use DB_File;
-use Benchmark ':hireswallclock';
-
-use lib "../lib";
-
-use Deb::Versions;
-use Packages::HTML ();
-use Packages::Search qw( :all );
-use Packages::Config qw( $HOME $DBDIR @SUITES @ARCHIVES @SECTIONS @ARCHITECTURES );
-use Packages::CGI;
-use Packages::DB;
-
-&Packages::CGI::reset;
-
-&Packages::Config::init( '../' );
-&Packages::DB::init();
-
-# TODO: find a way to get the U.S. mirror list from a more authoritive
-# location automatically. might not be overly smart to automatize it
-# completely, since I hand pick sites that are up-to-date, fast, and
-# have HTTP on a reasonably short URL
-# -- Joy
-
-# hint:
-# grep-dctrl -F Site,Alias -e '(udel|bigfoot|kernel|crosslink|internap|cerias|lcs.mit|progeny)' Mirrors.masterlist | timestamps/archive_mirror_check.py
-my @north_american_sites = (
- "ftp.us.debian.org/debian",
- "http.us.debian.org/debian",
- "ftp.debian.org/debian",
-# "ftp.ca.debian.org/debian",
- "ftp.egr.msu.edu/debian",
- "mirrors.kernel.org/debian",
- "archive.progeny.com/debian",
- "debian.crosslink.net/debian",
- "ftp-mirror.internap.com/pub/debian",
- "ftp.cerias.purdue.edu/pub/os/debian",
- "ftp.lug.udel.edu/debian",
- "debian.lcs.mit.edu/debian",
- "debian.teleglobe.net",
- "debian.rutgers.edu",
- "debian.oregonstate.edu/debian",
- );
-my @european_sites = (
- "ftp.de.debian.org/debian",
- "ftp.at.debian.org/debian",
- "ftp.bg.debian.org/debian",
- "ftp.cz.debian.org/debian",
- "ftp.dk.debian.org/debian",
- "ftp.ee.debian.org/debian",
- "ftp.fi.debian.org/debian",
- "ftp.fr.debian.org/debian",
- "ftp.hr.debian.org/debian",
- "ftp.hu.debian.org/debian",
- "ftp.ie.debian.org/debian",
- "ftp.is.debian.org/debian",
- "ftp.it.debian.org/debian",
- "ftp.nl.debian.org/debian",
- "ftp.no.debian.org/debian",
- "ftp.pl.debian.org/debian",
- "ftp.si.debian.org/debian",
- "ftp.es.debian.org/debian",
- "ftp.se.debian.org/debian",
- "ftp.tr.debian.org/debian",
- "ftp.uk.debian.org/debian",
- );
-my @south_american_sites = (
- "ftp.br.debian.org/debian",
- "ftp.cl.debian.org/debian",
- );
-my @australian_sites = (
- "ftp.au.debian.org/debian",
- "ftp.wa.au.debian.org/debian",
- "ftp.nz.debian.org/debian",
- );
-my @asian_sites = (
- "ftp.jp.debian.org/debian",
-# "ftp.kr.debian.org/debian",
- "linux.csie.nctu.edu.tw/debian",
- "debian.linux.org.tw/debian",
- "linux.cdpa.nsysu.edu.tw/debian",
- );
-
-my @volatile_european_sites = (
- "volatile.debian.net/debian-volatile",
- "ftp2.de.debian.org/debian-volatile",
- "ftp.sk.debian.org/debian-volatile",
- );
-my @backports_european_sites = (
- "www.backports.org/debian",
- "debian.sil.at/backports.org/",
- "backports.debian.or.at/backports.org",
- "mirror.realroute.net/backports.org",
- "backports.cisbg.com",
- "backports.linuxdediziert.de/backports.org",
- "debian.netcologne.de/debian-backports",
- "ftp.de.debian.org/backports.org",
- "mirror.buildd.net/backports.org",
- "ftp.estpak.ee/backports.org",
- "debian.acantho.net/backports.org",
- "backports.essentkabel.com/backports.org",
- "backports.sipo.nl",
- "ftp.tuke.sk",
- );
-my @backports_asian_sites = (
- "backports.mithril-linux.org",
- );
-my @backports_australian_sites = (
- "mirror.linux.org.au/backports.org",
- );
-my @amd64_european_sites = (
- "amd64.debian.net/debian",
- "ftp.de.debian.org/debian-amd64/debian",
- "bach.hpc2n.umu.se/debian-amd64/debian",
- "bytekeeper.as28747.net/debian-amd64/debian",
- "mirror.switch.ch/debian-amd64/debian",
- "ftp.nl.debian.org/debian-amd64/debian",
- );
-my @amd64_asian_sites = (
- "hanzubon.jp/debian-amd64/debian",
- );
-my @amd64_north_american_sites = (
- "mirror.espri.arizona.edu/debian-amd64/debian",
- );
-my @kfreebsd_north_american_sites = (
- "www.gtlib.gatech.edu/pub/gnuab/debian",
- );
-my @kfreebsd_european_sites = (
- # master site, aka ftp.gnuab.org
- "kfreebsd-gnu.debian.net/debian",
- "ftp.easynet.be/ftp/gnuab/debian",
- "ftp.de.debian.org/debian-kfreebsd",
- );
-my @nonus_north_american_sites = (
-# "ftp.ca.debian.org/debian-non-US",
- "debian.yorku.ca/debian/non-US",
- "mirror.direct.ca/linux/debian-non-US",
- );
-my @nonus_european_sites = (
- "non-us.debian.org/debian-non-US",
- "ftp.de.debian.org/debian-non-US",
- "ftp.at.debian.org/debian-non-US",
- "ftp.bg.debian.org/debian-non-US",
- "ftp.cz.debian.org/debian-non-US",
- "ftp.fi.debian.org/debian-non-US",
- "ftp.fr.debian.org/debian-non-US",
- "ftp.hr.debian.org/debian-non-US",
- "ftp.hu.debian.org/debian-non-US",
- "ftp.ie.debian.org/debian-non-US",
- "ftp.is.debian.org/debian-non-US",
- "ftp.it.debian.org/debian-non-US",
- "ftp.nl.debian.org/debian-non-US",
- "ftp.no.debian.org/debian-non-US",
- "ftp.pl.debian.org/debian/non-US",
- "ftp.si.debian.org/debian-non-US",
- "ftp.es.debian.org/debian-non-US",
- "ftp.se.debian.org/debian-non-US",
- "ftp.tr.debian.org/debian-non-US",
- "ftp.uk.debian.org/debian/non-US",
- );
-my @nonus_australian_sites = (
- "ftp.au.debian.org/debian-non-US",
- "ftp.wa.au.debian.org/debian-non-US",
- "ftp.nz.debian.org/debian-non-US",
- );
-my @nonus_asian_sites = (
- "ftp.jp.debian.org/debian-non-US",
-# "ftp.kr.debian.org/debian-non-US",
- "linux.csie.nctu.edu.tw/debian-non-US",
- "debian.linux.org.tw/debian-non-US",
- "linux.cdpa.nsysu.edu.tw/debian-non-US",
- );
-my @nonus_south_american_sites = (
- "ftp.br.debian.org/debian-non-US",
- "ftp.cl.debian.org/debian-non-US",
- );
-
-# list of architectures
-my %arches = (
- i386 => 'Intel x86',
- m68k => 'Motorola 680x0',
- sparc => 'SPARC',
- alpha => 'Alpha',
- powerpc => 'PowerPC',
- arm => 'ARM',
- hppa => 'HP PA-RISC',
- ia64 => 'Intel IA-64',
- mips => 'MIPS',
- mipsel => 'MIPS (DEC)',
- s390 => 'IBM S/390',
- "hurd-i386" => 'Hurd (i386)',
- amd64 => 'AMD64',
- "kfreebsd-i386" => 'GNU/kFreeBSD (i386)'
-);
-
-$ENV{PATH} = "/bin:/usr/bin";
-# Read in all the variables set by the form
-my $input;
-if ($ARGV[0] && ($ARGV[0] eq 'php')) {
- $input = new CGI(\*STDIN);
-} else {
- $input = new CGI;
-}
-
-my $pet0 = new Benchmark;
-my $tet0 = new Benchmark;
-# use this to disable debugging in production mode completly
-my $debug_allowed = 1;
-my $debug = $debug_allowed && $input->param("debug");
-$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
-$Packages::CGI::debug = $debug;
-
-if (my $path = $input->param('path')) {
- my @components = map { lc $_ } split /\//, $path;
-
- my %SUITES = map { $_ => 1 } @SUITES;
- my %ARCHIVES = map { $_ => 1 } @ARCHIVES;
- my %ARCHITECTURES = map { $_ => 1 } @ARCHITECTURES;
-
- foreach (@components) {
- if ($SUITES{$_}) {
- $input->param('suite', $_);
- } elsif ($ARCHIVES{$_}) {
- $input->param('archive', $_);
- } elsif ($ARCHITECTURES{$_}) {
- $input->param('arch', $_);
- } elsif ($_ eq 'source') {
- $input->param('source', 1);
- }
- }
-}
-
-my ( $pkg, $suite, @sections, $arch, @archives, $format );
-my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
- var => \$pkg },
- suite => { default => undef, match => '^(\w+)$',
- var => \$suite },
- archive => { default => 'all', match => '^(\w+)$',
- array => ', ', var => \@archives,
- replace => { all => [qw(us security non-US)] } },
- arch => { default => undef, match => '^(\w+)$',
- var => \$arch },
- format => { default => 'html', match => '^(\w+)$',
- var => \$format },
- );
-my %opts;
-my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
-
-#XXX: Don't use alternative output formats yet
-$format = 'html';
-if ($format eq 'html') {
- print $input->header( -charset => 'utf-8' );
-}
-
-if ($params{errors}{package}) {
- fatal_error( "package not valid or not specified" );
- $pkg = '';
-}
-if ($params{errors}{suite}) {
- fatal_error( "suite not valid or not specified" );
- $suite = '';
-}
-if ($params{errors}{arch}) {
- fatal_error( "arch not valid or not specified" );
- $arch = '';
-}
-
-$opts{h_suites} = { $suite => 1 };
-$opts{h_archs} = { $arch => 1 };
-$opts{h_sections} = { map { $_ => 1 } @SECTIONS };
-$opts{h_archives} = { map { $_ => 1 } @archives };
-
-our (%packages_all);
-my (@results);
-my ($final_result, $file, $filen, $md5sum, @file_components, $archive) = ("")x5;
-
-sub gettext { return $_[0]; };
-
-my $st0 = new Benchmark;
-unless (@Packages::CGI::fatal_errors) {
- tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
- O_RDONLY, 0666, $DB_BTREE
- or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
-
- read_entry( \%packages, $pkg, \@results, \%opts );
-
- unless (@results) {
- fatal_error( "No such package".
- "{insert link to search page with substring search}" );
-
- } else {
- my $final_result = shift @results;
- foreach (@results) {
- if (version_cmp( $_->[7], $final_result->[7] ) > 0) {
- $final_result = $_;
- }
- }
-
- $archive = $final_result->[1];
- my %data = split /\000/, $packages_all{"$pkg $arch $final_result->[7]"};
- $file = $data{filename};
- @file_components = split('/', $file);
- $filen = pop(@file_components);
-
- $md5sum = $data{md5sum};
- }
-}
-
-my $arch_string = $arch ne 'all' ? "on $arches{$arch} machines" : "";
-
-print Packages::HTML::header( title => "Package Download Selection",
- lang => "en",
- print_title_above => 1 );
-
-print_errors();
-print_hints();
-print_msgs();
-print_debug();
-print_notes();
-
-if ($file) {
- print "<h2>Download Page for <kbd>$filen</kbd> $arch_string</h2>\n".
- "<p>You can download the requested file from the <tt>";
- print join( '/', @file_components).'/';
- print "</tt> subdirectory at";
- print $archive ne 'security' ? " any of these sites:" : ":";
- print "</p>\n";
-
- if ($archive eq 'security') {
-
- print <<END;
-<ul>
- <li><a href="http://security.debian.org/debian-security/$file">security.debian.org/debian-security</a></li>
- </ul>
-
- <p>Debian security updates are currently officially distributed only via
- security.debian.org.</p>
-END
-;
- } elsif ($arch eq 'amd64') {
-
- print_links( "North America", $file, @amd64_north_american_sites );
- print_links( "Europe", $file, @amd64_european_sites );
-# print_links( "Australia and New Zealand", $file,
-# @nonus_australian_sites );
- print_links( "Asia", $file, @amd64_asian_sites );
-# print_links( "South America", $file, @nonus_south_american_sites );
-
- print <<END;
-<p>Note that AMD64 is not officialy included in the Debian archive
- yet, but the AMD64 porter group keeps their archive in sync with
- the official archive as close as possible. See the
- <a href="http://www.debian.org/ports/amd64/">AMD64 ports page</a> for
- current information.</p>
-END
-;
- } elsif ($arch eq 'kfreebsd-i386') {
-
- print_links( "North America", $file, @kfreebsd_north_american_sites );
- print_links( "Europe", $file, @kfreebsd_european_sites );
-# print_links( "Australia and New Zealand", $file,
-# @nonus_australian_sites );
-# print_links( "Asia", $file, @amd64_asian_sites );
-# print_links( "South America", $file, @nonus_south_american_sites );
-
- print <<END;
-<p>Note that GNU/kFreeBSD is not officialy included in the Debian archive
- yet, but the GNU/kFreeBSD porter group keeps their archive in sync with
- the official archive as close as possible. See the
- <a href="http://www.debian.org/ports/kfreebsd-gnu/">GNU/kFreeBSD ports page</a> for
- current information.</p>
-END
-;
- } elsif ($archive eq 'non-US') {
-
- print_links( "North America", $file, @nonus_north_american_sites );
- print_links( "Europe", $file, @nonus_european_sites );
- print_links( "Australia and New Zealand", $file,
- @nonus_australian_sites );
- print_links( "Asia", $file, @nonus_asian_sites );
- print_links( "South America", $file, @nonus_south_american_sites );
-
- print <<END;
-<p>If none of the above sites are fast enough for you, please see our
- <a href="http://www.debian.org/mirror/list-non-US">complete mirror list</a>.</p>
-END
-;
- } elsif ($archive eq 'backports') {
-
-# print_links( "North America", $file, @nonus_north_american_sites );
- print '<div class="cardleft">';
- print_links( "Europe", $file, @backports_european_sites );
- print '</div><div class="cardright">';
- print_links( "Australia and New Zealand", $file,
- @backports_australian_sites );
- print_links( "Asia", $file, @backports_asian_sites );
-# print_links( "South America", $file, @nonus_south_american_sites );
- print '</div>';
-
- print <<END;
-<p style="clear:both">If none of the above sites are fast enough for you, please see our
- <a href="http://www.backports.org/debian/README.mirrors.html">complete mirror list</a>.</p>
-END
-;
- } elsif ($archive eq 'volatile') {
-
-# print_links( "North America", $file, @nonus_north_american_sites );
- print_links( "Europe", $file, @volatile_european_sites );
-# print_links( "Australia and New Zealand", $file,
-# @nonus_australian_sites );
-# print_links( "Asia", $file, @nonus_asian_sites );
-# print_links( "South America", $file, @nonus_south_american_sites );
-
- print <<END;
-<p>If none of the above sites are fast enough for you, please see our
- <a href="http://volatile.debian.net/mirrors.html">complete mirror list</a>.</p>
-END
-;
- } elsif ($archive eq 'us') {
-
- print '<div class="cardleft">';
- print_links( "North America", $file, @north_american_sites );
- print '</div><div class="cardright">';
- print_links( "Europe", $file, @european_sites );
- print '</div><div class="cardleft">';
- print_links( "Australia and New Zealand", $file, @australian_sites );
- print '</div><div class="cardright">';
- print_links( "Asia", $file, @asian_sites );
- print '</div><div class="cardleft">';
- print_links( "South America", $file, @south_american_sites );
- print '</div>';
-
- print <<END;
-<p style="clear:both">If none of the above sites are fast enough for you, please see our
- <a href="http://www.debian.org/mirror/list">complete mirror list</a>.</p>
-END
-;
- }
-
- print <<END;
-<p>Note that in some browsers you will need to tell your browser you want
- the file saved to a file. For example, in Netscape or Mozilla, you should
- hold the Shift key when you click on the URL.</p>
-END
-;
- print "<p>The MD5sum for <tt>$filen</tt> is <strong>$md5sum</strong></p>\n"
- if $md5sum;
-}
-
-my $trailer = Packages::HTML::trailer( ".." );
-$trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e;
-print $trailer;
-
-exit;
-
-sub print_links {
- my ( $title, $file, @servers ) = @_;
-
- print "<p><em>$title</em></p>";
- print "<ul>";
- foreach (@servers) {
- print "<li><a href=\"http://$_/$file\">$_</a></li>\n";
- # print "<li><a href=\"ftp://$_/$file\">$_</a></li>\n";
- }
- print "</ul>";
-
-}
+++ /dev/null
-#!/usr/bin/perl -wT
-# $Id$
-# search_packages.pl -- CGI interface to the Packages files on packages.debian.org
-#
-# Copyright (C) 1998 James Treacy
-# Copyright (C) 2000, 2001 Josip Rodin
-# Copyright (C) 2001 Adam Heath
-# Copyright (C) 2004 Martin Schulze
-# Copyright (C) 2004-2006 Frank Lichtenheld
-#
-# use is allowed under the terms of the GNU Public License (GPL)
-# see http://www.fsf.org/copyleft/gpl.html for a copy of the license
-
-use strict;
-use lib '../lib';
-use CGI qw( -oldstyle_urls );
-use CGI::Carp qw( fatalsToBrowser );
-use POSIX;
-use URI::Escape;
-use HTML::Entities;
-use DB_File;
-use Benchmark ':hireswallclock';
-
-use Deb::Versions;
-use Packages::Config qw( $DBDIR $ROOT $SEARCH_CGI $SEARCH_PAGE
- @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES );
-use Packages::CGI;
-use Packages::DB;
-use Packages::Search qw( :all );
-use Packages::HTML ();
-
-&Packages::CGI::reset;
-
-$ENV{PATH} = "/bin:/usr/bin";
-
-# Read in all the variables set by the form
-my $input;
-if ($ARGV[0] && ($ARGV[0] eq 'php')) {
- $input = new CGI(\*STDIN);
-} else {
- $input = new CGI;
-}
-
-my $pet0 = new Benchmark;
-my $tet0 = new Benchmark;
-# use this to disable debugging in production mode completly
-my $debug_allowed = 1;
-my $debug = $debug_allowed && $input->param("debug");
-$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
-$Packages::CGI::debug = $debug;
-
-&Packages::Config::init( '../' );
-&Packages::DB::init();
-
-if (my $path = $input->param('path')) {
- my @components = map { lc $_ } split /\//, $path;
-
- my %SUITES = map { $_ => 1 } @SUITES;
- my %SECTIONS = map { $_ => 1 } @SECTIONS;
- my %ARCHIVES = map { $_ => 1 } @ARCHIVES;
- my %ARCHITECTURES = map { $_ => 1 } @ARCHITECTURES;
-
- foreach (@components) {
- if ($SUITES{$_}) {
- $input->param('suite', $_);
- } elsif ($SECTIONS{$_}) {
- $input->param('section', $_);
- } elsif ($ARCHIVES{$_}) {
- $input->param('archive', $_);
- } elsif ($ARCHITECTURES{$_}) {
- $input->param('arch', $_);
- } elsif ($_ eq 'source') {
- $input->param('searchon','sourcenames');
- }
- }
-}
-
-my ( $format, $keyword, $case, $subword, $exact, $searchon,
- @suites, @sections, @archives, @archs );
-
-my %params_def = ( keywords => { default => undef,
- match => '^\s*([-+\@\w\/.:]+)\s*$',
- var => \$keyword },
- suite => { default => 'stable', match => '^([\w-]+)$',
- alias => 'version', array => ',',
- var => \@suites,
- replace => { all => \@SUITES } },
- archive => { default => 'all', match => '^([\w-]+)$',
- array => ',', var => \@archives,
- replace => { all => \@ARCHIVES } },
- case => { default => 'insensitive', match => '^(\w+)$',
- var => \$case },
- official => { default => 0, match => '^(\w+)$' },
- subword => { default => 0, match => '^(\w+)$',
- var => \$subword },
- exact => { default => undef, match => '^(\w+)$',
- var => \$exact },
- searchon => { default => 'all', match => '^(\w+)$',
- var => \$searchon },
- section => { default => 'all', match => '^([\w-]+)$',
- alias => 'release', array => ',',
- var => \@sections,
- replace => { all => \@SECTIONS } },
- arch => { default => 'any', match => '^(\w+)$',
- array => ',', var => \@archs, replace =>
- { any => \@ARCHITECTURES } },
- format => { default => 'html', match => '^(\w+)$',
- var => \$format },
- );
-my %opts;
-my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
-
-#XXX: Don't use alternative output formats yet
-$format = 'html';
-if ($format eq 'html') {
- print $input->header( -charset => 'utf-8' );
-}
-
-if ($params{errors}{keywords}) {
- fatal_error( "keyword not valid or missing" );
-} elsif (length($keyword) < 2) {
- fatal_error( "keyword too short (keywords need to have at least two characters)" );
-}
-
-my $case_bool = ( $case !~ /insensitive/ );
-$exact = !$subword unless defined $exact;
-$opts{h_suites} = { map { $_ => 1 } @suites };
-$opts{h_sections} = { map { $_ => 1 } @sections };
-$opts{h_archives} = { map { $_ => 1 } @archives };
-$opts{h_archs} = { map { $_ => 1 } @archs };
-
-# for URL construction
-my $suites_param = join ',', @{$params{values}{suite}{no_replace}};
-my $sections_param = join ',', @{$params{values}{section}{no_replace}};
-my $archs_param = join ',', @{$params{values}{arch}{no_replace}};
-
-# for output
-my $keyword_enc = encode_entities $keyword || '';
-my $searchon_enc = encode_entities $searchon;
-my $suites_enc = encode_entities join ', ', @{$params{values}{suite}{no_replace}};
-my $sections_enc = encode_entities join ', ', @{$params{values}{section}{no_replace}};
-my $archs_enc = encode_entities join ', ', @{$params{values}{arch}{no_replace}};
-my $pet1 = new Benchmark;
-my $petd = timediff($pet1, $pet0);
-debug( "Parameter evaluation took ".timestr($petd) );
-
-my $st0 = new Benchmark;
-my @results;
-
-unless (@Packages::CGI::fatal_errors) {
-
- if ($searchon eq 'names') {
- push @results, @{ do_names_search( $keyword, \%packages,
- $p_obj,
- \&read_entry, \%opts ) };
- } elsif ($searchon eq 'sourcenames') {
- push @results, @{ do_names_search( $keyword, \%sources,
- $sp_obj,
- \&read_src_entry, \%opts ) };
- } elsif ($searchon eq 'contents') {
- require "./search_contents.pl";
- &contents($input);
- } else {
- push @results, @{ do_names_search( $keyword, \%packages,
- $p_obj,
- \&read_entry, \%opts ) };
- push @results, @{ do_fulltext_search( $keyword, "$DBDIR/descriptions.txt",
- \%did2pkg,
- \%packages,
- \&read_entry, \%opts ) };
- }
-}
-
-my $st1 = new Benchmark;
-my $std = timediff($st1, $st0);
-debug( "Search took ".timestr($std) );
-
-if ($format eq 'html') {
- my $suite_wording = $suites_enc eq "all" ? "all suites"
- : "suite(s) <em>$suites_enc</em>";
- my $section_wording = $sections_enc eq 'all' ? "all sections"
- : "section(s) <em>$sections_enc</em>";
- my $arch_wording = $archs_enc eq 'any' ? "all architectures"
- : "architecture(s) <em>$archs_enc</em>";
- if (($searchon eq "names") || ($searchon eq 'sourcenames')) {
- my $source_wording = ( $searchon eq 'sourcenames' ) ? "source " : "";
- my $exact_wording = $exact ? "named" : "that names contain";
- msg( "You have searched for ${source_wording}packages $exact_wording <em>$keyword_enc</em> in $suite_wording, $section_wording, and $arch_wording." );
- } else {
- my $exact_wording = $exact ? "" : " (including subword matching)";
- msg( "You have searched for <em>$keyword_enc</em> in packages names and descriptions in $suite_wording, $section_wording, and $arch_wording$exact_wording." );
- }
-}
-
-if ($Packages::Search::too_many_hits) {
- error( "Your search was too wide so we will only display exact matches. At least <em>$Packages::Search::too_many_hits</em> results have been omitted and will not be displayed. Please consider using a longer keyword or more keywords." );
-}
-
-if (!@Packages::CGI::fatal_errors && !@results) {
- if ($format eq 'html') {
- my $keyword_esc = uri_escape( $keyword );
- my $printed = 0;
- if (($searchon eq "names") || ($searchon eq 'sourcenames')) {
- if (($suites_enc eq 'all')
- && ($archs_enc eq 'any')
- && ($sections_enc eq 'all')) {
- error( "Can't find that package." );
- } else {
- error( "Can't find that package, at least not in that suite ".
- ( ( $searchon eq 'sourcenames' ) ? "" : " and on that architecture" ) )
- }
-
- if ($exact) {
- $printed++;
- hint( "You have searched only for exact matches of the package name. You can try to search for <a href=\"$SEARCH_CGI?exact=0&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">package names that contain your search string</a>." );
- }
- } else {
- if (($suites_enc eq 'all')
- && ($archs_enc eq 'any')
- && ($sections_enc eq 'all')) {
- error( "Can't find that string." );
- } else {
- error( "Can't find that string, at least not in that suite ($suites_enc, section $sections_enc) and on that architecture ($archs_enc)." );
- }
-
- unless ($subword) {
- $printed++;
- hint( "You have searched only for words exactly matching your keywords. You can try to search <a href=\"$SEARCH_CGI?subword=1&searchon=$searchon&suite=$suites_param&case=$case&section=$sections_param&keywords=$keyword_esc&arch=$archs_param\">allowing subword matching</a>." );
- }
- }
- hint( ( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$SEARCH_PAGE#search_packages\">Packages search page</a>." );
-
- }
-}
-
-print Packages::HTML::header( title => 'Package Search Results' ,
- lang => 'en',
- title_tag => 'Debian Package Search Results',
- print_title_above => 1,
- print_search_field => 'packages',
- search_field_values => {
- keywords => $keyword_enc,
- searchon => $searchon,
- arch => $archs_enc,
- suite => $suites_enc,
- section => $sections_enc,
- subword => $subword,
- exact => $exact,
- case => $case,
- debug => $debug,
- },
- );
-print_msgs();
-print_errors();
-print_hints();
-print_debug();
-if (@results) {
- my (%pkgs, %subsect, %sect, %archives, %desc, %binaries, %provided_by);
-
- unless ($opts{searchon} eq 'sourcenames') {
- foreach (@results) {
- my ($pkg_t, $archive, $suite, $arch, $section, $subsection,
- $priority, $version, $desc) = @$_;
-
- my ($pkg) = $pkg_t =~ m/^(.+)/; # untaint
- if ($arch ne 'virtual') {
- my $real_archive;
- if ($archive =~ /^(security|non-US)$/) {
- $real_archive = $archive;
- $archive = 'us';
- }
-
- $pkgs{$pkg}{$suite}{$archive}{$version}{$arch} = 1;
- $subsect{$pkg}{$suite}{$archive}{$version} = $subsection;
- $sect{$pkg}{$suite}{$archive}{$version} = $section
- unless $section eq 'main';
- $archives{$pkg}{$suite}{$archive}{$version} = $real_archive
- if $real_archive;
-
- $desc{$pkg}{$suite}{$archive}{$version} = $desc;
- } else {
- $provided_by{$pkg}{$suite}{$archive} = [ split /\s+/, $desc ];
- }
- }
-
-my @pkgs = sort(keys %pkgs, keys %provided_by);
- if ($opts{format} eq 'html') {
- #my ($start, $end) = multipageheader( $input, scalar @pkgs, \%opts );
- print "<p>Found <em>".(scalar @pkgs)."</em> matching packages,";
- #my $count = 0;
-
- foreach my $pkg (@pkgs) {
- #$count++;
- #next if $count < $start or $count > $end;
- printf "<h3>Package %s</h3>\n", $pkg;
- print "<ul>\n";
- foreach my $suite (@SUITES) {
- foreach my $archive (@ARCHIVES) {
- next if $archive eq 'security';
- next if $archive eq 'non-US';
- my $path = $suite.(($archive ne 'us')?"/$archive":'');
- if (exists $pkgs{$pkg}{$suite}{$archive}) {
- my %archs_printed;
- my @versions = version_sort keys %{$pkgs{$pkg}{$suite}{$archive}};
- my $origin_str = "";
- if ($sect{$pkg}{$suite}{$archive}{$versions[0]}) {
- $origin_str .= " [<span style=\"color:red\">$sect{$pkg}{$suite}{$archive}{$versions[0]}</span>]";
- }
- printf "<li><a href=\"$ROOT/%s/%s\">%s</a> (%s): %s %s\n",
- $path, $pkg, $path, $subsect{$pkg}{$suite}{$archive}{$versions[0]},
- $desc{$pkg}{$suite}{$archive}{$versions[0]}, $origin_str;
-
- foreach my $v (@versions) {
- my $archive_str = "";
- if ($archives{$pkg}{$suite}{$archive}{$v}) {
- $archive_str .= " [<span style=\"color:red\">$archives{$pkg}{$suite}{$archive}{$v}</span>]";
- }
-
- my @archs_to_print = grep { !$archs_printed{$_} } sort keys %{$pkgs{$pkg}{$suite}{$archive}{$v}};
- printf "<br>%s$archive_str: %s\n",
- $v, join (" ", @archs_to_print )
- if @archs_to_print;
- $archs_printed{$_}++ foreach @archs_to_print;
- }
- if (my $provided_by = $provided_by{$pkg}{$suite}{$archive}) {
- print '<br>also provided by: ',
- join( ', ', map { "<a href=\"$ROOT/$path/$_\">$_</a>" } @$provided_by);
- }
- print "</li>\n";
- } elsif (my $provided_by = $provided_by{$pkg}{$suite}{$archive}) {
- printf "<li><a href=\"$ROOT/%s/%s\">%s</a>: Virtual package<br>",
- $path, $pkg, $path;
- print 'provided by: ',
- join( ', ', map { "<a href=\"$ROOT/$path/$_\">$_</a>" } @$provided_by);
- }
- }
- }
- print "</ul>\n";
- }
- }
- } else {
- foreach (@results) {
- my ($pkg, $archive, $suite, $section, $subsection, $priority,
- $version) = @$_;
-
- my $real_archive = '';
- if ($archive =~ /^(security|non-US)$/) {
- $real_archive = $archive;
- $archive = 'us';
- }
- if (($real_archive eq $archive) &&
- $pkgs{$pkg}{$suite}{$archive} &&
- (version_cmp( $pkgs{$pkg}{$suite}{$archive}, $version ) >= 0)) {
- next;
- }
- $pkgs{$pkg}{$suite}{$archive} = $version;
- $subsect{$pkg}{$suite}{$archive}{source} = $subsection;
- $sect{$pkg}{$suite}{$archive}{source} = $section
- unless $section eq 'main';
- $archives{$pkg}{$suite}{$archive}{source} = $real_archive
- if $real_archive;
-
- $binaries{$pkg}{$suite}{$archive} = find_binaries( $pkg, $archive, $suite, \%src2bin );
- }
-
- if ($opts{format} eq 'html') {
- #my ($start, $end) = multipageheader( $input, scalar keys %pkgs, \%opts );
- print "<p>Found <em>".(scalar keys %pkgs)."</em> matching packages,";
- #my $count = 0;
-
- foreach my $pkg (sort keys %pkgs) {
- #$count++;
- #next if ($count < $start) or ($count > $end);
- printf "<h3>Source package %s</h3>\n", $pkg;
- print "<ul>\n";
- foreach my $suite (@SUITES) {
- foreach my $archive (@ARCHIVES) {
- if (exists $pkgs{$pkg}{$suite}{$archive}) {
- my $origin_str = "";
- if ($sect{$pkg}{$suite}{$archive}{source}) {
- $origin_str .= " [<span style=\"color:red\">$sect{$pkg}{$suite}{$archive}{source}</span>]";
- }
- if ($archives{$pkg}{$suite}{$archive}{source}) {
- $origin_str .= " [<span style=\"color:red\">$archives{$pkg}{$suite}{$archive}{source}</span>]";
- }
- printf( "<li><a href=\"$ROOT/%s/source/%s\">%s</a> (%s): %s %s",
- $suite.(($archive ne 'us')?"/$archive":''), $pkg, $suite.(($archive ne 'us')?"/$archive":''), $subsect{$pkg}{$suite}{$archive}{source},
- $pkgs{$pkg}{$suite}{$archive}, $origin_str );
-
- print "<br>Binary packages: ";
- my @bp_links;
- foreach my $bp (@{$binaries{$pkg}{$suite}{$archive}}) {
- my $bp_link = sprintf( "<a href=\"$ROOT/%s/%s\">%s</a>",
- $suite.(($archive ne 'us')?"/$archive":''), uri_escape( $bp ), $bp );
- push @bp_links, $bp_link;
- }
- print join( ", ", @bp_links );
- print "</li>\n";
- }
- }
- }
- print "</ul>\n";
- }
- }
- }
- #printindexline( $input, scalar keys %pkgs, \%opts );
-}
-#print_results(\@results, \%opts) if @results;;
-my $tet1 = new Benchmark;
-my $tetd = timediff($tet1, $tet0);
-print "Total page evaluation took ".timestr($tetd)."<br>"
- if $debug_allowed;
-
-my $trailer = Packages::HTML::trailer( $ROOT );
-$trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e; #FIXME
-print $trailer;
-
-# vim: ts=8 sw=4
+++ /dev/null
-#!/usr/bin/perl -wT
-# $Id$
-# show_package.pl -- CGI interface to show info about a package
-#
-# Copyright (C) 1998 James Treacy
-# Copyright (C) 2000, 2001 Josip Rodin
-# Copyright (C) 2001 Adam Heath
-# Copyright (C) 2004 Martin Schulze
-# Copyright (C) 2004-2006 Frank Lichtenheld
-# Copyright (C) 2006 Jeroen van Wolffelaar
-#
-# use is allowed under the terms of the GNU Public License (GPL)
-# see http://www.fsf.org/copyleft/gpl.html for a copy of the license
-
-use strict;
-use lib '../lib';
-use CGI qw( -oldstyle_urls );
-use CGI::Carp qw( fatalsToBrowser );
-use POSIX;
-use URI::Escape;
-use HTML::Entities;
-use DB_File;
-use Benchmark ':hireswallclock';
-
-use Deb::Versions;
-use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
- @ARCHITECTURES %FTP_SITES );
-use Packages::CGI;
-use Packages::DB;
-use Packages::Search qw( :all );
-use Packages::HTML;
-use Packages::Page ();
-use Packages::SrcPage ();
-
-&Packages::CGI::reset;
-
-$ENV{PATH} = "/bin:/usr/bin";
-
-# Read in all the variables set by the form
-my $input;
-if ($ARGV[0] && ($ARGV[0] eq 'php')) {
- $input = new CGI(\*STDIN);
-} else {
- $input = new CGI;
-}
-
-my $pet0 = new Benchmark;
-my $tet0 = new Benchmark;
-# use this to disable debugging in production mode completly
-my $debug_allowed = 1;
-my $debug = $debug_allowed && $input->param("debug");
-$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
-$Packages::CGI::debug = $debug;
-
-&Packages::Config::init( '../' );
-&Packages::DB::init();
-
-my ( $pkg, $suite, $arch );
-my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
- var => \$pkg },
- suite => { default => undef, match => '^(\w+)$',
- var => \$suite },
- arch => { default => undef, match => '^([a-z0-9-]+)$',
- var => \$arch }
- );
-
-my %opts;
-my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
-
-if ($params{errors}{package}) {
- fatal_error( "package not valid or not specified" );
- $pkg = '';
-}
-if ($params{errors}{suite}) {
- fatal_error( "suite not valid or not specified" );
- $suite = '';
-}
-if ($params{errors}{arch}) {
- fatal_error( "arch not valid or not specified" );
- $arch = '';
-}
-
-print $input->header( -charset => 'utf-8' );
-
-print Packages::HTML::header( title => "Filelist of package $pkg in $suite of arch $arch",
- lang => 'en',
- #desc => $short_desc,
- #keywords => "$suite, $archive, $section, $subsection, $version",
- #title_tag => "Details of package $pkg in $suite",
- );
-
-print_errors();
-print_hints();
-print_msgs();
-print_debug();
-print_notes();
-
-unless (@Packages::CGI::fatal_errors) {
- tie my %contents, 'DB_File', "$DBDIR/contents/filelists_${suite}_${arch}.db",
- O_RDONLY, 0666, $DB_BTREE
- or die "Invalid suite/arch combination";
-
- print "No such package in this suite on this arch" if not exists $contents{$pkg};
- my @files = unpack "L/(CC/a)", $contents{$pkg};
- my $file = "";
- print "<pre>";
- for (my $i=0; $i<scalar @files;) {
- $file = substr($file, 0, $files[$i++]).$files[$i++];
- print "$file\n";
- }
- print "</pre>";
-}
-
-my $tet1 = new Benchmark;
-my $tetd = timediff($tet1, $tet0);
-print "Total page evaluation took ".timestr($tetd)."<br>"
- if $debug_allowed;
-
-my $trailer = Packages::HTML::trailer( $ROOT );
-$trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e; #FIXME
-print $trailer;
-
-# vim: ts=8 sw=4
+++ /dev/null
-#!/usr/bin/perl -wT
-# $Id$
-# show_package.pl -- CGI interface to show info about a package
-#
-# Copyright (C) 1998 James Treacy
-# Copyright (C) 2000, 2001 Josip Rodin
-# Copyright (C) 2001 Adam Heath
-# Copyright (C) 2004 Martin Schulze
-# Copyright (C) 2004-2006 Frank Lichtenheld
-# Copyright (C) 2006 Jeroen van Wolffelaar
-#
-# use is allowed under the terms of the GNU Public License (GPL)
-# see http://www.fsf.org/copyleft/gpl.html for a copy of the license
-
-use strict;
-use lib '../lib';
-use CGI qw( -oldstyle_urls );
-use CGI::Carp qw( fatalsToBrowser );
-use POSIX;
-use URI::Escape;
-use HTML::Entities;
-use DB_File;
-use Benchmark ':hireswallclock';
-
-use Deb::Versions;
-use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
- @ARCHITECTURES %FTP_SITES );
-use Packages::CGI;
-use Packages::DB;
-use Packages::Search qw( :all );
-use Packages::HTML;
-use Packages::Page ();
-use Packages::SrcPage ();
-
-&Packages::CGI::reset;
-
-$ENV{PATH} = "/bin:/usr/bin";
-
-# Read in all the variables set by the form
-my $input;
-if ($ARGV[0] && ($ARGV[0] eq 'php')) {
- $input = new CGI(\*STDIN);
-} else {
- $input = new CGI;
-}
-
-my $pet0 = new Benchmark;
-my $tet0 = new Benchmark;
-# use this to disable debugging in production mode completly
-my $debug_allowed = 1;
-my $debug = $debug_allowed && $input->param("debug");
-$debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
-$Packages::CGI::debug = $debug;
-
-&Packages::Config::init( '../' );
-&Packages::DB::init();
-
-if (my $path = $input->param('path')) {
- my @components = map { lc $_ } split /\//, $path;
-
- my %SUITES = map { $_ => 1 } @SUITES;
- my %SECTIONS = map { $_ => 1 } @SECTIONS;
- my %ARCHIVES = map { $_ => 1 } @ARCHIVES;
- my %ARCHITECTURES = map { $_ => 1 } @ARCHITECTURES;
-
- foreach (@components) {
- if ($SUITES{$_}) {
- $input->param('suite', $_);
- } elsif ($SECTIONS{$_}) {
- $input->param('section', $_);
- } elsif ($ARCHIVES{$_}) {
- $input->param('archive', $_);
- } elsif ($ARCHITECTURES{$_}) {
- $input->param('arch', $_);
- } elsif ($_ eq 'source') {
- $input->param('source', 1);
- }
- }
-}
-
-my ( $pkg, $suite, @sections, @archs, @archives, $format );
-my %params_def = ( package => { default => undef, match => '^([a-z0-9.+-]+)$',
- var => \$pkg },
- suite => { default => undef, match => '^(\w+)$',
- var => \$suite },
- archive => { default => 'all', match => '^(\w+)$',
- array => ',', var => \@archives,
- replace => { all => [qw(us security non-US)] } },
- section => { default => 'all', match => '^(\w+)$',
- array => ',', var => \@sections,
- replace => { all => \@SECTIONS } },
- arch => { default => 'any', match => '^(\w+)$',
- array => ',', var => \@archs,
- replace => { any => \@ARCHITECTURES } },
- format => { default => 'html', match => '^(\w+)$',
- var => \$format },
- source => { default => 0, match => '^(\d+)$' },
- );
-my %opts;
-my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
-
-#XXX: Don't use alternative output formats yet
-$format = 'html';
-if ($format eq 'html') {
- print $input->header( -charset => 'utf-8' );
-}
-
-if ($params{errors}{package}) {
- fatal_error( "package not valid or not specified" );
- $pkg = '';
-}
-if ($params{errors}{suite}) {
- fatal_error( "suite not valid or not specified" );
- $suite = '';
-}
-
-$opts{h_suites} = { $suite => 1 };
-$opts{h_archs} = { map { $_ => 1 } @archs };
-$opts{h_sections} = { map { $_ => 1 } @sections };
-$opts{h_archives} = { map { $_ => 1 } @archives };
-
-my $DL_URL = "$pkg/download";
-my $FILELIST_URL = "$pkg/files";
-
-our (%packages_all, %sources_all);
-my (@results, @non_results);
-my $page = $opts{source} ?
- new Packages::SrcPage( $pkg ) :
- new Packages::Page( $pkg );
-my $package_page = "";
-my ($short_desc, $version, $archive, $section, $subsection) = ("")x5;
-
-sub gettext { return $_[0]; };
-
-my $st0 = new Benchmark;
-unless (@Packages::CGI::fatal_errors) {
- tie %packages_all, 'DB_File', "$DBDIR/packages_all_$suite.db",
- O_RDONLY, 0666, $DB_BTREE
- or die "couldn't tie DB $DBDIR/packages_all_$suite.db: $!";
- tie %sources_all, 'DB_File', "$DBDIR/sources_all_$suite.db",
- O_RDONLY, 0666, $DB_BTREE
- or die "couldn't tie DB $DBDIR/sources_all_$suite.db: $!";
-
- unless ($opts{source}) {
- read_entry_all( \%packages, $pkg, \@results, \@non_results, \%opts );
-
- unless (@results || @non_results ) {
- fatal_error( "No such package".
- "{insert link to search page with substring search}" );
- } else {
- unless (@results) {
- fatal_error( "Package not available in this suite" );
- } else {
- for my $entry (@results) {
- debug( join(":", @$entry), 1 );
- my (undef, $archive, undef, $arch, $section, $subsection,
- $priority, $version, $provided_by) = @$entry;
-
- if ($arch ne 'virtual') {
- my %data = split /\000/, $packages_all{"$pkg $arch $version"};
- $data{package} = $pkg;
- $data{architecture} = $arch;
- $data{version} = $version;
- $page->merge_package(\%data) or debug( "Merging $pkg $arch $version FAILED", 2 );
- } else {
- $page->add_provided_by([split /\s+/, $provided_by]);
- }
- }
-
- unless ($page->is_virtual()) {
- $version = $page->{newest};
- my $source = $page->get_newest( 'source' );
- $archive = $page->get_newest( 'archive' );
- debug( "find source package: source=$source", 1);
- my $src_data = $sources_all{"$archive $suite $source"};
- $page->add_src_data( $source, $src_data )
- if $src_data;
-
- my $st1 = new Benchmark;
- my $std = timediff($st1, $st0);
- debug( "Data search and merging took ".timestr($std) );
-
- my $encodedpkg = uri_escape( $pkg );
- my ($v_str, $v_str_arch, $v_str_arr) = $page->get_version_string();
- my $did = $page->get_newest( 'description' );
- $section = $page->get_newest( 'section' );
- $subsection = $page->get_newest( 'subsection' );
- my $filenames = $page->get_arch_field( 'filename' );
- my $file_md5sums = $page->get_arch_field( 'md5sum' );
- my $archives = $page->get_arch_field( 'archive' );
- my $sizes_inst = $page->get_arch_field( 'installed-size' );
- my $sizes_deb = $page->get_arch_field( 'size' );
- my @archs = sort $page->get_architectures;
-
- # process description
- #
- my $desc = $descriptions{$did};
- $short_desc = encode_entities( $1, "<>&\"" )
- if $desc =~ s/^(.*)$//m;
- my $long_desc = encode_entities( $desc, "<>&\"" );
-
- $long_desc =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),<a href=\"$1\">$1</a>$3,go; # syntax highlighting -> '];
- $long_desc =~ s/\A //o;
- $long_desc =~ s/\n /\n/sgo;
- $long_desc =~ s/\n.\n/\n<p>\n/go;
- $long_desc =~ s/(((\n|\A) [^\n]*)+)/\n<pre>$1\n<\/pre>/sgo;
-# $long_desc = conv_desc( $lang, $long_desc );
-# $short_desc = conv_desc( $lang, $short_desc );
-
- my %all_suites;
- foreach (@results, @non_results) {
- my $a = $_->[1];
- my $s = $_->[2];
- if ($a =~ /^(?:us|security|non-US)$/o) {
- $all_suites{$s}++;
- } else {
- $all_suites{"$s/$a"}++;
- }
- }
- foreach (suites_sort(keys %all_suites)) {
- if (("$suite/$archive" eq $_)
- || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
- $package_page .= "[ <strong>$_</strong> ] ";
- } else {
- $package_page .=
- "[ <a href=\"$ROOT/$_/".uri_escape($pkg)."\">$_</a> ] ";
- }
- }
- $package_page .= '<br>';
-
- $package_page .= simple_menu( [ gettext( "Distribution:" ),
- gettext( "Overview over this suite" ),
- "$ROOT/$suite/",
- $suite ],
- [ gettext( "Section:" ),
- gettext( "All packages in this section" ),
- "$ROOT/$suite/$subsection/",
- $subsection ],
- );
-
- my $title .= sprintf( gettext( "Package: %s (%s)" ), $pkg, $v_str );
- $title .= " ".marker( $archive ) if $archive ne 'us';
- $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
- and $archive ne 'non-US'; # non-US/security
- $title .= " ".marker( $section ) if $section ne 'main';
- $package_page .= title( $title );
-
- $package_page .= "<h2>".gettext( "Versions:" )." $v_str_arch</h2>\n"
- unless $version eq $v_str;
- if (my $provided_by = $page->{provided_by}) {
- note( gettext( "This is also a virtual package provided by ").join( ', ', map { "<a href=\"$ROOT/$suite/$_\">$_</a>" } @$provided_by) );
- }
-
- if ($suite eq "experimental") {
- note( gettext( "Experimental package"),
- gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> distribution. That means it is likely unstable or buggy, and it may even cause data loss. If you ignore this warning and install it nevertheless, you do it on your own risk.")."</p><p>".
- gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
- );
- }
- if ($subsection eq "debian-installer") {
- note( gettext( "debian-installer udeb package"),
- gettext( "Warning: This package is intended for the use in building <a href=\"http://www.debian.org/devel/debian-installer\">debian-installer</a> images only. Do not install it on a normal Debian system." )
- );
- }
- $package_page .= pdesc( $short_desc, $long_desc );
-
- #
- # display dependencies
- #
- my $dep_list;
- $dep_list = print_deps( \%packages, \%opts, $pkg,
- $page->get_dep_field('depends'),
- 'depends' );
- $dep_list .= print_deps( \%packages, \%opts, $pkg,
- $page->get_dep_field('recommends'),
- 'recommends' );
- $dep_list .= print_deps( \%packages, \%opts, $pkg,
- $page->get_dep_field('suggests'),
- 'suggests' );
-
- if ( $dep_list ) {
- $package_page .= "<div id=\"pdeps\">\n";
- $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
- if ($suite eq "experimental") {
- note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
- }
-
- $package_page .= pdeplegend( [ 'dep', gettext( 'depends' ) ],
- [ 'rec', gettext( 'recommends' ) ],
- [ 'sug', gettext( 'suggests' ) ], );
-
- $package_page .= $dep_list;
- $package_page .= "</div> <!-- end pdeps -->\n";
- }
-
- #
- # Download package
- #
- my $encodedpack = uri_escape( $pkg );
- $package_page .= "<div id=\"pdownload\">";
- $package_page .= sprintf( "<h2>".gettext( "Download %s\n" )."</h2>",
- $pkg ) ;
- $package_page .= "<table border=\"1\" summary=\"".gettext("The download table links to the download of the package and a file overview. In addition it gives information about the package size and the installed size.")."\">\n";
- $package_page .= "<caption class=\"hidecss\">".gettext("Download for all available architectures")."</caption>\n";
- $package_page .= "<tr>\n";
- $package_page .= "<th>".gettext("Architecture")."</th><th>".gettext("Files")."</th><th>".gettext( "Package Size")."</th><th>".gettext("Installed Size")."</th></tr>\n";
- foreach my $a ( @archs ) {
- $package_page .= "<tr>\n";
- $package_page .= "<th><a href=\"$ROOT/$suite/$encodedpkg/$a/download";
- $package_page .= "\">$a</a></th>\n";
- $package_page .= "<td>";
- if ( $suite ne "experimental" ) {
- $package_page .= sprintf( "[<a href=\"%s\">".gettext( "list of files" )."</a>]\n",
- "$ROOT/$suite/$encodedpkg/$a/filelist", $pkg );
- } else {
- $package_page .= gettext( "no current information" );
- }
- $package_page .= "</td>\n<td align=right>"; #FIXME: css
- $package_page .= floor(($sizes_deb->{$a}/102.4)+0.5)/10 . " kB";
- $package_page .= "</td>\n<td align=right>"; #FIXME: css
- $package_page .= $sizes_inst->{$a} . " kB";
- $package_page .= "</td>\n</tr>";
- }
- $package_page .= "</table>\n";
- $package_page .= "</div> <!-- end pdownload -->\n";
-
- #
- # more information
- #
- $package_page .= pmoreinfo( name => $pkg, data => $page,
- opts => \%opts,
- env => \%FTP_SITES,
- bugreports => 1, sourcedownload => 1,
- changesandcopy => 1, maintainers => 1,
- search => 1 );
- } else { # unless $page->is_virtual
- $short_desc = gettext( "virtual package" );
-
- my %all_suites;
- foreach (@results, @non_results) {
- my $a = $_->[1];
- my $s = $_->[2];
- if ($a =~ /^(?:us|security|non-US)$/o) {
- $all_suites{$s}++;
- } else {
- $all_suites{"$s/$a"}++;
- }
- }
- foreach (suites_sort(keys %all_suites)) {
- if (("$suite/$archive" eq $_)
- || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
- $package_page .= "[ <strong>$_</strong> ] ";
- } else {
- $package_page .=
- "[ <a href=\"$ROOT/$_/".uri_escape($pkg)."\">$_</a> ] ";
- }
- }
- $package_page .= '<br>';
- $package_page .= simple_menu( [ gettext( "Distribution:" ),
- gettext( "Overview over this distribution" ),
- "$ROOT/",
- $suite ],
- [ gettext( "Section:" ),
- gettext( "All packages in this section" ),
- "$ROOT/$suite/virtual/",
-
- 'virtual' ], );
-
- $package_page .= title( sprintf( gettext( "Virtual Package: %s" ),
- $pkg ) );
-
- my $policy_url = 'http://www.debian.org/doc/debian-policy/';
- note( sprintf( gettext( "This is a <em>virtual package</em>. See the <a href=\"%s\">Debian policy</a> for a <a href=\"%sch-binary.html#s-virtual_pkg\">definition of virtual packages</a>." ),
- $policy_url, $policy_url ));
-
- $package_page .= sprintf( "<h2>".gettext( "Packages providing %s" )."</h2>", $pkg );
- my $provided_by = $page->{provided_by};
- $package_page .= pkg_list( \%packages, \%opts, $provided_by, 'en');
-
- } # else (unless $page->is_virtual)
- } # else (unless @results)
- } # else (unless (@results || @non_results ))
- } else {
- read_src_entry_all( \%sources, $pkg, \@results, \@non_results, \%opts );
-
- unless (@results || @non_results ) {
- fatal_error( "No such package".
- "{insert link to search page with substring search}" );
- } else {
- unless (@results) {
- fatal_error( "Package not available in this suite" );
- } else {
- for my $entry (@results) {
- debug( join(":", @$entry), 1 );
- my (undef, $archive, undef, $section, $subsection,
- $priority, $version) = @$entry;
-
- my $data = $sources_all{"$archive $suite $pkg"};
- $page->merge_data($pkg, $suite, $archive, $data) or debug( "Merging $pkg $version FAILED", 2 );
- }
- $version = $page->{version};
-
- my $st1 = new Benchmark;
- my $std = timediff($st1, $st0);
- debug( "Data search and merging took ".timestr($std) );
-
- my $encodedpkg = uri_escape( $pkg );
- my ($v_str, $v_str_arr) = $page->get_version_string();
- $archive = $page->get_newest( 'archive' );
- $section = $page->get_newest( 'section' );
- $subsection = $page->get_newest( 'subsection' );
-
- my %all_suites;
- foreach (@results, @non_results) {
- my $a = $_->[1];
- my $s = $_->[2];
- if ($a =~ /^(?:us|security|non-US)$/o) {
- $all_suites{$s}++;
- } else {
- $all_suites{"$s/$a"}++;
- }
- }
- foreach (suites_sort(keys %all_suites)) {
- if (("$suite/$archive" eq $_)
- || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
- $package_page .= "[ <strong>$_</strong> ] ";
- } else {
- $package_page .=
- "[ <a href=\"$ROOT/$_/source/".uri_escape($pkg)."\">$_</a> ] ";
- }
- }
- $package_page .= '<br>';
-
- $package_page .= simple_menu( [ gettext( "Distribution:" ),
- gettext( "Overview over this suite" ),
- "/$suite/",
- $suite ],
- [ gettext( "Section:" ),
- gettext( "All packages in this section" ),
- "/$suite/$subsection/",
- $subsection ],
- );
-
- my $title .= sprintf( gettext( "Source Package: %s (%s)" ),
- $pkg, $v_str );
- $title .= " ".marker( $archive ) if $archive ne 'us';
- $title .= " ".marker( $subsection ) if $subsection eq 'non-US'
- and $archive ne 'non-US'; # non-US/security
- $title .= " ".marker( $section ) if $section ne 'main';
- $package_page .= title( $title );
-
- if ($suite eq "experimental") {
- $package_page .= note( gettext( "Experimental package"),
- gettext( "Warning: This package is from the <span class=\"pred\">experimental</span> distribution. That means it is likely unstable or buggy, and it may even cause data loss. If you ignore this warning and install it nevertheless, you do it on your own risk.")."</p><p>".
- gettext( "Users of experimental packages are encouraged to contact the package maintainers directly in case of problems." )
- );
- }
- if ($subsection eq "debian-installer") {
- note( gettext( "debian-installer udeb package"),
- gettext( "Warning: This package is intended for the use in building <a href=\"http://www.debian.org/devel/debian-installer\">debian-installer</a> images only. Do not install it on a normal Debian system." )
- );
- }
-
- my $binaries = find_binaries( $pkg, $archive, $suite, \%src2bin );
- if ($binaries && @$binaries) {
- $package_page .= '<div class="pdesc">';
- $package_page .= gettext( "The following binary packages are built from this source package:" );
- $package_page .= pkg_list( \%packages, \%opts, $binaries, 'en' );
- $package_page .= '</div> <!-- end pdesc -->';
- }
-
- #
- # display dependencies
- #
- my $dep_list;
- $dep_list = print_src_deps( \%packages, \%opts, $pkg,
- $page->get_dep_field('build-depends'),
- 'build-depends' );
- $dep_list .= print_src_deps( \%packages, \%opts, $pkg,
- $page->get_dep_field('build-depends-indep'),
- 'build-depends-indep' );
-
- if ( $dep_list ) {
- $package_page .= "<div id=\"pdeps\">\n";
- $package_page .= sprintf( "<h2>".gettext( "Other Packages Related to %s" )."</h2>\n", $pkg );
- if ($suite eq "experimental") {
- note( gettext( "Note that the \"<span class=\"pred\">experimental</span>\" distribution is not self-contained; missing dependencies are likely found in the \"<a href=\"/unstable/\">unstable</a>\" distribution." ) );
- }
-
- $package_page .= pdeplegend( [ 'adep', gettext( 'build-depends' ) ],
- [ 'idep', gettext( 'build-depends-indep' ) ],
- );
-
- $package_page .= $dep_list;
- $package_page .= "</div> <!-- end pdeps -->\n";
- }
-
- #
- # Source package download
- #
- $package_page .= "<div id=\"pdownload\">\n";
- my $encodedpack = uri_escape( $pkg );
- $package_page .= sprintf( "<h2>".gettext( "Download %s" )."</h2>\n",
- $pkg ) ;
-
- my $source_files = $page->get_src( 'files' );
- my $source_dir = $page->get_src( 'directory' );
-
- $package_page .= sprintf( "<table cellspacing=\"0\" cellpadding=\"2\" summary=\"Download information for the files of this source package\">\n"
- ."<tr><th>%s</th><th>%s</th><th>%s</th>",
- gettext("File"),
- gettext("Size (in kB)"),
- gettext("md5sum") );
- foreach( @$source_files ) {
- my ($src_file_md5, $src_file_size, $src_file_name)
- = split /\s+/, $_;
- my $src_url;
- for ($archive) {
- /security/o && do {
- $src_url = $FTP_SITES{security}; last };
- /volatile/o && do {
- $src_url = $FTP_SITES{volatile}; last };
- /backports/o && do {
- $src_url = $FTP_SITES{backports}; last };
- /non-us/io && do {
- $src_url = $FTP_SITES{'non-US'}; last };
- $src_url = $FTP_SITES{us};
- }
- $src_url .= "/$source_dir/$src_file_name";
-
- $package_page .= "<tr><td><a href=\"$src_url\">$src_file_name</a></td>\n"
- ."<td class=\"dotalign\">".sprintf("%.1f", (floor(($src_file_size/102.4)+0.5)/10))."</td>\n"
- ."<td>$src_file_md5</td></tr>";
- }
- $package_page .= "</table>\n";
- $package_page .= "</div> <!-- end pdownload -->\n";
-
- #
- # more information
- #
- $package_page .= pmoreinfo( name => $pkg, data => $page,
- opts => \%opts,
- env => \%FTP_SITES,
- bugreports => 1,
- changesandcopy => 1, maintainers => 1,
- search => 1, is_source => 1 );
- }
- }
- }
-}
-
-use Data::Dumper;
-debug( "Final page object:\n".Dumper($page), 3 );
-
-my $title = $opts{source} ?
- "Details of source package <em>$pkg</em> in $suite" :
- "Details of package <em>$pkg</em> in $suite" ;
-my $title_tag = $opts{source} ?
- "Details of source package $pkg in $suite" :
- "Details of package $pkg in $suite" ;
-print Packages::HTML::header( title => $title ,
- lang => 'en',
- desc => $short_desc,
- keywords => "$suite, $archive, $section, $subsection, $version",
- title_tag => "Details of package $pkg in $suite",
- );
-
-print_errors();
-print_hints();
-print_msgs();
-print_debug();
-print_notes();
-
-unless (@Packages::CGI::fatal_errors) {
- print $package_page;
-}
-my $tet1 = new Benchmark;
-my $tetd = timediff($tet1, $tet0);
-print "Total page evaluation took ".timestr($tetd)."<br>"
- if $debug_allowed;
-
-my $trailer = Packages::HTML::trailer( $ROOT );
-$trailer =~ s/LAST_MODIFIED_DATE/gmtime()/e; #FIXME
-print $trailer;
-
-# vim: ts=8 sw=4
projects / deb / packages.git / commitdiff