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 = 'nl'; # well .config it yourself then. ;-)
22 my $protocol = 'http';
23 # EDIT THIS (i386, amd64, powerpc, [etc.]):
26 # format: "alias=real".
31 'experimental' => 'experimental',
32 'oldstable' => 'sarge',
33 'incoming' => 'incoming',
36 my %archived_dists = (
46 my %archiveurlcontents = (
47 "Contents-##DIST-$arch.gz" =>
48 "$protocol://debian.crosslink.net/debian-archive".
49 "/dists/##DIST/Contents-$arch.gz",
52 my %archiveurlpackages = (
53 "Packages-##DIST-main-$arch.gz" =>
54 "$protocol://debian.crosslink.net/debian-archive".
55 "/dists/##DIST/main/binary-$arch/Packages.gz",
56 "Packages-##DIST-contrib-$arch.gz" =>
57 "$protocol://debian.crosslink.net/debian-archive".
58 "/dists/##DIST/contrib/binary-$arch/Packages.gz",
59 "Packages-##DIST-non-free-$arch.gz" =>
60 "$protocol://debian.crosslink.net/debian-archive".
61 "/dists/##DIST/non-free/binary-$arch/Packages.gz",
66 "Contents-##DIST-$arch.gz" =>
67 "$protocol://ftp.$country.debian.org".
68 "/debian/dists/##DIST/Contents-$arch.gz",
69 "Contents-##DIST-$arch-non-US.gz" =>
70 "$protocol://non-us.debian.org".
71 "/debian-non-US/dists/##DIST/non-US/Contents-$arch.gz",
75 "Packages-##DIST-main-$arch.gz" =>
76 "$protocol://ftp.$country.debian.org".
77 "/debian/dists/##DIST/main/binary-$arch/Packages.gz",
78 "Packages-##DIST-contrib-$arch.gz" =>
79 "$protocol://ftp.$country.debian.org".
80 "/debian/dists/##DIST/contrib/binary-$arch/Packages.gz",
81 "Packages-##DIST-non-free-$arch.gz" =>
82 "$protocol://ftp.$country.debian.org".
83 "/debian/dists/##DIST/non-free/binary-$arch/Packages.gz",
87 ### COMMON FUNCTION....
88 #######################
91 # Usage: &DebianDownload($dist, %hash);
93 my ($dist, %urls) = @_;
97 if (! -d $debian_dir) {
98 &::status("Debian: creating debian dir.");
99 mkdir($debian_dir, 0755);
103 # Download the files.
105 foreach $file (keys %urls) {
106 my $url = $urls{$file};
107 $url =~ s/##DIST/$dist/g;
108 $file =~ s/##DIST/$dist/g;
112 my $last_refresh = (stat $file)[9];
113 $update++ if (time() - $last_refresh > $refresh);
118 next unless ($update);
120 &::DEBUG("announce == $announce.") if ($debug);
121 if ($good + $bad == 0 and !$announce) {
122 &::status("Debian: Downloading files for '$dist'.");
123 &::msg($::who, "Updating debian files... please wait.");
127 if (exists $::debian{$url}) {
128 &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug);
129 next if (time() - $::debian{$url} <= $refresh);
130 &::DEBUG("stale for url $url; updating!") if ($debug);
133 if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
134 my ($host,$path,$thisfile) = ($1,$2,$3);
136 if (!&::ftpGet($host,$path,$thisfile,$file)) {
137 &::WARN("deb: down: $file == BAD.");
142 } elsif ($url =~ /^http:\/\/\S+\/\S+$/) {
144 if (!&::getURLAsFile($url,$file)) {
145 &::WARN("deb: down: http: $file == BAD.");
151 &::ERROR("Debian: invalid format of url => ($url).");
157 &::WARN("deb: down: http: !file");
162 # my $exit = system("/bin/gzip -t $file");
164 # &::WARN("deb: $file is corrupted ($exit) :/");
169 &::DEBUG("deb: download: good.") if ($debug);
173 # ok... lets just run this.
174 &::miscCheck() if (&::whatInterface() =~ /IRC/);
177 &generateIndex($dist);
180 return -1 unless ($bad); # no download.
181 &::DEBUG("DD: !good and bad($bad). :(");
186 ###########################
187 # DEBIAN CONTENTS SEARCH FUNCTIONS.
191 # Usage: &searchContents($query);
193 my ($dist, $query) = &getDistroFromStr($_[0]);
194 &::status("Debian: Contents search for '$query' in '$dist'.");
197 $dccsend++ if ($query =~ s/^dcc\s+//i);
199 $query =~ s/\\([\^\$])/$1/g; # hrm?
200 $query =~ s/^\s+|\s+$//g;
202 if (!&::validExec($query)) {
203 &::msg($::who, 'search string looks fuzzy.');
207 my %urls = fixDist($dist,'contents');
208 if ($dist eq 'incoming') { # nothing yet.
209 &::DEBUG('sC: dist = "incoming". no contents yet.');
212 # download contents file.
213 &::DEBUG('deb: download 1.') if ($debug);
214 if (!&DebianDownload($dist, %urls)) {
215 &::WARN('Debian: could not download files.');
220 my $start_time = &::timeget();
226 ### TODO: search properly if /usr/bin/blah is done.
227 if ($query =~ s/\$$//) {
228 &::DEBUG("deb: search-regex found.") if ($debug);
229 $grepRE = "$query\[ \t]";
230 } elsif ($query =~ s/^\^//) {
231 &::DEBUG("deb: front marker regex found.") if ($debug);
235 $grepRE = "$query*\[ \t]";
238 # fix up grepRE for "*".
239 $grepRE =~ s/\*/.*/g;
242 foreach (keys %urls) {
243 next unless ( -f $_ );
247 if (!scalar @files) {
248 &::ERROR("sC: no files?");
249 &::msg($::who, "failed.");
253 my $files = join(' ', @files);
256 $regex =~ s/\./\\./g;
257 $regex =~ s/\*/\\S*/g;
260 open(IN,"zegrep -h '$grepRE' $files |");
261 # wonderful abuse of if, last, next, return, and, unless ;)
263 last if ($found > 100);
265 next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/);
266 my ($file,$package) = ("/".$1,$2);
268 if ($query =~ /[\/\*\\]/) {
269 next unless (eval { $file =~ /$regex/ });
270 return unless &checkEval($@);
272 my ($basename) = $file =~ /^.*\/(.*)$/;
273 next unless (eval { $basename =~ /$regex/ });
274 return unless &checkEval($@);
276 next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//);
277 next if ($front and eval { $file !~ /^\/$query/ });
278 return unless &checkEval($@);
280 $contents{$package}{$file} = 1;
287 ### send results with dcc.
289 if (exists $::dcc{'SEND'}{$::who}) {
290 &::msg($::who, "DCC already active!");
294 if (!scalar %contents) {
295 &::msg($::who,"search returned no results.");
299 my $file = "$::param{tempDir}/$::who.txt";
300 if (!open OUT, ">$file") {
301 &::ERROR("Debian: cannot write file for dcc send.");
305 foreach $pkg (keys %contents) {
306 foreach (keys %{ $contents{$pkg} }) {
307 # TODO: correct padding.
308 print OUT "$_\t\t\t$pkg\n";
313 &::shmWrite($::shm, "DCC SEND $::who $file");
318 &::status("Debian: $found contents results found.");
321 foreach $pkg (keys %contents) {
322 my @tmplist = &::fixFileList(keys %{ $contents{$pkg} });
323 my @sublist = sort { length $a <=> length $b } @tmplist;
325 pop @sublist while (scalar @sublist > 3);
327 $pkg =~ s/\,/\037\,\037/g; # underline ','.
328 push(@list, "(". join(', ',@sublist) .") in $pkg");
330 # sort the total list from shortest to longest...
331 @list = sort { length $a <=> length $b } @list;
333 # show how long it took.
334 my $delta_time = &::timedelta($start_time);
335 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
337 my $prefix = "Debian Search of '$query' ";
338 if (scalar @list) { # @list.
339 &::performStrictReply( &::formListReply(0, $prefix, @list) );
344 &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug);
345 @list = &searchDesc($query);
348 my $prefix = "Debian Package/File/Desc Search of '$query' ";
349 &::performStrictReply( &::formListReply(0, $prefix, ) );
351 } elsif (scalar @list == 1) { # list = 1.
352 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
353 &infoPackages("info", $list[0]);
356 my $prefix = "Debian Desc Search of '$query' ";
357 &::performStrictReply( &::formListReply(0, $prefix, @list) );
362 # Usage: &searchAuthor($query);
364 my ($dist, $query) = &getDistroFromStr($_[0]);
365 &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug);
366 $query =~ s/^\s+|\s+$//g;
369 my $start_time = &::timeget();
370 &::status("Debian: starting author search.");
372 my %urls = fixDist($dist,'packages');
374 my ($bad,$good) = (0,0);
375 foreach (keys %urls) {
385 &::DEBUG("deb: good = $good, bad = $bad...") if ($debug);
387 if ($good == 0 and $bad != 0) {
388 &::DEBUG("deb: download 2.");
390 if (!&DebianDownload($dist, %urls)) {
391 &::ERROR("Debian(sA): could not download files.");
396 my (%maint, %pkg, $package);
397 open(IN,"zegrep -h '^Package|^Maintainer' $files |");
399 if (/^Package: (\S+)$/) {
402 } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
403 my($name,$email) = ($1,$2);
404 if ($package eq "") {
405 &::DEBUG("deb: sA: package == NULL.");
408 $maint{$name}{$email} = 1;
409 $pkg{$name}{$package} = 1;
414 &::WARN("debian: invalid line: '$_' (1).");
420 # TODO: can we use 'map' here?
421 foreach (grep /\Q$query\E/i, keys %maint) {
425 # TODO: should we only search email if '@' is used?
426 if (scalar keys %hash < 15) {
429 foreach $name (keys %maint) {
432 foreach $email (keys %{ $maint{$name} }) {
433 next unless ($email =~ /\Q$query\E/i);
434 next if (exists $hash{$name});
440 my @list = keys %hash;
441 if (scalar @list != 1) {
442 my $prefix = "Debian Author Search of '$query' ";
443 &::performStrictReply( &::formListReply(0, $prefix, @list) );
447 &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug);
449 my @pkg = sort keys %{ $pkg{$list[0]} };
451 # show how long it took.
452 my $delta_time = &::timedelta($start_time);
453 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
455 my $email = join(', ', keys %{ $maint{$list[0]} });
456 my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
457 &::performStrictReply( &::formListReply(0, $prefix, @pkg) );
461 # Usage: &searchDesc($query);
463 my ($dist, $query) = &getDistroFromStr($_[0]);
464 &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.") if ($debug);
465 $query =~ s/^\s+|\s+$//g;
468 my $start_time = &::timeget();
469 &::status("Debian: starting desc search.");
472 my ($bad,$good) = (0,0);
473 my %urls = fixDist($dist,'packages');
475 # XXX This should be abstracted elsewhere.
476 foreach (keys %urls) {
486 &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug);
488 if ($good == 0 and $bad != 0) {
489 &::DEBUG("deb: download 2c.") if ($debug);
491 if (!&DebianDownload($dist, %urls)) {
492 &::ERROR("deb: sD: could not download files.");
498 $regex =~ s/\./\\./g;
499 $regex =~ s/\*/\\S*/g;
502 my (%desc, $package);
503 open(IN,"zegrep -h '^Package|^Description' $files |");
505 if (/^Package: (\S+)$/) {
507 } elsif (/^Description: (.*)$/) {
509 next unless (eval { $desc =~ /$regex/i });
510 return unless &checkEval($@);
512 if ($package eq "") {
513 &::WARN("sD: package == NULL?");
517 $desc{$package} = $desc;
522 &::WARN("debian: invalid line: '$_'. (2)");
527 # show how long it took.
528 my $delta_time = &::timedelta($start_time);
529 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
535 # Usage: &generateIncoming();
536 sub generateIncoming {
537 my $pkgfile = $debian_dir."/Packages-incoming";
538 my $idxfile = $pkgfile.".idx";
540 $stale++ if (&::isStale($pkgfile.".gz", $refresh));
541 $stale++ if (&::isStale($idxfile, $refresh));
542 &::DEBUG("deb: gI: stale => '$stale'.") if ($debug);
543 return 0 unless ($stale);
546 my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/");
548 if (!open PKG, ">$pkgfile") {
549 &::ERROR("cannot write to pkg $pkgfile.");
552 if (!open IDX, ">$idxfile") {
553 &::ERROR("cannot write to idx $idxfile.");
557 print IDX "*$pkgfile.gz\n";
559 foreach $file (sort keys %ftp) {
560 next unless ($file =~ /deb$/);
562 if ($file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/) {
564 print PKG "Package: $1\n";
565 print PKG "Version: $2\n";
566 print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n";
568 print PKG "Filename: $file\n";
569 print PKG "Size: $ftp{$file}\n";
575 system("gzip -9fv $pkgfile"); # lame fix.
577 &::status("Debian: generateIncoming() complete.");
581 ##############################
582 # DEBIAN PACKAGE INFO FUNCTIONS.
585 # Usage: &getPackageInfo($query,$file);
587 my ($package, $file) = @_;
590 &::status("gPI: file $file does not exist?");
597 open(IN, "/bin/zcat $file 2>&1 |");
603 next if (/^ \S+/); # package long description.
606 if (/^Package: (.*)\n$/) {
608 if ($pkg =~ /^\Q$package\E$/i) {
609 $found++; # we can use pkg{'package'} instead.
610 $pkg{'package'} = $pkg;
619 if (/^Version: (.*)$/) {
620 $pkg{'version'} = $1;
621 } elsif (/^Priority: (.*)$/) {
622 $pkg{'priority'} = $1;
623 } elsif (/^Section: (.*)$/) {
624 $pkg{'section'} = $1;
625 } elsif (/^Size: (.*)$/) {
627 } elsif (/^Installed-Size: (.*)$/i) {
628 $pkg{'installed'} = $1;
629 } elsif (/^Description: (.*)$/) {
631 } elsif (/^Filename: (.*)$/) {
633 } elsif (/^Pre-Depends: (.*)$/) {
634 $pkg{'depends'} = "pre-depends on $1";
635 } elsif (/^Depends: (.*)$/) {
636 if (exists $pkg{'depends'}) {
637 $pkg{'depends'} .= "; depends on $1";
639 $pkg{'depends'} = "depends on $1";
641 } elsif (/^Maintainer: (.*)$/) {
643 } elsif (/^Provides: (.*)$/) {
644 $pkg{'provides'} = $1;
645 } elsif (/^Suggests: (.*)$/) {
646 $pkg{'suggests'} = $1;
647 } elsif (/^Conflicts: (.*)$/) {
648 $pkg{'conflicts'} = $1;
651 ### &::DEBUG("=> '$_'.");
661 next if (defined $pkg);
669 # Usage: &infoPackages($query,$package);
671 my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1]));
673 &::status("Debian: Searching for package '$package' in '$dist'.");
675 # download packages file.
677 my %urls = &fixDist($dist,'packages');
678 if ($dist ne "incoming") {
679 &::DEBUG("deb: download 3.") if ($debug);
681 if (!&DebianDownload($dist, %urls)) { # no good download.
682 &::WARN("Debian(iP): could not download ANY files.");
686 # check if the package is valid.
688 my @files = &validPackage($package, $dist);
689 if (!scalar @files) {
690 &::status("Debian: no valid package found; checking incoming.");
691 @files = &validPackage($package, "incoming");
694 &::status("Debian: cool, it exists in incoming.");
697 &::msg($::who, "Package '$package' does not exist.");
702 if (scalar @files > 1) {
703 &::WARN("same package in more than one file; random.");
704 &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
705 $files[0] = &::getRandom(@files);
708 if (! -f $files[0]) {
709 &::WARN("files[0] ($files[0]) doesn't exist.");
710 &::msg($::who, "FIXME: $files[0] does not exist?");
714 ### TODO: if specific package is requested, note down that a version
715 ### exists in incoming.
718 my $file = $files[0];
721 ### TODO: use fe, dump to a hash. if only one version of the package
722 ### exists. do as normal otherwise list all versions.
724 &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
727 my %pkg = &getPackageInfo($package, $file);
729 $query = "info" if ($query eq "dinfo");
732 if ($query eq "info") {
733 if (scalar keys %pkg <= 5) {
734 &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).").");
736 &::DEBUG("deb: end of debianCheck()");
738 &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it...");
742 $pkg{'info'} = "\002(\002". $pkg{'desc'} ."\002)\002";
743 $pkg{'info'} .= ", section ".$pkg{'section'};
744 $pkg{'info'} .= ", is ".$pkg{'priority'};
745 # $pkg{'info'} .= ". Version: \002$pkg{'version'}\002";
746 $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)";
747 $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
748 $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
751 &::status("iP: info requested and pkg is in incoming, too.");
752 my %incpkg = &getPackageInfo($query, $debian_dir ."/Packages-incoming");
754 if (scalar keys %incpkg) {
755 $pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
757 &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
762 if ($dist eq "incoming") {
763 $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
764 $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
765 $pkg{'info'} .= ", is in incoming!!!";
768 if (!exists $pkg{$query}) {
769 if ($query eq "suggests") {
770 $pkg{$query} = "has no suggestions";
771 } elsif ($query eq "conflicts") {
772 $pkg{$query} = "does not conflict with any other package";
773 } elsif ($query eq "depends") {
774 $pkg{$query} = "does not depend on anything";
775 } elsif ($query eq "maint") {
776 $pkg{$query} = "has no maintainer";
778 $pkg{$query} = "has nothing about $query";
782 &::performStrictReply("$package: $pkg{$query}");
785 # Usage: &infoStats($dist);
788 $dist = &getDistro($dist);
789 return unless (defined $dist);
791 &::DEBUG("deb: infoS: dist => '$dist'.");
793 # download packages file if needed.
794 my %urls = &fixDist($dist,'packages');
795 &::DEBUG("deb: download 4.");
796 if (!&DebianDownload($dist, %urls)) {
797 &::WARN("Debian(iS): could not download ANY files.");
798 &::msg($::who, "Debian(iS): internal error.");
803 my %total = (count => 0, maint => 0, isize => 0, csize => 0);
805 foreach $file (keys %urls) {
806 &::DEBUG("deb: file => '$file'.");
807 if (exists $stats{$file}{'count'}) {
808 &::DEBUG("deb: hrm... duplicate open with $file???");
812 open(IN, "zcat $file 2>&1 |");
815 &::DEBUG("deb: iS: $file does not exist.");
822 next if (/^ \S+/); # package long description.
824 if (/^Package: (.*)\n$/) { # counter.
825 $stats{$file}{'count'}++;
827 } elsif (/^Maintainer: .* <(\S+)>$/) {
828 $stats{$file}{'maint'}{$1}++;
829 $total{'maint'}{$1}++;
830 } elsif (/^Size: (.*)$/) { # compressed size.
831 $stats{$file}{'csize'} += $1;
832 $total{'csize'} += $1;
833 } elsif (/^i.*size: (.*)$/i) { # installed size.
834 $stats{$file}{'isize'} += $1;
835 $total{'isize'} += $1;
838 ### &::DEBUG("=> '$_'.");
843 ### TODO: don't count ppl with multiple email addresses.
845 &::performStrictReply(
846 "Debian Distro Stats on $dist... ".
847 "\002$total{'count'}\002 packages, ".
848 "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ".
849 "\002". int($total{'isize'}/1024)."\002 MB installed size, ".
850 "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size."
853 ### TODO: do individual stats? if so, we need _another_ arg.
854 # foreach $file (keys %stats) {
855 # foreach (keys %{ $stats{$file} }) {
856 # &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
864 # HELPER FUNCTIONS FOR INFOPACKAGES...
867 # Usage: &generateIndex();
870 &::DEBUG("D: generateIndex($dists[0]) called! ".join(':',caller(),));
871 if (!scalar @dists or $dists[0] eq '') {
872 &::ERROR("gI: no dists to generate index.");
877 my $dist = &getDistro($_); # incase the alias is returned, possible?
878 my $idx = $debian_dir."/Packages-$dist.idx";
879 my %urls = fixDist($_,'packages');
881 # TODO: check if any of the Packages file have been updated then
882 # regenerate it, even if it's not stale.
883 # TODO: also, regenerate the index if the packages file is newer
885 next unless (&::isStale($idx, $refresh));
888 &::DEBUG("deb: gIndex: calling generateIncoming()!");
894 # &::DEBUG("deb: Copying old index of sarge to -old");
895 # system("cp $idx $idx-old");
898 &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug);
899 &DebianDownload($dist, &fixDist($dist,'packages') );
901 &::status("Debian: generating index for '$dist'.");
902 if (!open OUT, ">$idx") {
903 &::ERROR("cannot write to $idx.");
908 foreach $packages (keys %urls) {
909 if (! -e $packages) {
910 &::ERROR("gIndex: '$packages' does not exist?");
914 print OUT "*$packages\n";
915 open(IN,"zcat $packages |");
918 next unless (/^Package: (.*)\n$/);
929 # Usage: &validPackage($package, $dist);
931 my ($package,$dist) = @_;
935 ### this majorly sucks, we need some standard in place.
936 # why is this needed... need to investigate later.
938 $dist = &getDistro($dist);
940 &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug);
943 while (!open IN, $debian_dir."/Packages-$dist.idx") {
945 &::ERROR("Packages-$dist.idx does not exist (#1).");
949 &generateIndex($dist);
961 if (/^\Q$package\E\n$/) {
968 &::VERB("vP: scanned $count items in index.",2);
974 my ($dist, $query) = &getDistroFromStr($_[0]);
975 my $file = $debian_dir."/Packages-$dist.idx";
976 my $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0;
980 &::status("Debian: Search package matching '$query' in '$dist'.");
981 unlink $file if ( -z $file );
983 while (!open IN, $file) {
984 if ($dist eq "incoming") {
985 &::DEBUG("deb: sP: dist == incoming; calling gI().");
990 &::ERROR("could not generate index ($file)!");
995 &::DEBUG("deb: should we be doing this?");
996 &generateIndex(($dist));
1005 if (&::isStale($file, $refresh)) {
1006 &::DEBUG("deb: STALE $file! regen.") if ($debug);
1007 &generateIndex(($dist));
1008 ### @files = searchPackage("$query $dist");
1009 &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug);
1022 if (scalar @files and $warn) {
1023 &::msg($::who, "searching for package name should be fully lowercase!");
1032 if (!defined $dist or $dist eq "") {
1033 &::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
1034 $dist = $defaultdist;
1037 if (exists $dists{$dist}) {
1038 &::VERB("gD: returning dists{$dist} ($dists{$dist})",2);
1039 return $dists{$dist};
1042 elsif (exists $archived_dists{$dist}){
1043 &::VERB("gD: returning archivedists{$dist} ($archived_dists{$dist})",2);
1044 return $archived_dists{$dist};
1047 if (!grep(/^\Q$dist\E$/i, %dists) and !grep(/^\Q$dist\E$/i, %archived_dists)) {
1048 &::msg($::who, "invalid dist '$dist'.");
1052 &::VERB("gD: returning $dist (no change or conversion)",2);
1057 sub getDistroFromStr {
1059 my $dists = join '|', %dists, %archived_dists;
1060 my $dist = $defaultdist;
1062 if ($str =~ s/\s+($dists)$//i) {
1063 $dist = &getDistro(lc $1);
1066 $str =~ s/\\([\$\^])/$1/g;
1072 my ($dist, $type) = @_;
1077 if (exists $archived_dists{$dist}){
1078 if ($type eq 'contents'){
1079 %dist_urls = %archiveurlcontents;
1082 %dist_urls = %archiveurlpackages;
1086 if ($type eq 'contents'){
1087 %dist_urls = %urlcontents;
1090 %dist_urls = %urlpackages;
1094 while (($key,$val) = each %dist_urls) {
1095 $key =~ s/##DIST/$dist/;
1096 $val =~ s/##DIST/$dist/;
1097 ### TODO: what should we do if the sar wasn't done.
1098 $new{$debian_dir."/".$key} = $val;
1107 my ($dist, $query) = &getDistroFromStr($str);
1108 my @results = sort &searchPackage($str);
1110 if (!scalar @results) {
1111 &::Forker("Debian", sub { &searchContents($str); } );
1112 } elsif (scalar @results == 1) {
1113 &::status("searchPackage returned one result; getting info of package instead!");
1114 &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } );
1116 my $prefix = "Debian Package Listing of '$query' ";
1117 &::performStrictReply( &::formListReply(0, $prefix, @results) );
1124 &::status("debianCheck() called.");
1126 ### TODO: remove the following loop (check if dir exists before)
1128 last if (opendir(DEBIAN, $debian_dir));
1131 &::ERROR("dC: cannot opendir debian.");
1135 mkdir $debian_dir, 0755;
1141 while (defined($file = readdir DEBIAN)) {
1142 next unless ($file =~ /(gz|bz2)$/);
1144 # TODO: add bzip2 support (debian doesn't do .bz2 anyway)
1145 my $exit = system("/bin/gzip -t '$debian_dir/$file'");
1146 next unless ($exit);
1147 &::DEBUG("deb: hmr... => ".(time() - (stat($debian_dir/$file))[8])."'.");
1148 next unless (time() - (stat($file))[8] > 3600);
1150 #&::DEBUG("deb: dC: exit => '$exit'.");
1151 &::WARN("dC: '$debian_dir/$file' corrupted? deleting!");
1152 unlink $debian_dir."/".$file;
1163 &::WARN("cE: $str");
1171 # &::DEBUG("deb: FE called for searchDesc");
1173 my @list = &searchDesc($query);
1175 if (!scalar @list) {
1176 my $prefix = "Debian Desc Search of '$query' ";
1177 &::performStrictReply( &::formListReply(0, $prefix, ) );
1178 } elsif (scalar @list == 1) { # list = 1.
1179 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
1180 &infoPackages("info", $list[0]);
1181 } else { # list > 1.
1182 my $prefix = "Debian Desc Search of '$query' ";
1183 &::performStrictReply( &::formListReply(0, $prefix, @list) );
1189 # vim:ts=4:sw=4:expandtab:tw=80