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' => 'sarge',
31 'incoming' => 'incoming',
34 my %archived_dists = (
44 my %archiveurlcontents = (
45 "Contents-##DIST-i386.gz" =>
46 "$protocol://debian.crosslink.net/debian-archive".
47 "/dists/##DIST/Contents-i386.gz",
50 my %archiveurlpackages = (
51 "Packages-##DIST-main-i386.gz" =>
52 "$protocol://debian.crosslink.net/debian-archive".
53 "/dists/##DIST/main/binary-i386/Packages.gz",
54 "Packages-##DIST-contrib-i386.gz" =>
55 "$protocol://debian.crosslink.net/debian-archive".
56 "/dists/##DIST/contrib/binary-i386/Packages.gz",
57 "Packages-##DIST-non-free-i386.gz" =>
58 "$protocol://debian.crosslink.net/debian-archive".
59 "/dists/##DIST/non-free/binary-i386/Packages.gz",
66 "Contents-##DIST-i386.gz" =>
67 "$protocol://debian.usc.edu".
68 "/dists/##DIST/Contents-i386.gz",
69 "Contents-##DIST-i386-non-US.gz" =>
70 "$protocol://non-us.debian.org".
71 "/debian-non-US/dists/##DIST/non-US/Contents-i386.gz",
75 "Packages-##DIST-main-i386.gz" =>
76 "$protocol://debian.usc.edu".
77 "/dists/##DIST/main/binary-i386/Packages.gz",
78 "Packages-##DIST-contrib-i386.gz" =>
79 "$protocol://debian.usc.edu".
80 "/dists/##DIST/contrib/binary-i386/Packages.gz",
81 "Packages-##DIST-non-free-i386.gz" =>
82 "$protocol://debian.usc.edu".
83 "/dists/##DIST/non-free/binary-i386/Packages.gz",
85 # "Packages-##DIST-non-US-main-i386.gz" =>
86 # "$protocol://non-us.debian.org".
87 # "/debian-non-US/dists/##DIST/non-US/main/binary-i386/Packages.gz",
88 # "Packages-##DIST-non-US-contrib-i386.gz" =>
89 # "$protocol://non-us.debian.org".
90 # "/debian-non-US/dists/##DIST/non-US/contrib/binary-i386/Packages.gz",
91 # "Packages-##DIST-non-US-non-free-i386.gz" =>
92 # "$protocol://non-us.debian.org".
93 # "/debian-non-US/dists/##DIST/non-US/non-free/binary-i386/Packages.gz",
97 ### COMMON FUNCTION....
98 #######################
101 # Usage: &DebianDownload($dist, %hash);
103 my ($dist, %urls) = @_;
107 if (! -d $debian_dir) {
108 &::status("Debian: creating debian dir.");
109 mkdir($debian_dir, 0755);
113 # Download the files.
115 foreach $file (keys %urls) {
116 my $url = $urls{$file};
117 $url =~ s/##DIST/$dist/g;
118 $file =~ s/##DIST/$dist/g;
122 my $last_refresh = (stat $file)[9];
123 $update++ if (time() - $last_refresh > $refresh);
128 next unless ($update);
130 &::DEBUG("announce == $announce.") if ($debug);
131 if ($good + $bad == 0 and !$announce) {
132 &::status("Debian: Downloading files for '$dist'.");
133 &::msg($::who, "Updating debian files... please wait.");
137 if (exists $::debian{$url}) {
138 &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug);
139 next if (time() - $::debian{$url} <= $refresh);
140 &::DEBUG("stale for url $url; updating!") if ($debug);
143 if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
144 my ($host,$path,$thisfile) = ($1,$2,$3);
146 if (!&::ftpGet($host,$path,$thisfile,$file)) {
147 &::WARN("deb: down: $file == BAD.");
152 } elsif ($url =~ /^http:\/\/\S+\/\S+$/) {
154 if (!&::getURLAsFile($url,$file)) {
155 &::WARN("deb: down: http: $file == BAD.");
161 &::ERROR("Debian: invalid format of url => ($url).");
167 &::WARN("deb: down: http: !file");
172 # my $exit = system("/bin/gzip -t $file");
174 # &::WARN("deb: $file is corrupted ($exit) :/");
179 &::DEBUG("deb: download: good.") if ($debug);
183 # ok... lets just run this.
184 &::miscCheck() if (&::whatInterface() =~ /IRC/);
187 &generateIndex($dist);
190 return -1 unless ($bad); # no download.
191 &::DEBUG("DD: !good and bad($bad). :(");
196 ###########################
197 # DEBIAN CONTENTS SEARCH FUNCTIONS.
201 # Usage: &searchContents($query);
203 my ($dist, $query) = &getDistroFromStr($_[0]);
204 &::status("Debian: Contents search for '$query' in '$dist'.");
207 $dccsend++ if ($query =~ s/^dcc\s+//i);
209 $query =~ s/\\([\^\$])/$1/g; # hrm?
210 $query =~ s/^\s+|\s+$//g;
212 if (!&::validExec($query)) {
213 &::msg($::who, 'search string looks fuzzy.');
217 my %urls = fixDist($dist,'contents');
218 if ($dist eq 'incoming') { # nothing yet.
219 &::DEBUG('sC: dist = "incoming". no contents yet.');
222 # download contents file.
223 &::DEBUG('deb: download 1.') if ($debug);
224 if (!&DebianDownload($dist, %urls)) {
225 &::WARN('Debian: could not download files.');
230 my $start_time = &::timeget();
236 ### TODO: search properly if /usr/bin/blah is done.
237 if ($query =~ s/\$$//) {
238 &::DEBUG("deb: search-regex found.") if ($debug);
239 $grepRE = "$query\[ \t]";
240 } elsif ($query =~ s/^\^//) {
241 &::DEBUG("deb: front marker regex found.") if ($debug);
245 $grepRE = "$query*\[ \t]";
248 # fix up grepRE for "*".
249 $grepRE =~ s/\*/.*/g;
252 foreach (keys %urls) {
253 next unless ( -f $_ );
257 if (!scalar @files) {
258 &::ERROR("sC: no files?");
259 &::msg($::who, "failed.");
263 my $files = join(' ', @files);
266 $regex =~ s/\./\\./g;
267 $regex =~ s/\*/\\S*/g;
270 open(IN,"zegrep -h '$grepRE' $files |");
271 # wonderful abuse of if, last, next, return, and, unless ;)
273 last if ($found > 100);
275 next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/);
276 my ($file,$package) = ("/".$1,$2);
278 if ($query =~ /[\/\*\\]/) {
279 next unless (eval { $file =~ /$regex/ });
280 return unless &checkEval($@);
282 my ($basename) = $file =~ /^.*\/(.*)$/;
283 next unless (eval { $basename =~ /$regex/ });
284 return unless &checkEval($@);
286 next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//);
287 next if ($front and eval { $file !~ /^\/$query/ });
288 return unless &checkEval($@);
290 $contents{$package}{$file} = 1;
297 ### send results with dcc.
299 if (exists $::dcc{'SEND'}{$::who}) {
300 &::msg($::who, "DCC already active!");
304 if (!scalar %contents) {
305 &::msg($::who,"search returned no results.");
309 my $file = "$::param{tempDir}/$::who.txt";
310 if (!open OUT, ">$file") {
311 &::ERROR("Debian: cannot write file for dcc send.");
315 foreach $pkg (keys %contents) {
316 foreach (keys %{ $contents{$pkg} }) {
317 # TODO: correct padding.
318 print OUT "$_\t\t\t$pkg\n";
323 &::shmWrite($::shm, "DCC SEND $::who $file");
328 &::status("Debian: $found contents results found.");
331 foreach $pkg (keys %contents) {
332 my @tmplist = &::fixFileList(keys %{ $contents{$pkg} });
333 my @sublist = sort { length $a <=> length $b } @tmplist;
335 pop @sublist while (scalar @sublist > 3);
337 $pkg =~ s/\,/\037\,\037/g; # underline ','.
338 push(@list, "(". join(', ',@sublist) .") in $pkg");
340 # sort the total list from shortest to longest...
341 @list = sort { length $a <=> length $b } @list;
343 # show how long it took.
344 my $delta_time = &::timedelta($start_time);
345 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
347 my $prefix = "Debian Search of '$query' ";
348 if (scalar @list) { # @list.
349 &::performStrictReply( &::formListReply(0, $prefix, @list) );
354 &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug);
355 @list = &searchDesc($query);
358 my $prefix = "Debian Package/File/Desc Search of '$query' ";
359 &::performStrictReply( &::formListReply(0, $prefix, ) );
361 } elsif (scalar @list == 1) { # list = 1.
362 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
363 &infoPackages("info", $list[0]);
366 my $prefix = "Debian Desc Search of '$query' ";
367 &::performStrictReply( &::formListReply(0, $prefix, @list) );
372 # Usage: &searchAuthor($query);
374 my ($dist, $query) = &getDistroFromStr($_[0]);
375 &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug);
376 $query =~ s/^\s+|\s+$//g;
379 my $start_time = &::timeget();
380 &::status("Debian: starting author search.");
382 my %urls = fixDist($dist,'packages');
384 my ($bad,$good) = (0,0);
385 foreach (keys %urls) {
395 &::DEBUG("deb: good = $good, bad = $bad...") if ($debug);
397 if ($good == 0 and $bad != 0) {
398 &::DEBUG("deb: download 2.");
400 if (!&DebianDownload($dist, %urls)) {
401 &::ERROR("Debian(sA): could not download files.");
406 my (%maint, %pkg, $package);
407 open(IN,"zegrep -h '^Package|^Maintainer' $files |");
409 if (/^Package: (\S+)$/) {
412 } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
413 my($name,$email) = ($1,$2);
414 if ($package eq "") {
415 &::DEBUG("deb: sA: package == NULL.");
418 $maint{$name}{$email} = 1;
419 $pkg{$name}{$package} = 1;
424 &::WARN("debian: invalid line: '$_' (1).");
430 # TODO: can we use 'map' here?
431 foreach (grep /\Q$query\E/i, keys %maint) {
435 # TODO: should we only search email if '@' is used?
436 if (scalar keys %hash < 15) {
439 foreach $name (keys %maint) {
442 foreach $email (keys %{ $maint{$name} }) {
443 next unless ($email =~ /\Q$query\E/i);
444 next if (exists $hash{$name});
450 my @list = keys %hash;
451 if (scalar @list != 1) {
452 my $prefix = "Debian Author Search of '$query' ";
453 &::performStrictReply( &::formListReply(0, $prefix, @list) );
457 &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug);
459 my @pkg = sort keys %{ $pkg{$list[0]} };
461 # show how long it took.
462 my $delta_time = &::timedelta($start_time);
463 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
465 my $email = join(', ', keys %{ $maint{$list[0]} });
466 my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
467 &::performStrictReply( &::formListReply(0, $prefix, @pkg) );
471 # Usage: &searchDesc($query);
473 my ($dist, $query) = &getDistroFromStr($_[0]);
474 &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.") if ($debug);
475 $query =~ s/^\s+|\s+$//g;
478 my $start_time = &::timeget();
479 &::status("Debian: starting desc search.");
482 my ($bad,$good) = (0,0);
483 my %urls = fixDist($dist,'packages');
485 # XXX This should be abstracted elsewhere.
486 foreach (keys %urls) {
496 &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug);
498 if ($good == 0 and $bad != 0) {
499 &::DEBUG("deb: download 2c.") if ($debug);
501 if (!&DebianDownload($dist, %urls)) {
502 &::ERROR("deb: sD: could not download files.");
508 $regex =~ s/\./\\./g;
509 $regex =~ s/\*/\\S*/g;
512 my (%desc, $package);
513 open(IN,"zegrep -h '^Package|^Description' $files |");
515 if (/^Package: (\S+)$/) {
517 } elsif (/^Description: (.*)$/) {
519 next unless (eval { $desc =~ /$regex/i });
520 return unless &checkEval($@);
522 if ($package eq "") {
523 &::WARN("sD: package == NULL?");
527 $desc{$package} = $desc;
532 &::WARN("debian: invalid line: '$_'. (2)");
537 # show how long it took.
538 my $delta_time = &::timedelta($start_time);
539 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
545 # Usage: &generateIncoming();
546 sub generateIncoming {
547 my $pkgfile = $debian_dir."/Packages-incoming";
548 my $idxfile = $pkgfile.".idx";
550 $stale++ if (&::isStale($pkgfile.".gz", $refresh));
551 $stale++ if (&::isStale($idxfile, $refresh));
552 &::DEBUG("deb: gI: stale => '$stale'.") if ($debug);
553 return 0 unless ($stale);
556 my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/");
558 if (!open PKG, ">$pkgfile") {
559 &::ERROR("cannot write to pkg $pkgfile.");
562 if (!open IDX, ">$idxfile") {
563 &::ERROR("cannot write to idx $idxfile.");
567 print IDX "*$pkgfile.gz\n";
569 foreach $file (sort keys %ftp) {
570 next unless ($file =~ /deb$/);
572 if ($file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/) {
574 print PKG "Package: $1\n";
575 print PKG "Version: $2\n";
576 print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n";
578 print PKG "Filename: $file\n";
579 print PKG "Size: $ftp{$file}\n";
585 system("gzip -9fv $pkgfile"); # lame fix.
587 &::status("Debian: generateIncoming() complete.");
591 ##############################
592 # DEBIAN PACKAGE INFO FUNCTIONS.
595 # Usage: &getPackageInfo($query,$file);
597 my ($package, $file) = @_;
600 &::status("gPI: file $file does not exist?");
607 open(IN, "/bin/zcat $file 2>&1 |");
613 next if (/^ \S+/); # package long description.
616 if (/^Package: (.*)\n$/) {
618 if ($pkg =~ /^\Q$package\E$/i) {
619 $found++; # we can use pkg{'package'} instead.
620 $pkg{'package'} = $pkg;
629 if (/^Version: (.*)$/) {
630 $pkg{'version'} = $1;
631 } elsif (/^Priority: (.*)$/) {
632 $pkg{'priority'} = $1;
633 } elsif (/^Section: (.*)$/) {
634 $pkg{'section'} = $1;
635 } elsif (/^Size: (.*)$/) {
637 } elsif (/^Installed-Size: (.*)$/i) {
638 $pkg{'installed'} = $1;
639 } elsif (/^Description: (.*)$/) {
641 } elsif (/^Filename: (.*)$/) {
643 } elsif (/^Pre-Depends: (.*)$/) {
644 $pkg{'depends'} = "pre-depends on $1";
645 } elsif (/^Depends: (.*)$/) {
646 if (exists $pkg{'depends'}) {
647 $pkg{'depends'} .= "; depends on $1";
649 $pkg{'depends'} = "depends on $1";
651 } elsif (/^Maintainer: (.*)$/) {
653 } elsif (/^Provides: (.*)$/) {
654 $pkg{'provides'} = $1;
655 } elsif (/^Suggests: (.*)$/) {
656 $pkg{'suggests'} = $1;
657 } elsif (/^Conflicts: (.*)$/) {
658 $pkg{'conflicts'} = $1;
661 ### &::DEBUG("=> '$_'.");
671 next if (defined $pkg);
679 # Usage: &infoPackages($query,$package);
681 my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1]));
683 &::status("Debian: Searching for package '$package' in '$dist'.");
685 # download packages file.
687 my %urls = &fixDist($dist,'packages');
688 if ($dist ne "incoming") {
689 &::DEBUG("deb: download 3.") if ($debug);
691 if (!&DebianDownload($dist, %urls)) { # no good download.
692 &::WARN("Debian(iP): could not download ANY files.");
696 # check if the package is valid.
698 my @files = &validPackage($package, $dist);
699 if (!scalar @files) {
700 &::status("Debian: no valid package found; checking incoming.");
701 @files = &validPackage($package, "incoming");
704 &::status("Debian: cool, it exists in incoming.");
707 &::msg($::who, "Package '$package' does not exist.");
712 if (scalar @files > 1) {
713 &::WARN("same package in more than one file; random.");
714 &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
715 $files[0] = &::getRandom(@files);
718 if (! -f $files[0]) {
719 &::WARN("files[0] ($files[0]) doesn't exist.");
720 &::msg($::who, "FIXME: $files[0] does not exist?");
724 ### TODO: if specific package is requested, note down that a version
725 ### exists in incoming.
728 my $file = $files[0];
731 ### TODO: use fe, dump to a hash. if only one version of the package
732 ### exists. do as normal otherwise list all versions.
734 &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
737 my %pkg = &getPackageInfo($package, $file);
739 $query = "info" if ($query eq "dinfo");
742 if ($query eq "info") {
743 if (scalar keys %pkg <= 5) {
744 &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).").");
746 &::DEBUG("deb: end of debianCheck()");
748 &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it...");
752 $pkg{'info'} = "\002(\002". $pkg{'desc'} ."\002)\002";
753 $pkg{'info'} .= ", section ".$pkg{'section'};
754 $pkg{'info'} .= ", is ".$pkg{'priority'};
755 # $pkg{'info'} .= ". Version: \002$pkg{'version'}\002";
756 $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)";
757 $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
758 $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
761 &::status("iP: info requested and pkg is in incoming, too.");
762 my %incpkg = &getPackageInfo($query, $debian_dir ."/Packages-incoming");
764 if (scalar keys %incpkg) {
765 $pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
767 &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
772 if ($dist eq "incoming") {
773 $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
774 $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
775 $pkg{'info'} .= ", is in incoming!!!";
778 if (!exists $pkg{$query}) {
779 if ($query eq "suggests") {
780 $pkg{$query} = "has no suggestions";
781 } elsif ($query eq "conflicts") {
782 $pkg{$query} = "does not conflict with any other package";
783 } elsif ($query eq "depends") {
784 $pkg{$query} = "does not depend on anything";
785 } elsif ($query eq "maint") {
786 $pkg{$query} = "has no maintainer";
788 $pkg{$query} = "has nothing about $query";
792 &::performStrictReply("$package: $pkg{$query}");
795 # Usage: &infoStats($dist);
798 $dist = &getDistro($dist);
799 return unless (defined $dist);
801 &::DEBUG("deb: infoS: dist => '$dist'.");
803 # download packages file if needed.
804 my %urls = &fixDist($dist,'packages');
805 &::DEBUG("deb: download 4.");
806 if (!&DebianDownload($dist, %urls)) {
807 &::WARN("Debian(iS): could not download ANY files.");
808 &::msg($::who, "Debian(iS): internal error.");
813 my %total = (count => 0, maint => 0, isize => 0, csize => 0);
815 foreach $file (keys %urls) {
816 &::DEBUG("deb: file => '$file'.");
817 if (exists $stats{$file}{'count'}) {
818 &::DEBUG("deb: hrm... duplicate open with $file???");
822 open(IN, "zcat $file 2>&1 |");
825 &::DEBUG("deb: iS: $file does not exist.");
832 next if (/^ \S+/); # package long description.
834 if (/^Package: (.*)\n$/) { # counter.
835 $stats{$file}{'count'}++;
837 } elsif (/^Maintainer: .* <(\S+)>$/) {
838 $stats{$file}{'maint'}{$1}++;
839 $total{'maint'}{$1}++;
840 } elsif (/^Size: (.*)$/) { # compressed size.
841 $stats{$file}{'csize'} += $1;
842 $total{'csize'} += $1;
843 } elsif (/^i.*size: (.*)$/i) { # installed size.
844 $stats{$file}{'isize'} += $1;
845 $total{'isize'} += $1;
848 ### &::DEBUG("=> '$_'.");
853 ### TODO: don't count ppl with multiple email addresses.
855 &::performStrictReply(
856 "Debian Distro Stats on $dist... ".
857 "\002$total{'count'}\002 packages, ".
858 "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ".
859 "\002". int($total{'isize'}/1024)."\002 MB installed size, ".
860 "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size."
863 ### TODO: do individual stats? if so, we need _another_ arg.
864 # foreach $file (keys %stats) {
865 # foreach (keys %{ $stats{$file} }) {
866 # &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
874 # HELPER FUNCTIONS FOR INFOPACKAGES...
877 # Usage: &generateIndex();
880 &::DEBUG("D: generateIndex($dists[0]) called! ".join(':',caller(),));
881 if (!scalar @dists or $dists[0] eq '') {
882 &::ERROR("gI: no dists to generate index.");
887 my $dist = &getDistro($_); # incase the alias is returned, possible?
888 my $idx = $debian_dir."/Packages-$dist.idx";
889 my %urls = fixDist($_,'packages');
891 # TODO: check if any of the Packages file have been updated then
892 # regenerate it, even if it's not stale.
893 # TODO: also, regenerate the index if the packages file is newer
895 next unless (&::isStale($idx, $refresh));
898 &::DEBUG("deb: gIndex: calling generateIncoming()!");
904 # &::DEBUG("deb: Copying old index of sarge to -old");
905 # system("cp $idx $idx-old");
908 &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug);
909 &DebianDownload($dist, &fixDist($dist,'packages') );
911 &::status("Debian: generating index for '$dist'.");
912 if (!open OUT, ">$idx") {
913 &::ERROR("cannot write to $idx.");
918 foreach $packages (keys %urls) {
919 if (! -e $packages) {
920 &::ERROR("gIndex: '$packages' does not exist?");
924 print OUT "*$packages\n";
925 open(IN,"zcat $packages |");
928 next unless (/^Package: (.*)\n$/);
939 # Usage: &validPackage($package, $dist);
941 my ($package,$dist) = @_;
945 ### this majorly sucks, we need some standard in place.
946 # why is this needed... need to investigate later.
948 $dist = &getDistro($dist);
950 &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug);
953 while (!open IN, $debian_dir."/Packages-$dist.idx") {
955 &::ERROR("Packages-$dist.idx does not exist (#1).");
959 &generateIndex($dist);
971 if (/^\Q$package\E\n$/) {
978 &::VERB("vP: scanned $count items in index.",2);
984 my ($dist, $query) = &getDistroFromStr($_[0]);
985 my $file = $debian_dir."/Packages-$dist.idx";
986 my $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0;
990 &::status("Debian: Search package matching '$query' in '$dist'.");
991 unlink $file if ( -z $file );
993 while (!open IN, $file) {
994 if ($dist eq "incoming") {
995 &::DEBUG("deb: sP: dist == incoming; calling gI().");
1000 &::ERROR("could not generate index ($file)!");
1005 &::DEBUG("deb: should we be doing this?");
1006 &generateIndex(($dist));
1015 if (&::isStale($file, $refresh)) {
1016 &::DEBUG("deb: STALE $file! regen.") if ($debug);
1017 &generateIndex(($dist));
1018 ### @files = searchPackage("$query $dist");
1019 &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug);
1032 if (scalar @files and $warn) {
1033 &::msg($::who, "searching for package name should be fully lowercase!");
1042 if (!defined $dist or $dist eq "") {
1043 &::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
1044 $dist = $defaultdist;
1047 if (exists $dists{$dist}) {
1048 &::VERB("gD: returning dists{$dist} ($dists{$dist})",2);
1049 return $dists{$dist};
1052 elsif (exists $archived_dists{$dist}){
1053 &::VERB("gD: returning archivedists{$dist} ($archived_dists{$dist})",2);
1054 return $archived_dists{$dist};
1057 if (!grep(/^\Q$dist\E$/i, %dists) and !grep(/^\Q$dist\E$/i, %archived_dists)) {
1058 &::msg($::who, "invalid dist '$dist'.");
1062 &::VERB("gD: returning $dist (no change or conversion)",2);
1067 sub getDistroFromStr {
1069 my $dists = join '|', %dists, %archived_dists;
1070 my $dist = $defaultdist;
1072 if ($str =~ s/\s+($dists)$//i) {
1073 $dist = &getDistro(lc $1);
1076 $str =~ s/\\([\$\^])/$1/g;
1082 my ($dist, $type) = @_;
1087 if (exists $archived_dists{$dist}){
1088 if ($type eq 'contents'){
1089 %dist_urls = %archiveurlcontents;
1092 %dist_urls = %archiveurlpackages;
1096 if ($type eq 'contents'){
1097 %dist_urls = %urlcontents;
1100 %dist_urls = %urlpackages;
1104 while (($key,$val) = each %dist_urls) {
1105 $key =~ s/##DIST/$dist/;
1106 $val =~ s/##DIST/$dist/;
1107 ### TODO: what should we do if the sar wasn't done.
1108 $new{$debian_dir."/".$key} = $val;
1117 my ($dist, $query) = &getDistroFromStr($str);
1118 my @results = sort &searchPackage($str);
1120 if (!scalar @results) {
1121 &::Forker("Debian", sub { &searchContents($str); } );
1122 } elsif (scalar @results == 1) {
1123 &::status("searchPackage returned one result; getting info of package instead!");
1124 &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } );
1126 my $prefix = "Debian Package Listing of '$query' ";
1127 &::performStrictReply( &::formListReply(0, $prefix, @results) );
1134 &::status("debianCheck() called.");
1136 ### TODO: remove the following loop (check if dir exists before)
1138 last if (opendir(DEBIAN, $debian_dir));
1141 &::ERROR("dC: cannot opendir debian.");
1145 mkdir $debian_dir, 0755;
1151 while (defined($file = readdir DEBIAN)) {
1152 next unless ($file =~ /(gz|bz2)$/);
1154 # TODO: add bzip2 support (debian doesn't do .bz2 anyway)
1155 my $exit = system("/bin/gzip -t '$debian_dir/$file'");
1156 next unless ($exit);
1157 &::DEBUG("deb: hmr... => ".(time() - (stat($debian_dir/$file))[8])."'.");
1158 next unless (time() - (stat($file))[8] > 3600);
1160 #&::DEBUG("deb: dC: exit => '$exit'.");
1161 &::WARN("dC: '$debian_dir/$file' corrupted? deleting!");
1162 unlink $debian_dir."/".$file;
1173 &::WARN("cE: $str");
1181 # &::DEBUG("deb: FE called for searchDesc");
1183 my @list = &searchDesc($query);
1185 if (!scalar @list) {
1186 my $prefix = "Debian Desc Search of '$query' ";
1187 &::performStrictReply( &::formListReply(0, $prefix, ) );
1188 } elsif (scalar @list == 1) { # list = 1.
1189 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
1190 &infoPackages("info", $list[0]);
1191 } else { # list > 1.
1192 my $prefix = "Debian Desc Search of '$query' ";
1193 &::performStrictReply( &::formListReply(0, $prefix, @list) );