2 # Debian.pl: Frontend to debian contents and packages files
4 # Version: v0.8 (20000918)
9 # XXX Add uploader field support
14 no strict 'refs'; # FIXME: dstats aborts if set
17 my $defaultdist = 'sid';
18 my $refresh = &::getChanConfDefault('debianRefreshInterval', 7, $::chan) * 60 * 60 * 24;
20 my $debian_dir = $::bot_state_dir . 'debian';
21 my $country = 'us'; # well .config it yourself then. ;-)
22 my $protocol = 'http';
24 # format: "alias=real".
29 'experimental' => 'experimental',
30 'oldstable' => 'woody',
31 'incoming' => 'incoming',
35 my %archived_dists = (
38 # oldstable => 'woody',
46 my %archiveurlcontents = (
47 "Contents-##DIST-i386.gz" =>
48 "$protocol://debian.crosslink.net/debian-archive".
49 "/dists/##DIST/Contents-i386.gz",
52 my %archiveurlpackages = (
53 "Packages-##DIST-main-i386.gz" =>
54 "$protocol://debian.crosslink.net/debian-archive".
55 "/dists/##DIST/main/binary-i386/Packages.gz",
56 "Packages-##DIST-contrib-i386.gz" =>
57 "$protocol://debian.crosslink.net/debian-archive".
58 "/dists/##DIST/contrib/binary-i386/Packages.gz",
59 "Packages-##DIST-non-free-i386.gz" =>
60 "$protocol://debian.crosslink.net/debian-archive".
61 "/dists/##DIST/non-free/binary-i386/Packages.gz",
68 "Contents-##DIST-i386.gz" =>
69 "$protocol://debian.usc.edu".
70 "/dists/##DIST/Contents-i386.gz",
71 "Contents-##DIST-i386-non-US.gz" =>
72 "$protocol://non-us.debian.org".
73 "/debian-non-US/dists/##DIST/non-US/Contents-i386.gz",
77 "Packages-##DIST-main-i386.gz" =>
78 "$protocol://debian.usc.edu".
79 "/dists/##DIST/main/binary-i386/Packages.gz",
80 "Packages-##DIST-contrib-i386.gz" =>
81 "$protocol://debian.usc.edu".
82 "/dists/##DIST/contrib/binary-i386/Packages.gz",
83 "Packages-##DIST-non-free-i386.gz" =>
84 "$protocol://debian.usc.edu".
85 "/dists/##DIST/non-free/binary-i386/Packages.gz",
87 # "Packages-##DIST-non-US-main-i386.gz" =>
88 # "$protocol://non-us.debian.org".
89 # "/debian-non-US/dists/##DIST/non-US/main/binary-i386/Packages.gz",
90 # "Packages-##DIST-non-US-contrib-i386.gz" =>
91 # "$protocol://non-us.debian.org".
92 # "/debian-non-US/dists/##DIST/non-US/contrib/binary-i386/Packages.gz",
93 # "Packages-##DIST-non-US-non-free-i386.gz" =>
94 # "$protocol://non-us.debian.org".
95 # "/debian-non-US/dists/##DIST/non-US/non-free/binary-i386/Packages.gz",
99 ### COMMON FUNCTION....
100 #######################
103 # Usage: &DebianDownload($dist, %hash);
105 my ($dist, %urls) = @_;
109 if (! -d $debian_dir) {
110 &::status("Debian: creating debian dir.");
111 mkdir($debian_dir, 0755);
115 # Download the files.
117 foreach $file (keys %urls) {
118 my $url = $urls{$file};
119 $url =~ s/##DIST/$dist/g;
120 $file =~ s/##DIST/$dist/g;
124 my $last_refresh = (stat $file)[9];
125 $update++ if (time() - $last_refresh > $refresh);
130 next unless ($update);
132 &::DEBUG("announce == $announce.") if ($debug);
133 if ($good + $bad == 0 and !$announce) {
134 &::status("Debian: Downloading files for '$dist'.");
135 &::msg($::who, "Updating debian files... please wait.");
139 if (exists $::debian{$url}) {
140 &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug);
141 next if (time() - $::debian{$url} <= $refresh);
142 &::DEBUG("stale for url $url; updating!") if ($debug);
145 if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
146 my ($host,$path,$thisfile) = ($1,$2,$3);
148 if (!&::ftpGet($host,$path,$thisfile,$file)) {
149 &::WARN("deb: down: $file == BAD.");
154 } elsif ($url =~ /^http:\/\/\S+\/\S+$/) {
156 if (!&::getURLAsFile($url,$file)) {
157 &::WARN("deb: down: http: $file == BAD.");
163 &::ERROR("Debian: invalid format of url => ($url).");
169 &::WARN("deb: down: http: !file");
174 # my $exit = system("/bin/gzip -t $file");
176 # &::WARN("deb: $file is corrupted ($exit) :/");
181 &::DEBUG("deb: download: good.") if ($debug);
185 # ok... lets just run this.
186 &::miscCheck() if (&::whatInterface() =~ /IRC/);
189 &generateIndex($dist);
192 return -1 unless ($bad); # no download.
193 &::DEBUG("DD: !good and bad($bad). :(");
198 ###########################
199 # DEBIAN CONTENTS SEARCH FUNCTIONS.
203 # Usage: &searchContents($query);
205 my ($dist, $query) = &getDistroFromStr($_[0]);
206 &::status("Debian: Contents search for '$query' in '$dist'.");
209 $dccsend++ if ($query =~ s/^dcc\s+//i);
211 $query =~ s/\\([\^\$])/$1/g; # hrm?
212 $query =~ s/^\s+|\s+$//g;
214 if (!&::validExec($query)) {
215 &::msg($::who, 'search string looks fuzzy.');
219 my %urls = fixDist($dist,'contents');
220 if ($dist eq 'incoming') { # nothing yet.
221 &::DEBUG('sC: dist = "incoming". no contents yet.');
224 # download contents file.
225 &::DEBUG('deb: download 1.') if ($debug);
226 if (!&DebianDownload($dist, %urls)) {
227 &::WARN('Debian: could not download files.');
232 my $start_time = &::timeget();
238 ### TODO: search properly if /usr/bin/blah is done.
239 if ($query =~ s/\$$//) {
240 &::DEBUG("deb: search-regex found.") if ($debug);
241 $grepRE = "$query\[ \t]";
242 } elsif ($query =~ s/^\^//) {
243 &::DEBUG("deb: front marker regex found.") if ($debug);
247 $grepRE = "$query*\[ \t]";
250 # fix up grepRE for "*".
251 $grepRE =~ s/\*/.*/g;
254 foreach (keys %urls) {
255 next unless ( -f $_ );
259 if (!scalar @files) {
260 &::ERROR("sC: no files?");
261 &::msg($::who, "failed.");
265 my $files = join(' ', @files);
268 $regex =~ s/\./\\./g;
269 $regex =~ s/\*/\\S*/g;
272 open(IN,"zegrep -h '$grepRE' $files |");
273 # wonderful abuse of if, last, next, return, and, unless ;)
275 last if ($found > 100);
277 next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/);
278 my ($file,$package) = ("/".$1,$2);
280 if ($query =~ /[\/\*\\]/) {
281 next unless (eval { $file =~ /$regex/ });
282 return unless &checkEval($@);
284 my ($basename) = $file =~ /^.*\/(.*)$/;
285 next unless (eval { $basename =~ /$regex/ });
286 return unless &checkEval($@);
288 next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//);
289 next if ($front and eval { $file !~ /^\/$query/ });
290 return unless &checkEval($@);
292 $contents{$package}{$file} = 1;
299 ### send results with dcc.
301 if (exists $::dcc{'SEND'}{$::who}) {
302 &::msg($::who, "DCC already active!");
306 if (!scalar %contents) {
307 &::msg($::who,"search returned no results.");
311 my $file = "$::param{tempDir}/$::who.txt";
312 if (!open OUT, ">$file") {
313 &::ERROR("Debian: cannot write file for dcc send.");
317 foreach $pkg (keys %contents) {
318 foreach (keys %{ $contents{$pkg} }) {
319 # TODO: correct padding.
320 print OUT "$_\t\t\t$pkg\n";
325 &::shmWrite($::shm, "DCC SEND $::who $file");
330 &::status("Debian: $found contents results found.");
333 foreach $pkg (keys %contents) {
334 my @tmplist = &::fixFileList(keys %{ $contents{$pkg} });
335 my @sublist = sort { length $a <=> length $b } @tmplist;
337 pop @sublist while (scalar @sublist > 3);
339 $pkg =~ s/\,/\037\,\037/g; # underline ','.
340 push(@list, "(". join(', ',@sublist) .") in $pkg");
342 # sort the total list from shortest to longest...
343 @list = sort { length $a <=> length $b } @list;
345 # show how long it took.
346 my $delta_time = &::timedelta($start_time);
347 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
349 my $prefix = "Debian Search of '$query' ";
350 if (scalar @list) { # @list.
351 &::performStrictReply( &::formListReply(0, $prefix, @list) );
356 &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug);
357 @list = &searchDesc($query);
360 my $prefix = "Debian Package/File/Desc Search of '$query' ";
361 &::performStrictReply( &::formListReply(0, $prefix, ) );
363 } elsif (scalar @list == 1) { # list = 1.
364 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
365 &infoPackages("info", $list[0]);
368 my $prefix = "Debian Desc Search of '$query' ";
369 &::performStrictReply( &::formListReply(0, $prefix, @list) );
374 # Usage: &searchAuthor($query);
376 my ($dist, $query) = &getDistroFromStr($_[0]);
377 &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug);
378 $query =~ s/^\s+|\s+$//g;
381 my $start_time = &::timeget();
382 &::status("Debian: starting author search.");
384 my %urls = fixDist($dist,'packages');
386 my ($bad,$good) = (0,0);
387 foreach (keys %urls) {
397 &::DEBUG("deb: good = $good, bad = $bad...") if ($debug);
399 if ($good == 0 and $bad != 0) {
400 &::DEBUG("deb: download 2.");
402 if (!&DebianDownload($dist, %urls)) {
403 &::ERROR("Debian(sA): could not download files.");
408 my (%maint, %pkg, $package);
409 open(IN,"zegrep -h '^Package|^Maintainer' $files |");
411 if (/^Package: (\S+)$/) {
414 } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
415 my($name,$email) = ($1,$2);
416 if ($package eq "") {
417 &::DEBUG("deb: sA: package == NULL.");
420 $maint{$name}{$email} = 1;
421 $pkg{$name}{$package} = 1;
426 &::WARN("debian: invalid line: '$_' (1).");
432 # TODO: can we use 'map' here?
433 foreach (grep /\Q$query\E/i, keys %maint) {
437 # TODO: should we only search email if '@' is used?
438 if (scalar keys %hash < 15) {
441 foreach $name (keys %maint) {
444 foreach $email (keys %{ $maint{$name} }) {
445 next unless ($email =~ /\Q$query\E/i);
446 next if (exists $hash{$name});
452 my @list = keys %hash;
453 if (scalar @list != 1) {
454 my $prefix = "Debian Author Search of '$query' ";
455 &::performStrictReply( &::formListReply(0, $prefix, @list) );
459 &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug);
461 my @pkg = sort keys %{ $pkg{$list[0]} };
463 # show how long it took.
464 my $delta_time = &::timedelta($start_time);
465 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
467 my $email = join(', ', keys %{ $maint{$list[0]} });
468 my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
469 &::performStrictReply( &::formListReply(0, $prefix, @pkg) );
473 # Usage: &searchDesc($query);
475 my ($dist, $query) = &getDistroFromStr($_[0]);
476 &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.") if ($debug);
477 $query =~ s/^\s+|\s+$//g;
480 my $start_time = &::timeget();
481 &::status("Debian: starting desc search.");
484 my ($bad,$good) = (0,0);
485 my %urls = fixDist($dist,'packages');
487 # XXX This should be abstracted elsewhere.
488 foreach (keys %urls) {
498 &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug);
500 if ($good == 0 and $bad != 0) {
501 &::DEBUG("deb: download 2c.") if ($debug);
503 if (!&DebianDownload($dist, %urls)) {
504 &::ERROR("deb: sD: could not download files.");
510 $regex =~ s/\./\\./g;
511 $regex =~ s/\*/\\S*/g;
514 my (%desc, $package);
515 open(IN,"zegrep -h '^Package|^Description' $files |");
517 if (/^Package: (\S+)$/) {
519 } elsif (/^Description: (.*)$/) {
521 next unless (eval { $desc =~ /$regex/i });
522 return unless &checkEval($@);
524 if ($package eq "") {
525 &::WARN("sD: package == NULL?");
529 $desc{$package} = $desc;
534 &::WARN("debian: invalid line: '$_'. (2)");
539 # show how long it took.
540 my $delta_time = &::timedelta($start_time);
541 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
547 # Usage: &generateIncoming();
548 sub generateIncoming {
549 my $pkgfile = $debian_dir."/Packages-incoming";
550 my $idxfile = $pkgfile.".idx";
552 $stale++ if (&::isStale($pkgfile.".gz", $refresh));
553 $stale++ if (&::isStale($idxfile, $refresh));
554 &::DEBUG("deb: gI: stale => '$stale'.") if ($debug);
555 return 0 unless ($stale);
558 my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/");
560 if (!open PKG, ">$pkgfile") {
561 &::ERROR("cannot write to pkg $pkgfile.");
564 if (!open IDX, ">$idxfile") {
565 &::ERROR("cannot write to idx $idxfile.");
569 print IDX "*$pkgfile.gz\n";
571 foreach $file (sort keys %ftp) {
572 next unless ($file =~ /deb$/);
574 if ($file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/) {
576 print PKG "Package: $1\n";
577 print PKG "Version: $2\n";
578 print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n";
580 print PKG "Filename: $file\n";
581 print PKG "Size: $ftp{$file}\n";
587 system("gzip -9fv $pkgfile"); # lame fix.
589 &::status("Debian: generateIncoming() complete.");
593 ##############################
594 # DEBIAN PACKAGE INFO FUNCTIONS.
597 # Usage: &getPackageInfo($query,$file);
599 my ($package, $file) = @_;
602 &::status("gPI: file $file does not exist?");
609 open(IN, "/bin/zcat $file 2>&1 |");
615 next if (/^ \S+/); # package long description.
618 if (/^Package: (.*)\n$/) {
620 if ($pkg =~ /^\Q$package\E$/i) {
621 $found++; # we can use pkg{'package'} instead.
622 $pkg{'package'} = $pkg;
631 if (/^Version: (.*)$/) {
632 $pkg{'version'} = $1;
633 } elsif (/^Priority: (.*)$/) {
634 $pkg{'priority'} = $1;
635 } elsif (/^Section: (.*)$/) {
636 $pkg{'section'} = $1;
637 } elsif (/^Size: (.*)$/) {
639 } elsif (/^Installed-Size: (.*)$/i) {
640 $pkg{'installed'} = $1;
641 } elsif (/^Description: (.*)$/) {
643 } elsif (/^Filename: (.*)$/) {
645 } elsif (/^Pre-Depends: (.*)$/) {
646 $pkg{'depends'} = "pre-depends on $1";
647 } elsif (/^Depends: (.*)$/) {
648 if (exists $pkg{'depends'}) {
649 $pkg{'depends'} .= "; depends on $1";
651 $pkg{'depends'} = "depends on $1";
653 } elsif (/^Maintainer: (.*)$/) {
655 } elsif (/^Provides: (.*)$/) {
656 $pkg{'provides'} = $1;
657 } elsif (/^Suggests: (.*)$/) {
658 $pkg{'suggests'} = $1;
659 } elsif (/^Conflicts: (.*)$/) {
660 $pkg{'conflicts'} = $1;
663 ### &::DEBUG("=> '$_'.");
673 next if (defined $pkg);
681 # Usage: &infoPackages($query,$package);
683 my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1]));
685 &::status("Debian: Searching for package '$package' in '$dist'.");
687 # download packages file.
689 my %urls = &fixDist($dist,'packages');
690 if ($dist ne "incoming") {
691 &::DEBUG("deb: download 3.") if ($debug);
693 if (!&DebianDownload($dist, %urls)) { # no good download.
694 &::WARN("Debian(iP): could not download ANY files.");
698 # check if the package is valid.
700 my @files = &validPackage($package, $dist);
701 if (!scalar @files) {
702 &::status("Debian: no valid package found; checking incoming.");
703 @files = &validPackage($package, "incoming");
706 &::status("Debian: cool, it exists in incoming.");
709 &::msg($::who, "Package '$package' does not exist.");
714 if (scalar @files > 1) {
715 &::WARN("same package in more than one file; random.");
716 &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
717 $files[0] = &::getRandom(@files);
720 if (! -f $files[0]) {
721 &::WARN("files[0] ($files[0]) doesn't exist.");
722 &::msg($::who, "FIXME: $files[0] does not exist?");
726 ### TODO: if specific package is requested, note down that a version
727 ### exists in incoming.
730 my $file = $files[0];
733 ### TODO: use fe, dump to a hash. if only one version of the package
734 ### exists. do as normal otherwise list all versions.
736 &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
739 my %pkg = &getPackageInfo($package, $file);
741 $query = "info" if ($query eq "dinfo");
744 if ($query eq "info") {
745 if (scalar keys %pkg <= 5) {
746 &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).").");
748 &::DEBUG("deb: end of debianCheck()");
750 &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it...");
754 $pkg{'info'} = "\002(\002". $pkg{'desc'} ."\002)\002";
755 $pkg{'info'} .= ", section ".$pkg{'section'};
756 $pkg{'info'} .= ", is ".$pkg{'priority'};
757 # $pkg{'info'} .= ". Version: \002$pkg{'version'}\002";
758 $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)";
759 $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
760 $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
763 &::status("iP: info requested and pkg is in incoming, too.");
764 my %incpkg = &getPackageInfo($query, $debian_dir ."/Packages-incoming");
766 if (scalar keys %incpkg) {
767 $pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
769 &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
774 if ($dist eq "incoming") {
775 $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
776 $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
777 $pkg{'info'} .= ", is in incoming!!!";
780 if (!exists $pkg{$query}) {
781 if ($query eq "suggests") {
782 $pkg{$query} = "has no suggestions";
783 } elsif ($query eq "conflicts") {
784 $pkg{$query} = "does not conflict with any other package";
785 } elsif ($query eq "depends") {
786 $pkg{$query} = "does not depend on anything";
787 } elsif ($query eq "maint") {
788 $pkg{$query} = "has no maintainer";
790 $pkg{$query} = "has nothing about $query";
794 &::performStrictReply("$package: $pkg{$query}");
797 # Usage: &infoStats($dist);
800 $dist = &getDistro($dist);
801 return unless (defined $dist);
803 &::DEBUG("deb: infoS: dist => '$dist'.");
805 # download packages file if needed.
806 my %urls = &fixDist($dist,'packages');
807 &::DEBUG("deb: download 4.");
808 if (!&DebianDownload($dist, %urls)) {
809 &::WARN("Debian(iS): could not download ANY files.");
810 &::msg($::who, "Debian(iS): internal error.");
815 my %total = (count => 0, maint => 0, isize => 0, csize => 0);
817 foreach $file (keys %urls) {
818 &::DEBUG("deb: file => '$file'.");
819 if (exists $stats{$file}{'count'}) {
820 &::DEBUG("deb: hrm... duplicate open with $file???");
824 open(IN, "zcat $file 2>&1 |");
827 &::DEBUG("deb: iS: $file does not exist.");
834 next if (/^ \S+/); # package long description.
836 if (/^Package: (.*)\n$/) { # counter.
837 $stats{$file}{'count'}++;
839 } elsif (/^Maintainer: .* <(\S+)>$/) {
840 $stats{$file}{'maint'}{$1}++;
841 $total{'maint'}{$1}++;
842 } elsif (/^Size: (.*)$/) { # compressed size.
843 $stats{$file}{'csize'} += $1;
844 $total{'csize'} += $1;
845 } elsif (/^i.*size: (.*)$/i) { # installed size.
846 $stats{$file}{'isize'} += $1;
847 $total{'isize'} += $1;
850 ### &::DEBUG("=> '$_'.");
855 ### TODO: don't count ppl with multiple email addresses.
857 &::performStrictReply(
858 "Debian Distro Stats on $dist... ".
859 "\002$total{'count'}\002 packages, ".
860 "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ".
861 "\002". int($total{'isize'}/1024)."\002 MB installed size, ".
862 "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size."
865 ### TODO: do individual stats? if so, we need _another_ arg.
866 # foreach $file (keys %stats) {
867 # foreach (keys %{ $stats{$file} }) {
868 # &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
876 # HELPER FUNCTIONS FOR INFOPACKAGES...
879 # Usage: &generateIndex();
882 &::DEBUG("D: generateIndex($dists[0]) called! ".join(':',caller(),));
883 if (!scalar @dists or $dists[0] eq '') {
884 &::ERROR("gI: no dists to generate index.");
889 my $dist = &getDistro($_); # incase the alias is returned, possible?
890 my $idx = $debian_dir."/Packages-$dist.idx";
891 my %urls = fixDist($_,'packages');
893 # TODO: check if any of the Packages file have been updated then
894 # regenerate it, even if it's not stale.
895 # TODO: also, regenerate the index if the packages file is newer
897 next unless (&::isStale($idx, $refresh));
900 &::DEBUG("deb: gIndex: calling generateIncoming()!");
906 # &::DEBUG("deb: Copying old index of sarge to -old");
907 # system("cp $idx $idx-old");
910 &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug);
911 &DebianDownload($dist, &fixDist($dist,'packages') );
913 &::status("Debian: generating index for '$dist'.");
914 if (!open OUT, ">$idx") {
915 &::ERROR("cannot write to $idx.");
920 foreach $packages (keys %urls) {
921 if (! -e $packages) {
922 &::ERROR("gIndex: '$packages' does not exist?");
926 print OUT "*$packages\n";
927 open(IN,"zcat $packages |");
930 next unless (/^Package: (.*)\n$/);
941 # Usage: &validPackage($package, $dist);
943 my ($package,$dist) = @_;
947 ### this majorly sucks, we need some standard in place.
948 # why is this needed... need to investigate later.
950 $dist = &getDistro($dist);
952 &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug);
955 while (!open IN, $debian_dir."/Packages-$dist.idx") {
957 &::ERROR("Packages-$dist.idx does not exist (#1).");
961 &generateIndex($dist);
973 if (/^\Q$package\E\n$/) {
980 &::VERB("vP: scanned $count items in index.",2);
986 my ($dist, $query) = &getDistroFromStr($_[0]);
987 my $file = $debian_dir."/Packages-$dist.idx";
988 my $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0;
992 &::status("Debian: Search package matching '$query' in '$dist'.");
993 unlink $file if ( -z $file );
995 while (!open IN, $file) {
996 if ($dist eq "incoming") {
997 &::DEBUG("deb: sP: dist == incoming; calling gI().");
1002 &::ERROR("could not generate index ($file)!");
1007 &::DEBUG("deb: should we be doing this?");
1008 &generateIndex(($dist));
1017 if (&::isStale($file, $refresh)) {
1018 &::DEBUG("deb: STALE $file! regen.") if ($debug);
1019 &generateIndex(($dist));
1020 ### @files = searchPackage("$query $dist");
1021 &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug);
1034 if (scalar @files and $warn) {
1035 &::msg($::who, "searching for package name should be fully lowercase!");
1044 if (!defined $dist or $dist eq "") {
1045 &::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
1046 $dist = $defaultdist;
1049 if (exists $dists{$dist}) {
1050 &::VERB("gD: returning dists{$dist} ($dists{$dist})",2);
1051 return $dists{$dist};
1054 elsif (exists $archived_dists{$dist}){
1055 &::VERB("gD: returning archivedists{$dist} ($archived_dists{$dist})",2);
1056 return $archived_dists{$dist};
1059 if (!grep(/^\Q$dist\E$/i, %dists) and !grep(/^\Q$dist\E$/i, %archived_dists)) {
1060 &::msg($::who, "invalid dist '$dist'.");
1064 &::VERB("gD: returning $dist (no change or conversion)",2);
1069 sub getDistroFromStr {
1071 my $dists = join '|', %dists, %archived_dists;
1072 my $dist = $defaultdist;
1074 if ($str =~ s/\s+($dists)$//i) {
1075 $dist = &getDistro(lc $1);
1078 $str =~ s/\\([\$\^])/$1/g;
1084 my ($dist, $type) = @_;
1089 if (exists $archived_dists{$dist}){
1090 if ($type eq 'contents'){
1091 %dist_urls = %archiveurlcontents;
1094 %dist_urls = %archiveurlpackages;
1098 if ($type eq 'contents'){
1099 %dist_urls = %urlcontents;
1102 %dist_urls = %urlpackages;
1106 while (($key,$val) = each %dist_urls) {
1107 $key =~ s/##DIST/$dist/;
1108 $val =~ s/##DIST/$dist/;
1109 ### TODO: what should we do if the sar wasn't done.
1110 $new{$debian_dir."/".$key} = $val;
1119 my ($dist, $query) = &getDistroFromStr($str);
1120 my @results = sort &searchPackage($str);
1122 if (!scalar @results) {
1123 &::Forker("Debian", sub { &searchContents($str); } );
1124 } elsif (scalar @results == 1) {
1125 &::status("searchPackage returned one result; getting info of package instead!");
1126 &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } );
1128 my $prefix = "Debian Package Listing of '$query' ";
1129 &::performStrictReply( &::formListReply(0, $prefix, @results) );
1136 &::status("debianCheck() called.");
1138 ### TODO: remove the following loop (check if dir exists before)
1140 last if (opendir(DEBIAN, $debian_dir));
1143 &::ERROR("dC: cannot opendir debian.");
1147 mkdir $debian_dir, 0755;
1153 while (defined($file = readdir DEBIAN)) {
1154 next unless ($file =~ /(gz|bz2)$/);
1156 # TODO: add bzip2 support (debian doesn't do .bz2 anyway)
1157 my $exit = system("/bin/gzip -t '$debian_dir/$file'");
1158 next unless ($exit);
1159 &::DEBUG("deb: hmr... => ".(time() - (stat($debian_dir/$file))[8])."'.");
1160 next unless (time() - (stat($file))[8] > 3600);
1162 #&::DEBUG("deb: dC: exit => '$exit'.");
1163 &::WARN("dC: '$debian_dir/$file' corrupted? deleting!");
1164 unlink $debian_dir."/".$file;
1175 &::WARN("cE: $str");
1183 # &::DEBUG("deb: FE called for searchDesc");
1185 my @list = &searchDesc($query);
1187 if (!scalar @list) {
1188 my $prefix = "Debian Desc Search of '$query' ";
1189 &::performStrictReply( &::formListReply(0, $prefix, ) );
1190 } elsif (scalar @list == 1) { # list = 1.
1191 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
1192 &infoPackages("info", $list[0]);
1193 } else { # list > 1.
1194 my $prefix = "Debian Desc Search of '$query' ";
1195 &::performStrictReply( &::formListReply(0, $prefix, @list) );