src/Modules/Debian.pl

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