* Support archive files; deal properly with gzip files; hardcode debian.usc.edu...

git-svn-id: https://svn.code.sf.net/p/infobot/code/branches/don/dpkg@1278 c11ca15a-4712-0410-83d8-924469b57eb5

diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl
index 69c7b21c70cc5395d21cd28e43460f5ce904f103..2c22f6a63285d1f4cbbcc056f776e537cae16434 100644 (file)
--- a/src/Modules/Debian.pl
+++ b/src/Modules/Debian.pl
@@ -5,6 +5,9 @@
 #     Created: 20000106
 #
 
+
+# XXX Add uploader field support
+
 package Debian;
 
 use strict;
@@ -23,14 +26,48 @@ my %dists   = (
        'unstable'      => 'sid',
        'testing'       => 'etch',
        'stable'        => 'sarge',
+        'experimental'  => 'experimental',
        'oldstable'     => 'woody',
        'incoming'      => 'incoming',
+        woody          => 'woody',
+);
+
+my %archived_dists = (
+#    woody  => 'woody',
+    potato => 'potato',
+#    oldstable => 'woody',
+    hamm   => 'hamm',
+    buzz   => 'buzz',
+    bo     => 'bo',
+    rex    => 'rex',
+    slink  => 'slink',
+);
+
+my %archiveurlcontents = (
+       "Contents-##DIST-i386.gz" =>
+               "$protocol://debian.crosslink.net/debian-archive".
+               "/dists/##DIST/Contents-i386.gz",
 );
 
+my %archiveurlpackages = (
+       "Packages-##DIST-main-i386.gz" =>
+               "$protocol://debian.crosslink.net/debian-archive".
+               "/dists/##DIST/main/binary-i386/Packages.gz",
+       "Packages-##DIST-contrib-i386.gz" =>
+               "$protocol://debian.crosslink.net/debian-archive".
+               "/dists/##DIST/contrib/binary-i386/Packages.gz",
+       "Packages-##DIST-non-free-i386.gz" =>
+               "$protocol://debian.crosslink.net/debian-archive".
+               "/dists/##DIST/non-free/binary-i386/Packages.gz",
+);
+    
+
+
+
 my %urlcontents = (
        "Contents-##DIST-i386.gz" =>
-               "$protocol://ftp.$country.debian.org".
-               "/debian/dists/##DIST/Contents-i386.gz",
+               "$protocol://debian.usc.edu".
+               "/dists/##DIST/Contents-i386.gz",
        "Contents-##DIST-i386-non-US.gz" =>
                "$protocol://non-us.debian.org".
                "/debian-non-US/dists/##DIST/non-US/Contents-i386.gz",
@@ -38,24 +75,24 @@ my %urlcontents = (
 
 my %urlpackages = (
        "Packages-##DIST-main-i386.gz" =>
-               "$protocol://ftp.$country.debian.org".
-               "/debian/dists/##DIST/main/binary-i386/Packages.gz",
+               "$protocol://debian.usc.edu".
+               "/dists/##DIST/main/binary-i386/Packages.gz",
        "Packages-##DIST-contrib-i386.gz" =>
-               "$protocol://ftp.$country.debian.org".
-               "/debian/dists/##DIST/contrib/binary-i386/Packages.gz",
+               "$protocol://debian.usc.edu".
+               "/dists/##DIST/contrib/binary-i386/Packages.gz",
        "Packages-##DIST-non-free-i386.gz" =>
-               "$protocol://ftp.$country.debian.org".
-               "/debian/dists/##DIST/non-free/binary-i386/Packages.gz",
-
-       "Packages-##DIST-non-US-main-i386.gz" =>
-               "$protocol://non-us.debian.org".
-               "/debian-non-US/dists/##DIST/non-US/main/binary-i386/Packages.gz",
-       "Packages-##DIST-non-US-contrib-i386.gz" =>
-               "$protocol://non-us.debian.org".
-               "/debian-non-US/dists/##DIST/non-US/contrib/binary-i386/Packages.gz",
-       "Packages-##DIST-non-US-non-free-i386.gz" =>
-               "$protocol://non-us.debian.org".
-               "/debian-non-US/dists/##DIST/non-US/non-free/binary-i386/Packages.gz",
+               "$protocol://debian.usc.edu".
+               "/dists/##DIST/non-free/binary-i386/Packages.gz",
+
+#      "Packages-##DIST-non-US-main-i386.gz" =>
+#              "$protocol://non-us.debian.org".
+#              "/debian-non-US/dists/##DIST/non-US/main/binary-i386/Packages.gz",
+#      "Packages-##DIST-non-US-contrib-i386.gz" =>
+#              "$protocol://non-us.debian.org".
+#              "/debian-non-US/dists/##DIST/non-US/contrib/binary-i386/Packages.gz",
+#      "Packages-##DIST-non-US-non-free-i386.gz" =>
+#              "$protocol://non-us.debian.org".
+#              "/debian-non-US/dists/##DIST/non-US/non-free/binary-i386/Packages.gz",
 );
 
 #####################
@@ -179,11 +216,11 @@ sub searchContents {
        return;
     }
 
+    my %urls = fixDist($dist,'contents');
     if ($dist eq 'incoming') {         # nothing yet.
        &::DEBUG('sC: dist = "incoming". no contents yet.');
        return;
     } else {
-       my %urls = &fixDist($dist, %urlcontents);
        # download contents file.
        &::DEBUG('deb: download 1.') if ($debug);
        if (!&DebianDownload($dist, %urls)) {
@@ -214,11 +251,9 @@ sub searchContents {
     $grepRE =~ s/\*/.*/g;
 
     my @files;
-    foreach (keys %urlcontents) {
-       s/##DIST/$dist/g;
-
-       next unless ( -f "$debian_dir/$_" );
-       push(@files, "$debian_dir/$_");
+    foreach (keys %urls) {
+       next unless ( -f $_ );
+       push(@files, $_);
     }
 
     if (!scalar @files) {
@@ -346,14 +381,11 @@ sub searchAuthor {
     my $start_time = &::timeget();
     &::status("Debian: starting author search.");
 
+    my %urls = fixDist($dist,'packages');
     my $files;
     my ($bad,$good) = (0,0);
-    my %urls = %urlpackages;
-
-    foreach (keys %urlpackages) {
-       s/##DIST/$dist/g;
-
-       if (! -f "$debian_dir/$_" ) {
+    foreach (keys %urls) {
+       if (! -f $_ ) {
            $bad++;
            next;
        }
@@ -365,8 +397,7 @@ sub searchAuthor {
     &::DEBUG("deb: good = $good, bad = $bad...") if ($debug);
 
     if ($good == 0 and $bad != 0) {
-       my %urls = &fixDist($dist, %urlpackages);
-       &::DEBUG("deb: download 2.");
+        &::DEBUG("deb: download 2.");
 
        if (!&DebianDownload($dist, %urls)) {
            &::ERROR("Debian(sA): could not download files.");
@@ -451,24 +482,22 @@ sub searchDesc {
 
     my $files;
     my ($bad,$good) = (0,0);
-    my %urls = %urlpackages;
-
-    foreach (keys %urlpackages) {
-       s/##DIST/$dist/g;
+    my %urls = fixDist($dist,'packages');
 
-       if (! -f "$debian_dir/$_" ) {
+    # XXX This should be abstracted elsewhere.
+    foreach (keys %urls) {
+       if (! -f $_ ) {
            $bad++;
            next;
        }
 
        $good++;
-       $files .= " $debian_dir/$_";
+       $files .= " $_";
     }
 
     &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug);
 
     if ($good == 0 and $bad != 0) {
-       my %urls = &fixDist($dist, %urlpackages);
        &::DEBUG("deb: download 2c.") if ($debug);
 
        if (!&DebianDownload($dist, %urls)) {
@@ -657,7 +686,7 @@ sub infoPackages {
 
     # download packages file.
     # hrm...
-    my %urls = &fixDist($dist, %urlpackages);
+    my %urls = &fixDist($dist,'packages');
     if ($dist ne "incoming") {
        &::DEBUG("deb: download 3.") if ($debug);
 
@@ -774,7 +803,7 @@ sub infoStats {
     &::DEBUG("deb: infoS: dist => '$dist'.");
 
     # download packages file if needed.
-    my %urls = &fixDist($dist, %urlpackages);
+    my %urls = &fixDist($dist,'packages');
     &::DEBUG("deb: download 4.");
     if (!&DebianDownload($dist, %urls)) {
        &::WARN("Debian(iS): could not download ANY files.");
@@ -785,18 +814,17 @@ sub infoStats {
     my %stats;
     my %total = (count => 0, maint => 0, isize => 0, csize => 0);
     my $file;
-    foreach $file (keys %urlpackages) {
-       $file =~ s/##DIST/$dist/g;      # won't work for incoming.
+    foreach $file (keys %urls) {
        &::DEBUG("deb: file => '$file'.");
        if (exists $stats{$file}{'count'}) {
            &::DEBUG("deb: hrm... duplicate open with $file???");
            next;
        }
 
-       open(IN, "zcat $debian_dir/$file 2>&1 |");
+       open(IN, "zcat $file 2>&1 |");
 
-       if (! -e "$debian_dir/$file") {
-           &::DEBUG("deb: iS: $debian_dir/$file does not exist.");
+       if (! -e "$file") {
+           &::DEBUG("deb: iS: $file does not exist.");
            next;
        }
 
@@ -851,7 +879,7 @@ sub infoStats {
 # Usage: &generateIndex();
 sub generateIndex {
     my (@dists)        = @_;
-    &::DEBUG("D: generateIndex($dists[0]) called!");
+    &::DEBUG("D: generateIndex($dists[0]) called! ".join(':',caller(),));
     if (!scalar @dists or $dists[0] eq '') {
        &::ERROR("gI: no dists to generate index.");
        return 1;
@@ -860,6 +888,7 @@ sub generateIndex {
     foreach (@dists) {
        my $dist = &getDistro($_); # incase the alias is returned, possible?
        my $idx  = $debian_dir."/Packages-$dist.idx";
+       my %urls = fixDist($_,'packages');
 
        # TODO: check if any of the Packages file have been updated then
        #       regenerate it, even if it's not stale.
@@ -873,13 +902,13 @@ sub generateIndex {
            next;
        }
 
-       if (/^woody$/i) {
-           &::DEBUG("deb: Copying old index of woody to -old");
-           system("cp $idx $idx-old");
-       }
+#      if (/^sarge$/i) {
+#          &::DEBUG("deb: Copying old index of sarge to -old");
+#          system("cp $idx $idx-old");
+#      }
 
        &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug);
-       &DebianDownload($dist, &fixDist($dist, %urlpackages) );
+       &DebianDownload($dist, &fixDist($dist,'packages') );
 
        &::status("Debian: generating index for '$dist'.");
        if (!open OUT, ">$idx") {
@@ -888,10 +917,7 @@ sub generateIndex {
        }
 
        my $packages;
-       foreach $packages (keys %urlpackages) {
-           $packages =~ s/##DIST/$dist/;
-           $packages =  "$debian_dir/$packages";
-
+       foreach $packages (keys %urls) {
            if (! -e $packages) {
                &::ERROR("gIndex: '$packages' does not exist?");
                next;
@@ -1020,18 +1046,17 @@ sub getDistro {
        $dist = $defaultdist;
     }
 
-    if ($dist =~ /^(slink|hamm|rex|bo)$/i) {
-       &::DEBUG("deb: deprecated version ($dist).");
-       &::msg($::who, "Debian: deprecated distribution version.");
-       return;
-    }
-
     if (exists $dists{$dist}) {
        &::VERB("gD: returning dists{$dist} ($dists{$dist})",2);
        return $dists{$dist};
 
-    } else {
-       if (!grep /^\Q$dist\E$/i, %dists) {
+    }
+    elsif (exists $archived_dists{$dist}){
+       &::VERB("gD: returning archivedists{$dist} ($archived_dists{$dist})",2);
+       return $archived_dists{$dist};
+    }
+    else {
+       if (!grep(/^\Q$dist\E$/i, %dists) and !grep(/^\Q$dist\E$/i, %archived_dists)) {
            &::msg($::who, "invalid dist '$dist'.");
            return;
        }
@@ -1043,7 +1068,7 @@ sub getDistro {
 
 sub getDistroFromStr {
     my ($str) = @_;
-    my $dists  = join '|', %dists;
+    my $dists  = join '|', %dists, %archived_dists;
     my $dist   = $defaultdist;
 
     if ($str =~ s/\s+($dists)$//i) {
@@ -1056,11 +1081,29 @@ sub getDistroFromStr {
 }
 
 sub fixDist {
-    my ($dist, %urls) = @_;
+    my ($dist, $type) = @_;
     my %new;
     my ($key,$val);
-
-    while (($key,$val) = each %urls) {
+    my %dist_urls;
+    
+    if (exists $archived_dists{$dist}){
+       if ($type eq 'contents'){
+           %dist_urls = %archiveurlcontents;
+       }
+       else {
+           %dist_urls = %archiveurlpackages;
+       }  
+    }
+    else {
+       if ($type eq 'contents'){
+           %dist_urls = %urlcontents;
+       }
+       else {
+           %dist_urls = %urlpackages;
+       }
+    }
+       
+    while (($key,$val) = each %dist_urls) {
        $key =~ s/##DIST/$dist/;
        $val =~ s/##DIST/$dist/;
        ### TODO: what should we do if the sar wasn't done.
@@ -1111,9 +1154,9 @@ sub debianCheck {
        next unless ($file =~ /(gz|bz2)$/);
 
        # TODO: add bzip2 support (debian doesn't do .bz2 anyway)
-       #my $exit = system("/bin/gzip -t '$debian_dir/$file'");
-       #next unless ($exit);
-       &::DEBUG("deb: hmr... => ".(time() - (stat($file))[8])."'.");
+       my $exit = system("/bin/gzip -t '$debian_dir/$file'");
+       next unless ($exit);
+       &::DEBUG("deb: hmr... => ".(time() - (stat($debian_dir/$file))[8])."'.");
        next unless (time() - (stat($file))[8] > 3600);
 
        #&::DEBUG("deb: dC: exit => '$exit'.");