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