src/Modules/Debian.pl

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