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