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