src/Modules/Debian.pl

   1 #
   2 #   Debian.pl: Frontend to debian contents and packages files
   3 #      Author: dms
   4 #     Version: v0.7b (20000527)
   5 #     Created: 20000106
   6 #
   7
   8 package Debian;
   9
  10 use strict;
  11
  12 # format: "alias=real".
  13 my $defaultdist = "woody";
  14 my %dists       = (
  15         "unstable"      => "woody",
  16         "frozen"        => "potato",
  17         "stable"        => "slink",
  18         "incoming"      => "incoming",
  19 );
  20
  21 my %urlcontents = (
  22         "debian/Contents-##DIST-i386.gz" =>
  23                 "ftp://ftp.us.debian.org".
  24                 "/debian/dists/##DIST/Contents-i386.gz",
  25
  26         "debian/Contents-##DIST-i386-non-US.gz" =>
  27                 "ftp://non-us.debian.org".
  28                 "/debian-non-US/dists/##DIST/non-US/Contents-i386.gz",
  29 );
  30
  31 my %urlpackages = (
  32         "debian/Packages-##DIST-main-i386.gz" =>
  33                 "ftp://ftp.us.debian.org".
  34                 "/debian/dists/##DIST/main/binary-i386/Packages.gz",
  35         "debian/Packages-##DIST-contrib-i386.gz" =>
  36                 "ftp://ftp.us.debian.org".
  37                 "/debian/dists/##DIST/contrib/binary-i386/Packages.gz",
  38         "debian/Packages-##DIST-non-free-i386.gz" =>
  39                 "ftp://ftp.us.debian.org".
  40                 "/debian/dists/##DIST/non-free/binary-i386/Packages.gz",
  41         "debian/Packages-##DIST-non-US-i386.gz" =>
  42                 "ftp://non-us.debian.org".
  43                 "/debian-non-US/dists/##DIST/non-US/binary-i386/Packages.gz",
  44 );
  45
  46 #####################
  47 ### COMMON FUNCTION....
  48 #######################
  49
  50 ####
  51 # Usage: &DebianDownload(%hash);
  52 sub DebianDownload {
  53     my ($dist, %urls)   = @_;
  54     my $refresh = $main::param{'debianRefreshInterval'} * 60 * 60 * 24;
  55     my $bad     = 0;
  56     my $good    = 0;
  57
  58     &main::status("Debian: Downloading files for '$dist'.");
  59
  60     if (! -d "debian/") {
  61         &main::status("Debian: creating debian dir.");
  62         mkdir("debian/",0755);
  63     }
  64
  65     %urls = &fixNonUS($dist, %urls);
  66
  67     # fe dists.
  68     # Download the files.
  69     my $file;
  70     foreach $file (keys %urls) {
  71         my $url = $urls{$file};
  72         $url  =~ s/##DIST/$dist/g;
  73         $file =~ s/##DIST/$dist/g;
  74         my $update = 0;
  75
  76         if ( -f $file) {
  77             my $last_refresh = (stat($file))[9];
  78             $update++ if (time() - $last_refresh > $refresh);
  79         } else {
  80             &main::DEBUG("Debian: local '$file' does not exist.");
  81             $update++;
  82         }
  83
  84         next unless ($update);
  85
  86         if ($good + $bad == 0) {
  87             &main::msg($main::who, "Updating debian files... please wait.");
  88         }
  89
  90         if (exists $main::debian{$url}) {
  91             &main::DEBUG("2: ".(time - $main::debian{$url})." <= $refresh");
  92             next if (time() - $main::debian{$url} <= $refresh);
  93             &main::DEBUG("stale for url $url; updating!");
  94         }
  95
  96         if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
  97             my ($host,$path,$thisfile) = ($1,$2,$3);
  98
  99             # error internally to ftp.
 100             # hope it doesn't do anything bad.
 101             if (!&main::ftpGet($host,$path,$thisfile,$file)) {
 102                 &main::DEBUG("deb: down: ftpGet: bad.");
 103                 $bad++;
 104                 next;
 105             }
 106
 107             if (! -f $file) {
 108                 &main::DEBUG("deb: down: ftpGet: !file");
 109                 $bad++;
 110                 next;
 111             }
 112
 113             &main::DEBUG("deb: download: good.");
 114             $good++;
 115         } else {
 116             &main::ERROR("Debian: invalid format of url => ($url).");
 117             $bad++;
 118             next;
 119         }
 120     }
 121
 122     if ($good) {
 123         &generateIndex($dist);
 124         return 1;
 125     } else {
 126         return -1 unless ($bad);        # no download.
 127         &main::DEBUG("DD: !good and bad($bad). :(");
 128         return 0;
 129     }
 130 }
 131
 132 ###########################
 133 # DEBIAN CONTENTS SEARCH FUNCTIONS.
 134 ########
 135
 136 ####
 137 # Usage: &searchContents($query);
 138 sub searchContents {
 139     my ($dist, $query)  = &getDistroFromStr($_[0]);
 140     &main::status("Debian: Contents search for '$query' on $dist.");
 141     my $dccsend = 0;
 142
 143     $dccsend++          if ($query =~ s/^dcc\s+//i);
 144     ### larne's regex.
 145     # $query = $query.'(\.so\.)?([.[[:digit:]]+\.]+)?$';
 146
 147     $query =~ s/\\([\^\$])/$1/g;
 148     $query =~ s/^\s+|\s+$//g;
 149     $query =~ s/\*/\\S*/g;              # does it even work?
 150
 151     if (!&main::validExec($query)) {
 152         &main::msg($main::who, "search string looks fuzzy.");
 153         return;
 154     }
 155
 156     if ($dist eq "incoming") {          # nothing yet.
 157         &main::DEBUG("sC: dist = 'incoming'. no contents yet.");
 158         return;
 159     } else {
 160         my %urls = &fixDist($dist, %urlcontents);
 161         # download contents file.
 162         &main::DEBUG("deb: download 1.");
 163         if (!&DebianDownload($dist, %urls)) {
 164             &main::WARN("Debian: could not download files.");
 165         }
 166     }
 167
 168     # start of search.
 169     my $start_time = &main::gettimeofday();
 170
 171     my $found = 0;
 172     my %contents;
 173     my $search = "$query.*\[ \t]";
 174     foreach (keys %urlcontents) {
 175         next unless ( -f $_);
 176         push(@files,$_);
 177     }
 178
 179     if (!scalar @files) {
 180         &main::ERROR("sC: no files?");
 181         &main::msg($main::who, "failed.");
 182         return;
 183     }
 184
 185     my $files = join(' ', @files);
 186     $files =~ s/##DIST/$dist/g;
 187
 188     open(IN,"zegrep -h '$search' $files |");
 189     while (<IN>) {
 190         if (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/) {
 191             my ($file,$package) = ("/".$1,$2);
 192             if ($query =~ /\//) {
 193                 next unless ($file =~ /\Q$query\E/);
 194             } else {
 195                 my ($basename) = $file =~ /^.*\/(.*)$/;
 196                 next unless ($basename =~ /\Q$query\E/);
 197             }
 198             next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//);
 199
 200             $contents{$package}{$file} = 1;
 201             $found++;
 202         }
 203     }
 204     close IN;
 205
 206     my $pkg;
 207
 208     ### send results with dcc.
 209     if ($dccsend) {
 210         if (exists $main::dcc{'SEND'}{$main::who}) {
 211             &main::msg($main::who, "DCC already active!");
 212             return;
 213         }
 214
 215         if (!scalar %contents) {
 216             &main::msg($main::who,"search returned no results.");
 217             return;
 218         }
 219
 220         if (! -d "Temp/") {
 221             mkdir("Temp",0755);
 222         }
 223
 224         my $file = "temp/$main::who.txt";
 225         if (!open(OUT,">$file")) {
 226             &main::ERROR("Debian: cannot write file for dcc send.");
 227             return;
 228         }
 229
 230         foreach $pkg (keys %contents) {
 231             foreach (keys %{$contents{$pkg}}) {
 232                 # TODO: correct padding.
 233                 print OUT "$_\t\t\t$pkg\n";
 234             }
 235         }
 236         close OUT;
 237
 238         &main::shmWrite($main::shm, "DCC SEND $main::who $file");
 239
 240         return;
 241     }
 242
 243     &main::status("Debian: $found results.");
 244
 245     my @list;
 246     foreach $pkg (keys %contents) {
 247         my @tmplist = &main::fixFileList(keys %{$contents{$pkg}});
 248         my @sublist = sort { length $a <=> length $b } @tmplist;
 249
 250         pop @sublist while (scalar @sublist > 3);
 251
 252         $pkg =~ s/\,/\037\,\037/g;      # underline ','.
 253         push(@list, "(". join(', ',@sublist) .") in $pkg");
 254     }
 255     # sort the total list from shortest to longest...
 256     @list = sort { length $a <=> length $b } @list;
 257
 258     # show how long it took.
 259     my $delta_time = &main::gettimeofday() - $start_time;
 260     &main::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
 261
 262     my $prefix = "Debian Search of '$query' ";
 263     &main::performStrictReply( &main::formListReply(0, $prefix, @list) );
 264 }
 265
 266 ####
 267 # Usage: &searchAuthor($query);
 268 sub searchAuthor {
 269     my ($dist, $query)  = &getDistroFromStr($_[0]);
 270     &main::DEBUG("searchAuthor: dist => '$dist', query => '$query'.");
 271     $query =~ s/^\s+|\s+$//g;
 272
 273     # start of search.
 274     my $start_time = &main::gettimeofday();
 275     &main::status("Debian: starting author search.");
 276
 277     my $files;
 278     my ($bad,$good) = (0,0);
 279     my %urls = %urlpackages;
 280     ### potato now has the "new" non-US tree like woody does.
 281     if ($dist =~ /^(woody|potato)$/) {
 282         %urls = &fixNonUS($dist, %urlpackages);
 283     }
 284
 285     foreach (keys %urlpackages) {
 286         s/##DIST/$dist/g;
 287
 288         if (! -f $_) {
 289             $bad++;
 290             next;
 291         }
 292
 293         $good++;
 294         $files .= " ".$_;
 295     }
 296
 297     &main::DEBUG("good = $good, bad = $bad...");
 298
 299     if ($good == 0 and $bad != 0) {
 300         my %urls = &fixDist($dist, %urlpackages);
 301         &main::DEBUG("deb: download 2.");
 302         if (!&DebianDownload($dist, %urls)) {
 303             &main::ERROR("Debian(sA): could not download files.");
 304             return;
 305         }
 306     }
 307
 308     my (%maint, %pkg, $package);
 309     open(IN,"zegrep -h '^Package|^Maintainer' $files |");
 310     while (<IN>) {
 311         if (/^Package: (\S+)$/) {
 312             $package = $1;
 313         } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
 314             $maint{$1}{$2} = 1;
 315             $pkg{$1}{$package} = 1;
 316         } else {
 317             &main::WARN("invalid line: '$_'.");
 318         }
 319     }
 320     close IN;
 321
 322     my %hash;
 323     # TODO: can we use 'map' here?
 324     foreach (grep /\Q$query\E/i, keys %maint) {
 325         $hash{$_} = 1;
 326     }
 327
 328     # TODO: should we only search email if '@' is used?
 329     if (scalar keys %hash < 15) {
 330         my $name;
 331         foreach $name (keys %maint) {
 332             my $email;
 333             foreach $email (keys %{$maint{$name}}) {
 334                 next unless ($email =~ /\Q$query\E/i);
 335                 next if (exists $hash{$name});
 336                 $hash{$name} = 1;
 337             }
 338         }
 339     }
 340
 341     my @list = keys %hash;
 342     if (scalar @list != 1) {
 343         my $prefix = "Debian Author Search of '$query' ";
 344         &main::performStrictReply( &main::formListReply(0, $prefix, @list) );
 345         return 1;
 346     }
 347
 348     &main::DEBUG("showing all packages by '$list[0]'...");
 349
 350     my @pkg = sort keys %{$pkg{$list[0]}};
 351
 352     # show how long it took.
 353     my $delta_time = &main::gettimeofday() - $start_time;
 354     &main::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
 355
 356     my $email   = join(', ', keys %{$maint{$list[0]}});
 357     my $prefix  = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
 358     &main::performStrictReply( &main::formListReply(0, $prefix, @pkg) );
 359 }
 360
 361 ####
 362 # Usage: &generateIncoming();
 363 sub generateIncoming {
 364     my $interval = $main::param{'debianRefreshInterval'};
 365     my $pkgfile  = "debian/Packages-incoming";
 366     my $idxfile  = $pkgfile.".idx";
 367     my $stale    = 0;
 368     $stale++ if (&main::isStale($pkgfile.".gz", $interval));
 369     $stale++ if (&main::isStale($idxfile.".gz", $interval));
 370     &main::DEBUG("gI: stale => '$stale'.");
 371     return 0 unless ($stale);
 372
 373     ### STATIC URL.
 374     my %ftp = &main::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/");
 375
 376     if (!open(PKG,">$pkgfile")) {
 377         &main::ERROR("cannot write to pkg $pkgfile.");
 378         return 0;
 379     }
 380     if (!open(IDX,">$idxfile")) {
 381         &main::ERROR("cannot write to idx $idxfile.");
 382         return 0;
 383     }
 384
 385     print IDX "*$pkgfile.gz\n";
 386     my $file;
 387     foreach $file (sort keys %ftp) {
 388         next unless ($file =~ /deb$/);
 389
 390         if ($file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/) {
 391             print IDX "$1\n";
 392             print PKG "Package: $1\n";
 393             print PKG "Version: $2\n";
 394             print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n";
 395         }
 396         print PKG "Filename: $file\n";
 397         print PKG "Size: $ftp{$file}\n";
 398         print PKG "\n";
 399     }
 400     close IDX;
 401     close PKG;
 402
 403     system("gzip -9fv $pkgfile");       # lame fix.
 404
 405     &main::status("Debian: generateIncoming() complete.");
 406 }
 407
 408
 409 ##############################
 410 # DEBIAN PACKAGE INFO FUNCTIONS.
 411 #########
 412
 413 # Usage: &getPackageInfo($query,$file);
 414 sub getPackageInfo {
 415     my ($package, $file) = @_;
 416
 417     if (! -f $file) {
 418         &main::status("gPI: file $file does not exist?");
 419         return 'NULL';
 420     }
 421
 422     my $found = 0;
 423     my (%pkg, $pkg);
 424
 425     open(IN, "zcat $file 2>&1 |");
 426
 427     my $done = 0;
 428     while (!eof IN) {
 429         $_ = <IN>;
 430
 431         next if (/^ \S+/);      # package long description.
 432
 433         # package line.
 434         if (/^Package: (.*)\n$/) {
 435             $pkg = $1;
 436             if ($pkg =~ /^$package$/i) {
 437                 $found++;       # we can use pkg{'package'} instead.
 438                 $pkg{'package'} = $pkg;
 439             }
 440
 441             next;
 442         }
 443
 444         if ($found) {
 445             chop;
 446
 447             if (/^Version: (.*)$/) {
 448                 $pkg{'version'}         = $1;
 449             } elsif (/^Priority: (.*)$/) {
 450                 $pkg{'priority'}        = $1;
 451             } elsif (/^Section: (.*)$/) {
 452                 $pkg{'section'}         = $1;
 453             } elsif (/^Size: (.*)$/) {
 454                 $pkg{'size'}            = $1;
 455             } elsif (/^i.*size: (.*)$/) {
 456                 $pkg{'installed'}       = $1;
 457             } elsif (/^Description: (.*)$/) {
 458                 $pkg{'desc'}            = $1;
 459             } elsif (/^Filename: (.*)$/) {
 460                 $pkg{'find'}            = $1;
 461             } elsif (/^Pre-Depends: (.*)$/) {
 462                 $pkg{'depends'}         = "pre-depends on $1";
 463             } elsif (/^Depends: (.*)$/) {
 464                 if (exists $pkg{'depends'}) {
 465                     $pkg{'depends'} .= "; depends on $1";
 466                 } else {
 467                     $pkg{'depends'} = "depends on $1";
 468                 }
 469             } elsif (/^Maintainer: (.*)$/) {
 470                 $pkg{'maint'} = $1;
 471             } elsif (/^Provides: (.*)$/) {
 472                 $pkg{'provides'} = $1;
 473             } elsif (/^Suggests: (.*)$/) {
 474                 $pkg{'suggests'} = $1;
 475             } elsif (/^Conflicts: (.*)$/) {
 476                 $pkg{'conflicts'} = $1;
 477             }
 478
 479 ###         &main::DEBUG("=> '$_'.");
 480         }
 481
 482         # blank line.
 483         if (/^$/) {
 484             undef $pkg;
 485             last if ($found);
 486             next;
 487         }
 488
 489         next if (defined $pkg);
 490     }
 491
 492     close IN;
 493
 494     %pkg;
 495 }
 496
 497 # Usage: &infoPackages($query,$package);
 498 sub infoPackages {
 499     my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1]));
 500     my $interval = $main::param{'debianRefreshInterval'} || 7;
 501
 502     &main::status("Debian: Searching for package '$package' in '$dist'.");
 503
 504     # download packages file.
 505     # hrm...
 506     my %urls = &fixDist($dist, %urlpackages);
 507     if ($dist ne "incoming") {
 508         &main::DEBUG("deb: download 3.");
 509         if (!&DebianDownload($dist, %urls)) {   # no good download.
 510             &main::WARN("Debian(iP): could not download ANY files.");
 511         }
 512     }
 513
 514     # check if the package is valid.
 515     my $incoming = 0;
 516     my @files = &validPackage($package, $dist);
 517     if (!scalar @files) {
 518         &main::status("Debian: no valid package found; checking incoming.");
 519         @files = &validPackage($package, "incoming");
 520         if (scalar @files) {
 521             &main::status("Debian: cool, it exists in incoming.");
 522             $incoming++;
 523         } else {
 524             &main::msg($main::who, "Package '$package' does not exist.");
 525             return 0;
 526         }
 527     }
 528
 529     if (scalar @files > 1) {
 530         &main::WARN("same package in more than one file; random.");
 531         &main::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
 532         $files[0] = &main::getRandom(@files);
 533     }
 534
 535     if (! -f $files[0]) {
 536         &main::WARN("files[0] ($files[0]) doesn't exist.");
 537         &main::msg($main::who, "WARNING: $files[0] does not exist? FIXME");
 538         return 'NULL';
 539     }
 540
 541     ### TODO: if specific package is requested, note down that a version
 542     ###         exists in incoming.
 543
 544     my $found = 0;
 545     my $file = $files[0];
 546     my ($pkg);
 547
 548     ### TODO: use fe, dump to a hash. if only one version of the package
 549     ###         exists. do as normal otherwise list all versions.
 550     if (! -f $file) {
 551         &main::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
 552         return 0;
 553     }
 554     my %pkg = &getPackageInfo($package, $file);
 555
 556     # 'fm'-like output.
 557     if ($query eq "info") {
 558         if (scalar keys %pkg > 5) {
 559             $pkg{'info'}  = "\002(\002". $pkg{'desc'} ."\002)\002";
 560             $pkg{'info'} .= ", section ".$pkg{'section'};
 561             $pkg{'info'} .= ", is ".$pkg{'priority'};
 562             $pkg{'info'} .= ". Version: \002$pkg{'version'}\002";
 563             $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
 564             $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
 565
 566             if ($incoming) {
 567                 &main::status("iP: info requested and pkg is in incoming, too.");
 568                 my %incpkg = &getPackageInfo($query, "debian/Packages-incoming");
 569
 570                 if (scalar keys %incpkg) {
 571                    $pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
 572                 } else {
 573                     &main::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
 574                 }
 575             }
 576         } else {
 577             &main::DEBUG("running debianCheck() due to problems (".scalar(keys %pkg).").");
 578             &debianCheck();
 579             &main::DEBUG("end of debianCheck()");
 580
 581             &main::msg($main::who,"Debian: Package appears to exist but I could not retrieve info about it...");
 582             return;
 583         }
 584     }
 585
 586     if ($dist eq "incoming") {
 587         $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
 588         $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
 589         $pkg{'info'} .= ", is in incoming!!!";
 590     }
 591
 592     if (!exists $pkg{$query}) {
 593         if ($query eq "suggests") {
 594             $pkg{$query} = "has no suggestions";
 595         } elsif ($query eq "conflicts") {
 596             $pkg{$query} = "does not conflict with any other package";
 597         } elsif ($query eq "depends") {
 598             $pkg{$query} = "does not depend on anything";
 599         } elsif ($query eq "maint") {
 600             $pkg{$query} = "has no maintainer";
 601         } else {
 602             $pkg{$query} = "has nothing about $query";
 603         }
 604     }
 605
 606     &main::performStrictReply("$package: $pkg{$query}");
 607 }
 608
 609 # Usage: &infoStats($dist);
 610 sub infoStats {
 611     my ($dist)  = @_;
 612     $dist       = &getDistro($dist);
 613     return unless (defined $dist);
 614
 615     &main::DEBUG("infoS: dist => '$dist'.");
 616     my $interval = $main::param{'debianRefreshInterval'} || 7;
 617
 618     # download packages file if needed.
 619     my %urls = &fixDist($dist, %urlpackages);
 620     &main::DEBUG("deb: download 4.");
 621     if (!&DebianDownload($dist, %urls)) {
 622         &main::WARN("Debian(iS): could not download ANY files.");
 623         &main::msg($main::who, "Debian(iS): internal error.");
 624         return;
 625     }
 626
 627     my %stats;
 628     my %total;
 629     my $file;
 630     foreach $file (keys %urlpackages) {
 631         $file =~ s/##DIST/$dist/g;      # won't work for incoming.
 632         &main::DEBUG("file => '$file'.");
 633         if (exists $stats{$file}{'count'}) {
 634             &main::DEBUG("hrm... duplicate open with $file???");
 635             next;
 636         }
 637
 638         open(IN,"zcat $file 2>&1 |");
 639
 640         if (! -e $file) {
 641             &main::DEBUG("iS: $file does not exist.");
 642             next;
 643         }
 644
 645         while (!eof IN) {
 646             $_ = <IN>;
 647
 648             next if (/^ \S+/);  # package long description.
 649
 650             if (/^Package: (.*)\n$/) {          # counter.
 651                 $stats{$file}{'count'}++;
 652                 $total{'count'}++;
 653             } elsif (/^Maintainer: .* <(\S+)>$/) {
 654                 $stats{$file}{'maint'}{$1}++;
 655                 $total{'maint'}{$1}++;
 656             } elsif (/^Size: (.*)$/) {          # compressed size.
 657                 $stats{$file}{'csize'}  += $1;
 658                 $total{'csize'}         += $1;
 659             } elsif (/^i.*size: (.*)$/) {       # installed size.
 660                 $stats{$file}{'isize'}  += $1;
 661                 $total{'isize'}         += $1;
 662             }
 663
 664 ###         &main::DEBUG("=> '$_'.");
 665         }
 666         close IN;
 667     }
 668
 669     &main::performStrictReply(
 670         "Debian Distro Stats on $dist... ".
 671         "\002$total{'count'}\002 packages, ".
 672         "\002".scalar(keys %{$total{'maint'}})."\002 maintainers, ".
 673         "\002". int($total{'isize'}/1024)."\002 MB installed size, ".
 674         "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size."
 675     );
 676
 677 ### TODO: do individual stats? if so, we need _another_ arg.
 678 #    foreach $file (keys %stats) {
 679 #       foreach (keys %{$stats{$file}}) {
 680 #           &main::DEBUG("  '$file' '$_' '$stats{$file}{$_}'.");
 681 #       }
 682 #    }
 683
 684     return;
 685 }
 686
 687
 688
 689 ###
 690 # HELPER FUNCTIONS FOR INFOPACKAGES...
 691 ###
 692
 693 # Usage: &generateIndex();
 694 sub generateIndex {
 695     my (@dists) = @_;
 696     &main::DEBUG("Debian: generateIndex() called.");
 697     if (!scalar @dists) {
 698         &main::ERROR("gI: no dists to generate index.");
 699         return 1;
 700     }
 701
 702     foreach (@dists) {
 703         my $dist = &getDistro($_); # incase the alias is returned, possible?
 704         my $idx  = "debian/Packages-$dist.idx";
 705
 706         # TODO: check if any of the Packages file have been updated then
 707         #       regenerate it, even if it's not stale.
 708         # TODO: also, regenerate the index if the packages file is newer
 709         #       than the index.
 710         next unless (&main::isStale($idx, $main::param{'debianRefreshInterval'}));
 711         if (/^incoming$/i) {
 712             &main::DEBUG("gIndex: calling generateIncoming()!");
 713             &generateIncoming();
 714             next;
 715         }
 716
 717         &main::DEBUG("gIndeX: calling DebianDownload($dist, ...).");
 718         &DebianDownload($dist, %urlpackages);
 719
 720         &main::status("Debian: generating index for '$_'.");
 721         if (!open(OUT,">$idx")) {
 722             &main::ERROR("cannot write to $idx.");
 723             return 0;
 724         }
 725
 726         my $packages;
 727         foreach $packages (keys %urlpackages) {
 728             $packages =~ s/##DIST/$dist/;
 729
 730             if (! -e $packages) {
 731                 &main::ERROR("gIndex: '$packages' does not exist?");
 732                 next;
 733             }
 734
 735             print OUT "*$packages\n";
 736             open(IN,"zcat $packages |");
 737
 738             while (<IN>) {
 739                 if (/^Package: (.*)\n$/) {
 740                     print OUT $1."\n";
 741                 }
 742             }
 743             close IN;
 744         }
 745         close OUT;
 746     }
 747
 748     return 1;
 749 }
 750
 751 # Usage: &validPackage($package, $dist);
 752 sub validPackage {
 753     my ($package,$dist) = @_;
 754     my @files;
 755     my $file;
 756
 757     &main::DEBUG("D: validPackage($package, $dist) called.");
 758
 759     my $error = 0;
 760     while (!open(IN, "debian/Packages-$dist.idx")) {
 761         if ($error) {
 762             &main::ERROR("Packages-$dist.idx does not exist (#1).");
 763             return;
 764         }
 765
 766         &generateIndex($dist);
 767
 768         $error++;
 769     }
 770
 771     my $count = 0;
 772     while (<IN>) {
 773         if (/^\*(.*)\n$/) {
 774             $file = $1;
 775             next;
 776         }
 777
 778         if (/^$package\n$/) {
 779             push(@files,$file);
 780         }
 781         $count++;
 782     }
 783     close IN;
 784
 785     &main::DEBUG("vP: scanned $count items in index.");
 786
 787     return @files;
 788 }
 789
 790 sub searchPackage {
 791     my ($dist, $query) = &getDistroFromStr($_[0]);
 792     my $file = "debian/Packages-$dist.idx";
 793     my @files;
 794     my $error = 0;
 795
 796     &main::status("Debian: Search package matching '$query' in '$dist'.");
 797     if ( -z $file) {
 798         &main::DEBUG("sP: $file == NULL; removing, redoing.");
 799         unlink $file;
 800     }
 801
 802     while (!open(IN, $file)) {
 803         &main::ERROR("$file does not exist (#2).");
 804         if ($dist eq "incoming") {
 805             &main::DEBUG("sP: dist == incoming; calling gI().");
 806             &generateIncoming();
 807         }
 808
 809         if ($error) {
 810             &main::ERROR("could not generate index!!!");
 811             return;
 812         }
 813         $error++;
 814         &generateIndex(($dist));
 815     }
 816
 817     while (<IN>) {
 818         chop;
 819
 820         if (/^\*(.*)$/) {
 821             &main::DEBUG("sP: hrm => '$1'.");
 822
 823             if (&main::isStale($file, $main::param{'debianRefreshInterval'})) {
 824                 &main::DEBUG("STALE $file! regen.");
 825                 &generateIndex(($dist));
 826 ###             @files = searchPackage("$query $dist");
 827                 &main::DEBUG("EVIL HACK HACK HACK.");
 828                 last;
 829             }
 830
 831             $file = $1;
 832             next;
 833         }
 834
 835         if (/\Q$query\E/) {
 836             push(@files,$_);
 837         }
 838     }
 839     close IN;
 840
 841     return @files;
 842 }
 843
 844 sub getDistro {
 845     my $dist = $_[0];
 846
 847     if (!defined $dist or $dist eq "") {
 848         &main::DEBUG("gD: dist == NULL; dist = defaultdist.");
 849         $dist = $defaultdist;
 850     }
 851
 852     if (exists $dists{$dist}) {
 853         return $dists{$dist};
 854     } else {
 855         if (!grep /^\Q$dist\E$/i, %dists) {
 856             &main::msg($main::who, "invalid dist '$dist'.");
 857             return;
 858         }
 859
 860         return $dist;
 861     }
 862 }
 863
 864 sub getDistroFromStr {
 865     my ($str) = @_;
 866     my $dists   = join '|', %dists;
 867     my $dist    = $defaultdist;
 868
 869     if ($str =~ s/\s+($dists)$//i) {
 870         $dist = &getDistro(lc $1);
 871         $str =~ s/\\+$//;
 872     }
 873     $str =~ s/\\([\$\^])/$1/g;
 874
 875     return($dist,$str);
 876 }
 877
 878 sub fixDist {
 879     my ($dist, %urls) = @_;
 880     my %new;
 881     my ($key,$val);
 882
 883     while (($key,$val) = each %urls) {
 884         $key =~ s/##DIST/$dist/;
 885         $val =~ s/##DIST/$dist/;
 886         ### TODO: what should we do if the sar wasn't done.
 887         $new{$key} = $val;
 888     }
 889     return %new;
 890 }
 891
 892 sub DebianFind {
 893     ### H-H-H-HACK HACK HACK :)
 894     my ($str) = @_;
 895     my ($dist, $query) = &getDistroFromStr($str);
 896     my @results = sort &searchPackage($str);
 897
 898     if (!scalar @results) {
 899         &main::Forker("debian", sub { &searchContents($str); } );
 900     } elsif (scalar @results == 1) {
 901         &main::status("searchPackage returned one result; getting info of package instead!");
 902         &main::Forker("debian", sub { &infoPackages("info", "$results[0] $dist"); } );
 903     } else {
 904         my $prefix = "Debian Package Listing of '$str' ";
 905         &main::performStrictReply( &main::formListReply(0, $prefix, @results) );
 906     }
 907 }
 908
 909 ### TODO: move DWH to &fixDist() or leave it being called by DD?
 910 sub fixNonUS {
 911     my ($dist, %urls) = @_;
 912
 913     foreach (keys %urls) {
 914         last unless ($dist =~ /^(woody|potato)$/);
 915         next unless (/non-US/);
 916         &main::DEBUG("DD: Enabling hack(??) for $dist non-US.");
 917
 918         my $file = $_;
 919         my $url  = $urls{$_};
 920         delete $urls{$file};    # heh.
 921
 922         foreach ("main","contrib","non-free") {
 923             my ($newfile,$newurl) = ($file,$url);
 924             # only needed for Packages for now, not Contents; good.
 925             $newfile =~ s/non-US/non-US_$_/;
 926             $newurl =~ s#non-US/bin#non-US/$_/bin#;
 927             $urls{$newfile} = $newurl;
 928         }
 929
 930         &main::DEBUG("DD: Files: ".scalar(keys %urls));
 931         last;
 932     }
 933
 934     %urls;
 935 }
 936
 937 sub debianCheck {
 938     my $dir     = "debian/";
 939     my $error   = 0;
 940
 941     &main::status("debianCheck() called.");
 942
 943     ### TODO: remove the following loop (check if dir exists before)
 944     while (1) {
 945         last if (opendir(DEBIAN, $dir));
 946         if ($error) {
 947             &main::ERROR("dC: cannot opendir debian.");
 948             return;
 949         }
 950         mkdir $dir, 0755;
 951         $error++;
 952     }
 953
 954     my $retval = 0;
 955     my $file;
 956     while (defined($file = readdir DEBIAN)) {
 957         next unless ($file =~ /(gz|bz2)$/);
 958
 959         my $exit = system("gzip -t '$dir/$file'");
 960         next unless ($exit);
 961         &main::DEBUG("hmr... => ".(time() - (stat($file))[8])."'.");
 962         next unless (time() - (stat($file))[8] > 3600);
 963
 964         &main::DEBUG("dC: exit => '$exit'.");
 965         &main::WARN("dC: '$dir/$file' corrupted? deleting!");
 966         unlink $dir."/".$file;
 967         $retval++;
 968     }
 969
 970     return $retval;
 971 }
 972
 973 1;