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