* Move coniguratio stuf to own module
authorFrank Lichtenheld <frank@lichtenheld.de>
Sun, 5 Feb 2006 16:59:48 +0000 (16:59 +0000)
committerFrank Lichtenheld <frank@lichtenheld.de>
Sun, 5 Feb 2006 16:59:48 +0000 (16:59 +0000)
* Overhaul archive handling for show_package
* Begin to make the URL handling somewhat consistent
* Fix source files handling, which was broken by the last upload

bin/parse-packages
bin/parse-sources
cgi-bin/search_packages.pl
cgi-bin/show_package.pl
conf/apache.conf
config.sh
lib/Deb/Versions.pm
lib/Packages/Config.pm [new file with mode: 0644]
lib/Packages/HTML.pm
lib/Packages/Page.pm
lib/Packages/Search.pm

index 04bee3d9b75381ce410359568e9b25466e92dbfa..ab5fbcef5b12e357fbfcce47cea2093e14356e8c 100755 (executable)
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 use strict;
+use lib './lib';
 
 my $what = $ARGV[0] ? "non-free" : "*";
 # max. distinct results for a given package postfix
 my $MAX_PACKAGE_POSTFIXES = 100;
 
 use DB_File;
+use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES );
+&Packages::Config::init( './' );
 my %packages_small = ();
 my %package_names = ();
 my %package_postfixes = ();
@@ -35,20 +38,17 @@ my @descriptions = ("we count lines one-based\000");
 my %packages_descriptions = ();
 my %descriptions_packages = ();
 
-my @archives = ( 'us', 'non-US', 'security', 'volatile', 'backports' );
-my @suites = ('oldstable', 'stable', 'testing', 'unstable', 'experimental');
-
 $/ = "";
 
-for my $archive (@archives) {
-    for my $suite (@suites) {
+for my $archive (@ARCHIVES) {
+    for my $suite (@SUITES) {
 
        print "Reading $archive/$suite...\n";
        my %packages_all_db;
-       tie %packages_all_db, "DB_File", "packages_all_$suite.db.new",
+       tie %packages_all_db, "DB_File", "$DBDIR/packages_all_$suite.db.new",
                O_RDWR|O_CREAT, 0666, $DB_BTREE
                or die "Error creating DB: $!";
-       open PKG, "zcat /org/packages.debian.org/archive/$archive/$suite/$what/{,debian-installer/}binary-*/Packages.gz|";
+       open PKG, "zcat $TOPDIR/archive/$archive/$suite/$what/{,debian-installer/}binary-*/Packages.gz|";
        while (<PKG>) {
                next if /^\s*$/;
                my $data = "";
@@ -119,7 +119,7 @@ for my $archive (@archives) {
 
 print "Writing databases...\n";
 my %packages_small_db;
-tie %packages_small_db, "DB_File", "packages_small.db.new",
+tie %packages_small_db, "DB_File", "$DBDIR/packages_small.db.new",
        O_RDWR|O_CREAT, 0666, $DB_BTREE
        or die "Error creating DB: $!";
 while (my ($k, $v) = each(%packages_small)) {
@@ -129,7 +129,7 @@ while (my ($k, $v) = each(%packages_small)) {
 untie %packages_small_db;
 
 my %sources_packages_db;
-tie %sources_packages_db, "DB_File", "sources_packages.db.new",
+tie %sources_packages_db, "DB_File", "$DBDIR/sources_packages.db.new",
        O_RDWR|O_CREAT, 0666, $DB_BTREE
        or die "Error creating DB: $!";
 while (my ($k, $v) = each(%sources_packages)) {
@@ -139,7 +139,7 @@ while (my ($k, $v) = each(%sources_packages)) {
 untie %sources_packages_db;
 
 my %packages_descriptions_db;
-tie %packages_descriptions_db, "DB_File", "packages_descriptions.db.new",
+tie %packages_descriptions_db, "DB_File", "$DBDIR/packages_descriptions.db.new",
        O_RDWR|O_CREAT, 0666, $DB_BTREE
        or die "Error creating DB: $!";
 while (my ($k, $v) = each(%packages_descriptions)) {
@@ -148,7 +148,7 @@ while (my ($k, $v) = each(%packages_descriptions)) {
 untie %packages_descriptions_db;
 
 my %descriptions_packages_db;
-tie %descriptions_packages_db, "DB_File", "descriptions_packages.db.new",
+tie %descriptions_packages_db, "DB_File", "$DBDIR/descriptions_packages.db.new",
        O_RDWR|O_CREAT, 0666, $DB_BTREE
        or die "Error creating DB: $!";
 while (my ($k, $v) = each(%descriptions_packages)) {
@@ -158,10 +158,10 @@ while (my ($k, $v) = each(%descriptions_packages)) {
 untie %descriptions_packages_db;
 
 my %descriptions_db;
-tie %descriptions_db, "DB_File", "descriptions.db.new",
+tie %descriptions_db, "DB_File", "$DBDIR/descriptions.db.new",
        O_RDWR|O_CREAT, 0666, $DB_BTREE
        or die "Error creating DB: $!";
-open DESCR, "> descriptions.txt" or die "Error creating descriptions textfile";
+open DESCR, ">", "$DBDIR/descriptions.txt" or die "Error creating descriptions textfile";
 for (my $i=1; $i<= $#descriptions; $i++) {
        my $plain_description = $descriptions[$i];
        $plain_description =~ s/\n .\n/ /og;
@@ -182,7 +182,7 @@ for my $pkg (keys %package_names) {
        }
 }
 my %package_postfixes_db;
-tie %package_postfixes_db, "DB_File", "package_postfixes.db.new",
+tie %package_postfixes_db, "DB_File", "$DBDIR/package_postfixes.db.new",
        O_RDWR|O_CREAT, 0666, $DB_BTREE
        or die "Error creating DB: $!";
 while (my ($k, $v) = each(%package_postfixes)) {
@@ -197,13 +197,16 @@ while (my ($k, $v) = each(%package_postfixes)) {
 }
 untie %package_postfixes_db;
 
-rename("packages_small.db.new", "packages_small.db");
-rename("sources_packages.db.new", "sources_packages.db");
-for my $suite (@suites) {
-       rename("packages_all_$suite.db.new", "packages_all_$suite.db");
+rename("$DBDIR/packages_small.db.new", "$DBDIR/packages_small.db");
+rename("$DBDIR/sources_packages.db.new", "$DBDIR/sources_packages.db");
+for my $suite (@SUITES) {
+       rename("$DBDIR/packages_all_$suite.db.new",
+              "$DBDIR/packages_all_$suite.db");
 }
-rename("packages_descriptions.db.new", "packages_descriptions.db");
-rename("descriptions_packages.db.new", "descriptions_packages.db");
-rename("descriptions.txt.new", "descriptions.txt");
-rename("descriptions.db.new", "descriptions.db");
-rename("package_postfixes.db.new", "package_postfixes.db");
+rename("$DBDIR/packages_descriptions.db.new",
+       "$DBDIR/packages_descriptions.db");
+rename("$DBDIR/descriptions_packages.db.new",
+       "$DBDIR/descriptions_packages.db");
+rename("$DBDIR/descriptions.txt.new", "$DBDIR/descriptions.txt");
+rename("$DBDIR/descriptions.db.new", "$DBDIR/descriptions.db");
+rename("$DBDIR/package_postfixes.db.new", "$DBDIR/package_postfixes.db");
index 82716b3c35216d54728cf03fa423377ef546786b..9c97e2f315750f5849a1c2eef5d76cdacd9b906c 100755 (executable)
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 use strict;
+use lib './lib';
 
 my $what = $ARGV[0] ? "non-free" : "*";
 # max. distinct results for a given package postfix
 my $MAX_SOURCE_POSTFIXES = 100;
 
 use DB_File;
+use Packages::Config qw( $TOPDIR $DBDIR @ARCHIVES @SUITES );
+&Packages::Config::init( './' );
 my %sources_small = ();
 my %source_names = ();
 my %source_postfixes = ();
 
-my @archives = ( 'us', 'non-US', 'security', 'volatile', 'backports' );
-my @suites = ('oldstable', 'stable', 'testing', 'unstable', 'experimental');
-
 $/ = "";
 
-for my $archive (@archives) {
-    for my $suite (@suites) {
+for my $archive (@ARCHIVES) {
+    for my $suite (@SUITES) {
 
        print "Reading $archive/$suite...\n";
        my %sources_all_db;
-       tie %sources_all_db, "DB_File", "sources_all_$suite.db.new",
+       tie %sources_all_db, "DB_File", "$DBDIR/sources_all_$suite.db.new",
                O_RDWR|O_CREAT, 0666, $DB_BTREE
                or die "Error creating DB: $!";
-       open PKG, "zcat /org/packages.debian.org/archive/$archive/$suite/$what/source/Sources.gz|";
+       open PKG, "zcat $TOPDIR/archive/$archive/$suite/$what/source/Sources.gz|";
        while (<PKG>) {
                next if /^\s*$/;
                my $data = "";
@@ -79,7 +79,7 @@ for my $archive (@archives) {
 
 print "Writing databases...\n";
 my %sources_small_db;
-tie %sources_small_db, "DB_File", "sources_small.db.new",
+tie %sources_small_db, "DB_File", "$DBDIR/sources_small.db.new",
        O_RDWR|O_CREAT, 0666, $DB_BTREE
        or die "Error creating DB: $!";
 while (my ($k, $v) = each(%sources_small)) {
@@ -98,7 +98,7 @@ for my $pkg (keys %source_names) {
        }
 }
 my %source_postfixes_db;
-tie %source_postfixes_db, "DB_File", "source_postfixes.db.new",
+tie %source_postfixes_db, "DB_File", "$DBDIR/source_postfixes.db.new",
        O_RDWR|O_CREAT, 0666, $DB_BTREE
        or die "Error creating DB: $!";
 while (my ($k, $v) = each(%source_postfixes)) {
@@ -113,8 +113,8 @@ while (my ($k, $v) = each(%source_postfixes)) {
 }
 untie %source_postfixes_db;
 
-for my $suite (@suites) {
-       rename("sources_all_$suite.db.new", "sources_all_$suite.db");
+for my $suite (@SUITES) {
+       rename("$DBDIR/sources_all_$suite.db.new", "$DBDIR/sources_all_$suite.db");
 }
-rename("sources_small.db.new", "sources_small.db");
-rename("source_postfixes.db.new", "source_postfixes.db");
+rename("$DBDIR/sources_small.db.new", "$DBDIR/sources_small.db");
+rename("$DBDIR/source_postfixes.db.new", "$DBDIR/source_postfixes.db");
index e5cf44d15d4b2bd44a517fd0bc7a29a09a22dc2f..22e9495808dd5c6252ee9b254125a82eac413c3b 100755 (executable)
@@ -21,6 +21,8 @@ use DB_File;
 use Benchmark;
 
 use Deb::Versions;
+use Packages::Config qw( $DBDIR $ROOT $SEARCH_CGI $SEARCH_PAGE
+                        @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES );
 use Packages::CGI;
 use Packages::Search qw( :all );
 use Packages::HTML ();
@@ -46,37 +48,9 @@ $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
 $Packages::CGI::debug = $debug;
 
 # read the configuration
-our $config_read_time ||= 0;
 our $db_read_time ||= 0;
-our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES );
 
-# FIXME: move to own module
-my $modtime = (stat( "../config.sh" ))[9];
-if ($modtime > $config_read_time) {
-    if (!open (C, '<', "../config.sh")) {
-       error( "Internal: Cannot open configuration file." );
-    }
-    while (<C>) {
-       next if /^\s*\#/o;
-       chomp;
-       $topdir = $1 if /^\s*topdir="?([^\"]*)"?\s*$/o;
-       $ROOT = $1 if /^\s*root="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::HOME = $1 if /^\s*home="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::SEARCH_CGI = $1 if /^\s*searchcgi="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::SEARCH_PAGE = $1 if /^\s*searchpage="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::WEBMASTER_MAIL = $1 if /^\s*webmaster="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::CONTACT_MAIL = $1 if /^\s*contact="?([^\"]*)"?\s*$/o;
-       @SUITES = split(/\s+/, $1) if /^\s*suites="?([^\"]*)"?\s*$/o;
-       @SECTIONS = split(/\s+/, $1) if /^\s*sections="?([^\"]*)"?\s*$/o;
-       @ARCHIVES = split(/\s+/, $1) if /^\s*archives="?([^\"]*)"?\s*$/o;
-       @ARCHITECTURES = split(/\s+/, $1) if /^\s*architectures="?([^\"]*)"?\s*$/o;
-    }
-    close (C);
-    debug( "read config ($modtime > $config_read_time)" );
-    $config_read_time = $modtime;
-}
-my $DBDIR = $topdir . "/files/db";
-my $thisscript = $Packages::HTML::SEARCH_CGI;
+&Packages::Config::init( '../' );
 
 if (my $path = $input->param('path')) {
     my @components = map { lc $_ } split /\//, $path;
@@ -95,6 +69,8 @@ if (my $path = $input->param('path')) {
            $input->param('archive', $_);
        } elsif ($ARCHITECTURES{$_}) {
            $input->param('arch', $_);
+       } elsif ($_ eq 'source') {
+           $input->param('searchon','sourcenames');
        }
     }
 }
@@ -261,7 +237,7 @@ if (!@Packages::CGI::fatal_errors && !@results) {
            
            if ($exact) {
                $printed++;
-               hint( "You have searched only for exact matches of the package name. You can try to search for <a href=\"$thisscript?exact=0&amp;searchon=$searchon&amp;suite=$suites_param&amp;case=$case&amp;section=$sections_param&amp;keywords=$keyword_esc&amp;arch=$archs_param\">package names that contain your search string</a>." );
+               hint( "You have searched only for exact matches of the package name. You can try to search for <a href=\"$SEARCH_CGI?exact=0&amp;searchon=$searchon&amp;suite=$suites_param&amp;case=$case&amp;section=$sections_param&amp;keywords=$keyword_esc&amp;arch=$archs_param\">package names that contain your search string</a>." );
            }
        } else {
            if (($suites_enc eq 'all')
@@ -274,10 +250,10 @@ if (!@Packages::CGI::fatal_errors && !@results) {
            
            unless ($subword) {
                $printed++;
-               hint( "You have searched only for words exactly matching your keywords. You can try to search <a href=\"$thisscript?subword=1&amp;searchon=$searchon&amp;suite=$suites_param&amp;case=$case&amp;section=$sections_param&amp;keywords=$keyword_esc&amp;arch=$archs_param\">allowing subword matching</a>." );
+               hint( "You have searched only for words exactly matching your keywords. You can try to search <a href=\"$SEARCH_CGI?subword=1&amp;searchon=$searchon&amp;suite=$suites_param&amp;case=$case&amp;section=$sections_param&amp;keywords=$keyword_esc&amp;arch=$archs_param\">allowing subword matching</a>." );
            }
        }
-       hint( ( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$Packages::HTML::SEARCH_PAGE#search_packages\">Packages search page</a>." );
+       hint( ( $printed ? "Or you" : "You" )." can try a different search on the <a href=\"$SEARCH_PAGE#search_packages\">Packages search page</a>." );
            
     }
 }
index e4e897c970bf4cf2a18dfb79f31fb1ea2b43438e..53d0f7be63c670c56bc15a8135d00cfeae20ba4b 100755 (executable)
@@ -22,6 +22,8 @@ use DB_File;
 use Benchmark;
 
 use Deb::Versions;
+use Packages::Config qw( $DBDIR $ROOT @SUITES @ARCHIVES @SECTIONS
+                        @ARCHITECTURES %FTP_SITES );
 use Packages::CGI;
 use Packages::Search qw( :all );
 use Packages::HTML;
@@ -48,43 +50,9 @@ $debug = 0 if !defined($debug) || $debug !~ /^\d+$/o;
 $Packages::CGI::debug = $debug;
 
 # read the configuration
-our $config_read_time ||= 0;
 our $db_read_time ||= 0;
-our ( $topdir, $ROOT, @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES,
-      %FTP_SITES );
-
-# FIXME: move to own module
-my $modtime = (stat( "../config.sh" ))[9];
-if ($modtime > $config_read_time) {
-    if (!open (C, '<', "../config.sh")) {
-       error( "Internal: Cannot open configuration file." );
-    }
-    while (<C>) {
-       next if /^\s*\#/o;
-       chomp;
-       $topdir = $1 if /^\s*topdir="?([^\"]*)"?\s*$/o;
-       $ROOT = $1 if /^\s*root="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::HOME = $1 if /^\s*home="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::SEARCH_CGI = $1 if /^\s*searchcgi="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::SEARCH_PAGE = $1 if /^\s*searchpage="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::WEBMASTER_MAIL = $1 if /^\s*webmaster="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::CONTACT_MAIL = $1 if /^\s*contact="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::BUG_URL = $1 if /^\s*bug_url="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::SRC_BUG_URL = $1 if /^\s*src_bug_url="?([^\"]*)"?\s*$/o;
-       $Packages::HTML::QA_URL = $1 if /^\s*qa_url="?([^\"]*)"?\s*$/o;
-       $FTP_SITES{us} = $1 if /^\s*ftpsite="?([^\"]*)"?\s*$/o;
-       $FTP_SITES{$1} = $2 if /^\s*(\w+)_ftpsite="?([^\"]*)"?\s*$/o;
-       @SUITES = split(/\s+/, $1) if /^\s*suites="?([^\"]*)"?\s*$/o;
-       @SECTIONS = split(/\s+/, $1) if /^\s*sections="?([^\"]*)"?\s*$/o;
-       @ARCHIVES = split(/\s+/, $1) if /^\s*archives="?([^\"]*)"?\s*$/o;
-       @ARCHITECTURES = split(/\s+/, $1) if /^\s*architectures="?([^\"]*)"?\s*$/o;
-    }
-    close (C);
-    debug( "read config ($modtime > $config_read_time)" );
-    $config_read_time = $modtime;
-}
-my $DBDIR = $topdir . "/files/db";
-my $thisscript = $Packages::HTML::SEARCH_CGI;
+
+&Packages::Config::init( '../' );
 
 if (my $path = $input->param('path')) {
     my @components = map { lc $_ } split /\//, $path;
@@ -107,22 +75,26 @@ if (my $path = $input->param('path')) {
     }
 }
 
-my ( $pkg, $suite, $format );
+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)] } },
+                  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 }
                   );
 my %opts;
 my %params = Packages::Search::parse_params( $input, \%params_def, \%opts );
 
-$opts{h_suites} =   { $suite => 1 };
-$opts{h_archs} =    { map { $_ => 1 } @ARCHITECTURES };
-$opts{h_sections} = { map { $_ => 1 } @SECTIONS };
-$opts{h_archives} = { map { $_ => 1 } @ARCHIVES };
-
 #XXX: Don't use alternative output formats yet
 $format = 'html';
 if ($format eq 'html') {
@@ -131,14 +103,20 @@ if ($format eq 'html') {
 
 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";
-my $DDPO_URL = "http://qa.debian.org/developer.php?email=";
 
 our (%packages, %packages_all, %sources_all, %descriptions);
 my (@results, @non_results);
@@ -151,16 +129,16 @@ sub gettext { return $_[0]; };
 my $st0 = new Benchmark;
 unless (@Packages::CGI::fatal_errors) {
     my $dbmodtime = (stat("$DBDIR/packages_small.db"))[9];
+    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: $!";
     if ($dbmodtime > $db_read_time) {
        tie %packages, 'DB_File', "$DBDIR/packages_small.db",
        O_RDONLY, 0666, $DB_BTREE
            or die "couldn't tie DB $DBDIR/packages_small.db: $!";
-       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: $!";
        tie %descriptions, 'DB_File', "$DBDIR/descriptions.db",
        O_RDONLY, 0666, $DB_BTREE
            or die "couldn't tie DB $DBDIR/descriptions.db: $!";
@@ -239,15 +217,26 @@ unless (@Packages::CGI::fatal_errors) {
 #          $long_desc = conv_desc( $lang, $long_desc );
 #          $short_desc = conv_desc( $lang, $short_desc );
 
-           my %all_suites = map { $_->[2] => 1 } (@results, @non_results);
+           my %all_suites;
+           foreach (@results, @non_results) {
+               my $a = $_->[1];
+               my $s = $_->[2];
+               if ($a =~ /^(?:us|security)$/o) {
+                   $all_suites{$s}++;
+               } else {
+                   $all_suites{"$s/$a"}++;
+               }
+           }
            foreach (suites_sort(keys %all_suites)) {
-               if ($suite eq $_) {
+               if (("$suite/$archive" eq $_)
+                   || (!$all_suites{"$suite/$archive"} && ($suite eq $_))) {
                    $package_page .= "[ <strong>$_</strong> ] ";
                } else {
                    $package_page .=
-                       "[ <a href=\"../$_/".uri_escape($pkg)."\">$_</a> ] ";
+                       "[ <a href=\"$ROOT/$_/".uri_escape($pkg)."\">$_</a> ] ";
                }
            }
+           $package_page .= '<br>';
 
            $package_page .= simple_menu( [ gettext( "Distribution:" ),
                                            gettext( "Overview over this suite" ),
@@ -359,6 +348,7 @@ unless (@Packages::CGI::fatal_errors) {
            # more information
            #
            $package_page .= pmoreinfo( name => $pkg, data => $page,
+                                       opts => \%opts,
                                        env => \%FTP_SITES,
                                        bugreports => 1, sourcedownload => 1,
                                        changesandcopy => 1, maintainers => 1,
index f6e9e03bf95a1601f08c8cdd6e0626c4a03329b3..40c890d2432dfc2d675c2e626a8d338533189f3c 100644 (file)
    ScriptAlias /cgi-old /org/packages.debian.net/cgi-bin/
 
    RewriteEngine on
+   RewriteLog /var/log/apache/rewrite.log
+   RewriteLogLevel 0
 
    # we never want to rewrite those URLs
    RewriteRule ^/cgi-(bin|old)/ - [L]
 
    RewriteCond %{SCRIPT_FILENAME} "!-f"
    RewriteCond %{SCRIPT_FILENAME} "!-d"
-   RewriteRule ^/([^/]+)$ http://packages.debian.net/cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$1 [R,L,NE]
+   RewriteRule ^/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$1 [PT]
 
    RewriteCond %{SCRIPT_FILENAME} "!-f"
    RewriteCond %{SCRIPT_FILENAME} "!-d"
-   RewriteRule ^/(.+)/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$2&path=$1 [PT]
+   RewriteRule ^/search/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$1 [PT]
+
+   RewriteCond %{SCRIPT_FILENAME} "!-f"
+   RewriteCond %{SCRIPT_FILENAME} "!-d"
+   RewriteRule ^/search/(.+)/([^/]+)$ /cgi-bin/search_packages.pl?searchon=names&version=all&exact=1&keywords=$2&path=$1 [PT]
+
+   RewriteCond %{SCRIPT_FILENAME} "!-f"
+   RewriteCond %{SCRIPT_FILENAME} "!-d"
+   RewriteRule ^/(.+)/([^/]+)$ /cgi-bin/show_package.pl?searchon=names&version=all&exact=1&package=$2&path=$1 [PT]
 
 
 #  In case we need to disable the site again
index 2a3e945733c8724c2e102ac9342e33b3040ea9e7..8867ddb528b1305f45f8beece6fcccbde4a77f11 100644 (file)
--- a/config.sh
+++ b/config.sh
@@ -32,14 +32,17 @@ amd64_ftpsite=http://amd64.debian.net/debian
 kfreebsd_ftpsite=http://kfreebsd-gnu.debian.net/debian
 
 root=""
-searchpage="http://packages.debian.net/"
-searchcgi="/cgi-bin/search_packages.pl"
+search_page="http://packages.debian.net/"
+search_cgi="/cgi-bin/search_packages.pl"
+search_url="/search/"
+search_src_url="/search/source/"
 webmaster=webmaster@debian.org
 contact=debian-www@lists.debian.org
 home="http://www.debian.org"
 bug_url="http://bugs.debian.org/"
 src_bug_url="http://bugs.debian.org/src:"
 qa_url="http://packages.qa.debian.org/"
+ddpo_url="http://qa.debian.org/developer.php?email="
 
 # Architectures
 #
index dbd5ba85c816bd018cfcd5846f150f8b328ccc9a..984cbfb0b5ddb1775f2cc05055db9d2e6b38ab67 100644 (file)
@@ -64,6 +64,7 @@ package Deb::Versions;
 
 use strict;
 use Exporter;
+use Carp qw(cluck);
 
 our @ISA = qw( Exporter );
 our @EXPORT = qw( version_cmp version_sort suites_cmp suites_sort );
@@ -79,7 +80,7 @@ sub version_cmp {
        ( $e1, $u1, $d1 ) = ( $1, $2, $3 );
        $e1 ||= 0;
     } else {
-       warn "This seems not to be a valid version number:"
+       cluck "This seems not to be a valid version number:"
            . "<$ver1>\n";
        return -1;
     }
@@ -87,7 +88,7 @@ sub version_cmp {
         ( $e2, $u2, $d2 ) = ( $1, $2, $3 );
        $e2 ||= 0;
     } else {
-        warn "This seems not to be a valid version number:"
+        cluck "This seems not to be a valid version number:"
             . "<$ver2>\n";
         return 1;
     }
@@ -156,11 +157,25 @@ our @SUITES_SORT = qw( woody oldstable sarge stable stable-proposed-updates
                       etch testing testing-proposed-updates sid unstable
                       experimental warty hoary hoary-backports breezy
                       breezy-backports dapper );
-my $i = 100;
-our %suites_sort = map { $_ => $i-- } @SUITES_SORT;
+our @ARCHIVE_SORT = qw( security updates volatile backports );
+my $i = 1000;
+our %suites_sort = map { $_ => ($i-=10) } @SUITES_SORT;
+$i = 0;
+our %archive_sort = map { $_ => $i++ } @ARCHIVE_SORT;
 
 sub suites_cmp {
-    return ($suites_sort{$_[0]} <=> $suites_sort{$_[1]});
+    my ($s_a, $s_b) = @_;
+    my $cmp_a = $suites_sort{$s_a};
+    unless ($cmp_a) {
+       $cmp_a = $suites_sort{$1} - $archive_sort{$2}
+       if $s_a =~ m;^(.+?)[/-](.*)$;o;
+    }
+    my $cmp_b = $suites_sort{$s_b};
+    unless ($cmp_b) {
+       $cmp_b = $suites_sort{$1} - $archive_sort{$2}
+       if $s_b =~ m;^(.+?)[/-](.*)$;o;
+    }
+    return ($cmp_a <=> $cmp_b);
 }
 
 sub suites_sort {
diff --git a/lib/Packages/Config.pm b/lib/Packages/Config.pm
new file mode 100644 (file)
index 0000000..d2efe2f
--- /dev/null
@@ -0,0 +1,66 @@
+package Packages::Config;
+
+use strict;
+use warnings;
+
+use Exporter;
+use Packages::CGI;
+
+our @ISA = qw( Exporter );
+
+our ( $TOPDIR, $DBDIR, $ROOT, $HOME, $CONTACT_MAIL, $WEBMASTER_MAIL,
+      $SEARCH_PAGE, $SEARCH_CGI, $SEARCH_URL,
+      $SRC_SEARCH_URL, $CONTENTS_SEARCH_CGI,
+      $CN_HELP_URL, $BUG_URL, $SRC_BUG_URL, $QA_URL, $DDPO_URL,
+      @SUITES, @SECTIONS, @ARCHIVES, @ARCHITECTURES,
+      %FTP_SITES );
+our @EXPORT_OK = qw( $TOPDIR $DBDIR $ROOT $HOME $CONTACT_MAIL
+                    $WEBMASTER_MAIL
+                    $SEARCH_PAGE $SEARCH_CGI $SEARCH_URL
+                    $SRC_SEARCH_URL $CONTENTS_SEARCH_CGI
+                    $CN_HELP_URL $BUG_URL $SRC_BUG_URL $QA_URL $DDPO_URL
+                    @SUITES @SECTIONS @ARCHIVES @ARCHITECTURES
+                    %FTP_SITES  );
+our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
+
+our $config_read_time;
+
+sub init {
+    my ($dir) = @_;
+    my $modtime = (stat( "$dir/config.sh" ))[9];
+    $config_read_time ||= 0;
+    if ($modtime > $config_read_time) {
+       if (!open (C, '<', "$dir/config.sh")) {
+           error( "Internal: Cannot open configuration file." );
+       }
+       while (<C>) {
+           next if /^\s*\#/o;
+           chomp;
+           $TOPDIR = $1 if /^\s*topdir="?([^\"]*)"?\s*$/o;
+           $ROOT = $1 if /^\s*root="?([^\"]*)"?\s*$/o;
+           $HOME = $1 if /^\s*home="?([^\"]*)"?\s*$/o;
+           $SEARCH_CGI = $1 if /^\s*search_cgi="?([^\"]*)"?\s*$/o;
+           $SEARCH_PAGE = $1 if /^\s*search_page="?([^\"]*)"?\s*$/o;
+           $SEARCH_URL = $1 if /^\s*search_url="?([^\"]*)"?\s*$/o;
+           $SRC_SEARCH_URL = $1 if /^\s*search_src_url="?([^\"]*)"?\s*$/o;
+           $WEBMASTER_MAIL = $1 if /^\s*webmaster="?([^\"]*)"?\s*$/o;
+           $CONTACT_MAIL = $1 if /^\s*contact="?([^\"]*)"?\s*$/o;
+           $BUG_URL = $1 if /^\s*bug_url="?([^\"]*)"?\s*$/o;
+           $SRC_BUG_URL = $1 if /^\s*src_bug_url="?([^\"]*)"?\s*$/o;
+           $QA_URL = $1 if /^\s*qa_url="?([^\"]*)"?\s*$/o;
+           $DDPO_URL = $1 if /^\s*ddpo_url="?([^\"]*)"?\s*$/o;
+           $FTP_SITES{us} = $1 if /^\s*ftpsite="?([^\"]*)"?\s*$/o;
+           $FTP_SITES{$1} = $2 if /^\s*(\w+)_ftpsite="?([^\"]*)"?\s*$/o;
+           @SUITES = split(/\s+/, $1) if /^\s*suites="?([^\"]*)"?\s*$/o;
+           @SECTIONS = split(/\s+/, $1) if /^\s*sections="?([^\"]*)"?\s*$/o;
+           @ARCHIVES = split(/\s+/, $1) if /^\s*archives="?([^\"]*)"?\s*$/o;
+           @ARCHITECTURES = split(/\s+/, $1) if /^\s*architectures="?([^\"]*)"?\s*$/o;
+       }
+       close (C);
+       debug( "read config ($modtime > $config_read_time)" );
+       $config_read_time = $modtime;
+    }
+    $DBDIR = "$TOPDIR/files/db";
+}
+
+1;
index da024339886679c74eca96bbf8df1a1a1bf9f470..826461a0e944cb035a3a074c44802fd6373116a0 100644 (file)
@@ -8,6 +8,7 @@ use HTML::Entities;
 
 use Packages::CGI;
 use Packages::Search qw( read_entry_simple );
+use Packages::Config qw( :all );
 
 #use Packages::Util;
 #use Packages::I18N::Locale;
@@ -25,10 +26,6 @@ our @EXPORT = qw( header title trailer file_changed time_stamp
                  ds_begin ds_item ds_end note title marker pdesc
                  pdeplegend pkg_list pmoreinfo print_deps );
 
-our ( $HOME, $ROOT, $CONTACT_MAIL, $WEBMASTER_MAIL,
-      $SEARCH_PAGE, $SEARCH_CGI, $SEARCH_URL,
-      $SRC_SEARCH_URL, $CONTENTS_SEARCH_CGI,
-      $CN_HELP_URL, $BUG_URL, $SRC_BUG_URL, $QA_URL );
 our $CHANGELOG_URL = '/changelogs';
 
 sub img {
@@ -120,6 +117,7 @@ sub pmoreinfo {
     
     my $name = $info{name} or return;
     my $env = $info{env} or return;
+    my $opts = $info{opts} or return;
     my $page = $info{data} or return;
     my $is_source = $info{is_source};
 
@@ -139,8 +137,11 @@ sub pmoreinfo {
     my $src_dir = $page->get_src('directory');
     if ($info{sourcedownload}) {
        my $files = $page->get_src( 'files' );
+       my $path = (@{$opts->{archive}} >1) ?
+           $opts->{suite} :
+           "$opts->{suite}/$opts->{archive}[0]";
        $str .= gettext( "Source Package:" );
-       $str .= " <a href=\"../source/$source\">$source</a>, ".
+       $str .= " <a href=\"/$path/source/$source\">$source</a>, ".
            gettext( "Download" ).":\n";
 
        unless (@$files) {
@@ -287,7 +288,7 @@ sub print_deps {
            my @results;
            my %short_descs;
            my $short_desc = $short_descs{$p_name} ||
-               (read_entry_simple( $packages, $p_name, $opts->{suite}))->[-1];
+               (read_entry_simple( $packages, $p_name, $opts->{h_archives}, $opts->{suite}))->[-1];
            if ( $short_desc ) {
                if ( $is_old_pkgs ) {
                    push @res_pkgs, dep_item( "/$opts->{suite}/$p_name",
index bc7fdc03f4faf54d4815ae6755ed5201af91818c..550b9894763f3114d95a9f8277504615fbd18155 100644 (file)
@@ -33,8 +33,8 @@ sub merge_data {
     my ($self, $pkg, $version, $architecture, $data) = @_;
 
     my %data = ( package => $pkg,
-                    version => $version,
-                    architecture => $architecture );
+                version => $version,
+                architecture => $architecture );
     chomp($data);
     while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
        my ($key, $value) = ($1, $2);
@@ -68,7 +68,8 @@ sub add_src_data {
 
     chomp($data);
     my %data = ();
-    while ($data =~ /^(\S+):\s*(.*)\s*$/mg) {
+    $data =~ s/\n\s+/\377/g;
+    while ($data =~ /^(\S+):\s*(.*)\s*$/mog) {
        my ($key, $value) = ($1, $2);
        $key =~ tr [A-Z] [a-z];
        $data{$key} = $value;
@@ -77,9 +78,9 @@ sub add_src_data {
     $self->{src}{name} = $src;
     $self->{src}{version} = $version;
     if ($data{files}) {
-       $data{files} =~ s/\A\s*//o; # remove leading spaces
        $self->{src}{files} = [];
-        foreach my $sf ( split( /\n\s*/, $data{files} ) ) {
+        foreach my $sf ( split( /\377/, $data{files} ) ) {
+           next unless $sf;
             # md5, size, name
             push @{$self->{src}{files}}, [ split( /\s+/, $sf) ];
         }
@@ -148,7 +149,7 @@ sub merge_package {
     if (!$self->{versions}{$data->{architecture}}
        || $is_newest
        || (version_cmp( $data->{version},
-                        $self->{versions}{$data->{architecture}} ) > 0)) {
+                        $self->{versions}{$data->{architecture}}{version} ) > 0)) {
        foreach my $key (@STORE_ALL) {
            $self->{versions}{$data->{architecture}}{$key}
            = $data->{$key};
index a7a76d072bc69a9038a5d95db4eb6c9741455ba6..b545dbc5fa544c77bb07a59e1a247903c29e3fa6 100644 (file)
@@ -361,16 +361,23 @@ sub read_entry {
     read_entry_all( $hash, $key, $results, \@non_results, $opts );
 }
 sub read_entry_simple {
-    my ($hash, $key, $suite) = @_;
+    my ($hash, $key, $archives, $suite) = @_;
     my $result = $hash->{$key} || '';
+    my @data_fuzzy;
     foreach (split /\000/o, $result) {
        my @data = split ( /\s/o, $_, 8 );
        debug( "Considering entry ".join( ':', @data), 2);
        if ($data[1] eq $suite) {
-           debug( "Using entry ".join( ':', @data), 2);
-           return \@data;
-       }
+           if ($archives->{$data[0]}) {
+               debug( "Using entry ".join( ':', @data), 2);
+               return \@data;
+           } elsif ($data[0] eq 'us') {
+               debug( "Fuzzy entry ".join( ':', @data), 2);
+               @data_fuzzy = @data;
+           }
+       } 
     }
+    return \@data_fuzzy;
 }
 sub read_src_entry {
     my ($hash, $key, $results, $opts) = @_;