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