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