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",
68 "Contents-##DIST-$arch.gz" =>
69 "$protocol://ftp.$country.debian.org".
70 "/debian/dists/##DIST/Contents-$arch.gz",
71 "Contents-##DIST-$arch-non-US.gz" =>
72 "$protocol://non-us.debian.org".
73 "/debian-non-US/dists/##DIST/non-US/Contents-$arch.gz",
77 "Packages-##DIST-main-$arch.gz" =>
78 "$protocol://ftp.$country.debian.org".
79 "/debian/dists/##DIST/main/binary-$arch/Packages.gz",
80 "Packages-##DIST-contrib-$arch.gz" =>
81 "$protocol://ftp.$country.debian.org".
82 "/debian/dists/##DIST/contrib/binary-$arch/Packages.gz",
83 "Packages-##DIST-non-free-$arch.gz" =>
84 "$protocol://ftp.$country.debian.org".
85 "/debian/dists/##DIST/non-free/binary-$arch/Packages.gz",
89 ### COMMON FUNCTION....
90 #######################
93 # Usage: &DebianDownload($dist, %hash);
95 my ($dist, %urls) = @_;
99 if (! -d $debian_dir) {
100 &::status("Debian: creating debian dir.");
101 mkdir($debian_dir, 0755);
105 # Download the files.
107 foreach $file (keys %urls) {
108 my $url = $urls{$file};
109 $url =~ s/##DIST/$dist/g;
110 $file =~ s/##DIST/$dist/g;
114 my $last_refresh = (stat $file)[9];
115 $update++ if (time() - $last_refresh > $refresh);
120 next unless ($update);
122 &::DEBUG("announce == $announce.") if ($debug);
123 if ($good + $bad == 0 and !$announce) {
124 &::status("Debian: Downloading files for '$dist'.");
125 &::msg($::who, "Updating debian files... please wait.");
129 if (exists $::debian{$url}) {
130 &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug);
131 next if (time() - $::debian{$url} <= $refresh);
132 &::DEBUG("stale for url $url; updating!") if ($debug);
135 if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
136 my ($host,$path,$thisfile) = ($1,$2,$3);
138 if (!&::ftpGet($host,$path,$thisfile,$file)) {
139 &::WARN("deb: down: $file == BAD.");
144 } elsif ($url =~ /^http:\/\/\S+\/\S+$/) {
146 if (!&::getURLAsFile($url,$file)) {
147 &::WARN("deb: down: http: $file == BAD.");
153 &::ERROR("Debian: invalid format of url => ($url).");
159 &::WARN("deb: down: http: !file");
164 # my $exit = system("/bin/gzip -t $file");
166 # &::WARN("deb: $file is corrupted ($exit) :/");
171 &::DEBUG("deb: download: good.") if ($debug);
175 # ok... lets just run this.
176 &::miscCheck() if (&::whatInterface() =~ /IRC/);
179 &generateIndex($dist);
182 return -1 unless ($bad); # no download.
183 &::DEBUG("DD: !good and bad($bad). :(");
188 ###########################
189 # DEBIAN CONTENTS SEARCH FUNCTIONS.
193 # Usage: &searchContents($query);
195 my ($dist, $query) = &getDistroFromStr($_[0]);
196 &::status("Debian: Contents search for '$query' in '$dist'.");
199 $dccsend++ if ($query =~ s/^dcc\s+//i);
201 $query =~ s/\\([\^\$])/$1/g; # hrm?
202 $query =~ s/^\s+|\s+$//g;
204 if (!&::validExec($query)) {
205 &::msg($::who, 'search string looks fuzzy.');
209 my %urls = fixDist($dist,'contents');
210 if ($dist eq 'incoming') { # nothing yet.
211 &::DEBUG('sC: dist = "incoming". no contents yet.');
214 # download contents file.
215 &::DEBUG('deb: download 1.') if ($debug);
216 if (!&DebianDownload($dist, %urls)) {
217 &::WARN('Debian: could not download files.');
222 my $start_time = &::timeget();
228 ### TODO: search properly if /usr/bin/blah is done.
229 if ($query =~ s/\$$//) {
230 &::DEBUG("deb: search-regex found.") if ($debug);
231 $grepRE = "$query\[ \t]";
232 } elsif ($query =~ s/^\^//) {
233 &::DEBUG("deb: front marker regex found.") if ($debug);
237 $grepRE = "$query*\[ \t]";
240 # fix up grepRE for "*".
241 $grepRE =~ s/\*/.*/g;
244 foreach (keys %urls) {
245 next unless ( -f $_ );
249 if (!scalar @files) {
250 &::ERROR("sC: no files?");
251 &::msg($::who, "failed.");
255 my $files = join(' ', @files);
258 $regex =~ s/\./\\./g;
259 $regex =~ s/\*/\\S*/g;
262 open(IN,"zegrep -h '$grepRE' $files |");
263 # wonderful abuse of if, last, next, return, and, unless ;)
265 last if ($found > 100);
267 next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/);
268 my ($file,$package) = ("/".$1,$2);
270 if ($query =~ /[\/\*\\]/) {
271 next unless (eval { $file =~ /$regex/ });
272 return unless &checkEval($@);
274 my ($basename) = $file =~ /^.*\/(.*)$/;
275 next unless (eval { $basename =~ /$regex/ });
276 return unless &checkEval($@);
278 next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//);
279 next if ($front and eval { $file !~ /^\/$query/ });
280 return unless &checkEval($@);
282 $contents{$package}{$file} = 1;
289 ### send results with dcc.
291 if (exists $::dcc{'SEND'}{$::who}) {
292 &::msg($::who, "DCC already active!");
296 if (!scalar %contents) {
297 &::msg($::who,"search returned no results.");
301 my $file = "$::param{tempDir}/$::who.txt";
302 if (!open OUT, ">$file") {
303 &::ERROR("Debian: cannot write file for dcc send.");
307 foreach $pkg (keys %contents) {
308 foreach (keys %{ $contents{$pkg} }) {
309 # TODO: correct padding.
310 print OUT "$_\t\t\t$pkg\n";
315 &::shmWrite($::shm, "DCC SEND $::who $file");
320 &::status("Debian: $found contents results found.");
323 foreach $pkg (keys %contents) {
324 my @tmplist = &::fixFileList(keys %{ $contents{$pkg} });
325 my @sublist = sort { length $a <=> length $b } @tmplist;
327 pop @sublist while (scalar @sublist > 3);
329 $pkg =~ s/\,/\037\,\037/g; # underline ','.
330 push(@list, "(". join(', ',@sublist) .") in $pkg");
332 # sort the total list from shortest to longest...
333 @list = sort { length $a <=> length $b } @list;
335 # show how long it took.
336 my $delta_time = &::timedelta($start_time);
337 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
339 my $prefix = "Debian Search of '$query' ";
340 if (scalar @list) { # @list.
341 &::performStrictReply( &::formListReply(0, $prefix, @list) );
346 &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug);
347 @list = &searchDesc($query);
350 my $prefix = "Debian Package/File/Desc Search of '$query' ";
351 &::performStrictReply( &::formListReply(0, $prefix, ) );
353 } elsif (scalar @list == 1) { # list = 1.
354 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
355 &infoPackages("info", $list[0]);
358 my $prefix = "Debian Desc Search of '$query' ";
359 &::performStrictReply( &::formListReply(0, $prefix, @list) );
364 # Usage: &searchAuthor($query);
366 my ($dist, $query) = &getDistroFromStr($_[0]);
367 &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug);
368 $query =~ s/^\s+|\s+$//g;
371 my $start_time = &::timeget();
372 &::status("Debian: starting author search.");
374 my %urls = fixDist($dist,'packages');
376 my ($bad,$good) = (0,0);
377 foreach (keys %urls) {
387 &::DEBUG("deb: good = $good, bad = $bad...") if ($debug);
389 if ($good == 0 and $bad != 0) {
390 &::DEBUG("deb: download 2.");
392 if (!&DebianDownload($dist, %urls)) {
393 &::ERROR("Debian(sA): could not download files.");
398 my (%maint, %pkg, $package);
399 open(IN,"zegrep -h '^Package|^Maintainer' $files |");
401 if (/^Package: (\S+)$/) {
404 } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
405 my($name,$email) = ($1,$2);
406 if ($package eq "") {
407 &::DEBUG("deb: sA: package == NULL.");
410 $maint{$name}{$email} = 1;
411 $pkg{$name}{$package} = 1;
416 &::WARN("debian: invalid line: '$_' (1).");
422 # TODO: can we use 'map' here?
423 foreach (grep /\Q$query\E/i, keys %maint) {
427 # TODO: should we only search email if '@' is used?
428 if (scalar keys %hash < 15) {
431 foreach $name (keys %maint) {
434 foreach $email (keys %{ $maint{$name} }) {
435 next unless ($email =~ /\Q$query\E/i);
436 next if (exists $hash{$name});
442 my @list = keys %hash;
443 if (scalar @list != 1) {
444 my $prefix = "Debian Author Search of '$query' ";
445 &::performStrictReply( &::formListReply(0, $prefix, @list) );
449 &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug);
451 my @pkg = sort keys %{ $pkg{$list[0]} };
453 # show how long it took.
454 my $delta_time = &::timedelta($start_time);
455 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
457 my $email = join(', ', keys %{ $maint{$list[0]} });
458 my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
459 &::performStrictReply( &::formListReply(0, $prefix, @pkg) );
463 # Usage: &searchDesc($query);
465 my ($dist, $query) = &getDistroFromStr($_[0]);
466 &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.") if ($debug);
467 $query =~ s/^\s+|\s+$//g;
470 my $start_time = &::timeget();
471 &::status("Debian: starting desc search.");
474 my ($bad,$good) = (0,0);
475 my %urls = fixDist($dist,'packages');
477 # XXX This should be abstracted elsewhere.
478 foreach (keys %urls) {
488 &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug);
490 if ($good == 0 and $bad != 0) {
491 &::DEBUG("deb: download 2c.") if ($debug);
493 if (!&DebianDownload($dist, %urls)) {
494 &::ERROR("deb: sD: could not download files.");
500 $regex =~ s/\./\\./g;
501 $regex =~ s/\*/\\S*/g;
504 my (%desc, $package);
505 open(IN,"zegrep -h '^Package|^Description' $files |");
507 if (/^Package: (\S+)$/) {
509 } elsif (/^Description: (.*)$/) {
511 next unless (eval { $desc =~ /$regex/i });
512 return unless &checkEval($@);
514 if ($package eq "") {
515 &::WARN("sD: package == NULL?");
519 $desc{$package} = $desc;
524 &::WARN("debian: invalid line: '$_'. (2)");
529 # show how long it took.
530 my $delta_time = &::timedelta($start_time);
531 &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
537 # Usage: &generateIncoming();
538 sub generateIncoming {
539 my $pkgfile = $debian_dir."/Packages-incoming";
540 my $idxfile = $pkgfile.".idx";
542 $stale++ if (&::isStale($pkgfile.".gz", $refresh));
543 $stale++ if (&::isStale($idxfile, $refresh));
544 &::DEBUG("deb: gI: stale => '$stale'.") if ($debug);
545 return 0 unless ($stale);
548 my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/");
550 if (!open PKG, ">$pkgfile") {
551 &::ERROR("cannot write to pkg $pkgfile.");
554 if (!open IDX, ">$idxfile") {
555 &::ERROR("cannot write to idx $idxfile.");
559 print IDX "*$pkgfile.gz\n";
561 foreach $file (sort keys %ftp) {
562 next unless ($file =~ /deb$/);
564 if ($file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/) {
566 print PKG "Package: $1\n";
567 print PKG "Version: $2\n";
568 print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n";
570 print PKG "Filename: $file\n";
571 print PKG "Size: $ftp{$file}\n";
577 system("gzip -9fv $pkgfile"); # lame fix.
579 &::status("Debian: generateIncoming() complete.");
583 ##############################
584 # DEBIAN PACKAGE INFO FUNCTIONS.
587 # Usage: &getPackageInfo($query,$file);
589 my ($package, $file) = @_;
592 &::status("gPI: file $file does not exist?");
599 open(IN, "/bin/zcat $file 2>&1 |");
605 next if (/^ \S+/); # package long description.
608 if (/^Package: (.*)\n$/) {
610 if ($pkg =~ /^\Q$package\E$/i) {
611 $found++; # we can use pkg{'package'} instead.
612 $pkg{'package'} = $pkg;
621 if (/^Version: (.*)$/) {
622 $pkg{'version'} = $1;
623 } elsif (/^Priority: (.*)$/) {
624 $pkg{'priority'} = $1;
625 } elsif (/^Section: (.*)$/) {
626 $pkg{'section'} = $1;
627 } elsif (/^Size: (.*)$/) {
629 } elsif (/^Installed-Size: (.*)$/i) {
630 $pkg{'installed'} = $1;
631 } elsif (/^Description: (.*)$/) {
633 } elsif (/^Filename: (.*)$/) {
635 } elsif (/^Pre-Depends: (.*)$/) {
636 $pkg{'depends'} = "pre-depends on $1";
637 } elsif (/^Depends: (.*)$/) {
638 if (exists $pkg{'depends'}) {
639 $pkg{'depends'} .= "; depends on $1";
641 $pkg{'depends'} = "depends on $1";
643 } elsif (/^Maintainer: (.*)$/) {
645 } elsif (/^Provides: (.*)$/) {
646 $pkg{'provides'} = $1;
647 } elsif (/^Suggests: (.*)$/) {
648 $pkg{'suggests'} = $1;
649 } elsif (/^Conflicts: (.*)$/) {
650 $pkg{'conflicts'} = $1;
653 ### &::DEBUG("=> '$_'.");
663 next if (defined $pkg);
671 # Usage: &infoPackages($query,$package);
673 my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1]));
675 &::status("Debian: Searching for package '$package' in '$dist'.");
677 # download packages file.
679 my %urls = &fixDist($dist,'packages');
680 if ($dist ne "incoming") {
681 &::DEBUG("deb: download 3.") if ($debug);
683 if (!&DebianDownload($dist, %urls)) { # no good download.
684 &::WARN("Debian(iP): could not download ANY files.");
688 # check if the package is valid.
690 my @files = &validPackage($package, $dist);
691 if (!scalar @files) {
692 &::status("Debian: no valid package found; checking incoming.");
693 @files = &validPackage($package, "incoming");
696 &::status("Debian: cool, it exists in incoming.");
699 &::msg($::who, "Package '$package' does not exist.");
704 if (scalar @files > 1) {
705 &::WARN("same package in more than one file; random.");
706 &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
707 $files[0] = &::getRandom(@files);
710 if (! -f $files[0]) {
711 &::WARN("files[0] ($files[0]) doesn't exist.");
712 &::msg($::who, "FIXME: $files[0] does not exist?");
716 ### TODO: if specific package is requested, note down that a version
717 ### exists in incoming.
720 my $file = $files[0];
723 ### TODO: use fe, dump to a hash. if only one version of the package
724 ### exists. do as normal otherwise list all versions.
726 &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
729 my %pkg = &getPackageInfo($package, $file);
731 $query = "info" if ($query eq "dinfo");
734 if ($query eq "info") {
735 if (scalar keys %pkg <= 5) {
736 &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).").");
738 &::DEBUG("deb: end of debianCheck()");
740 &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it...");
744 $pkg{'info'} = "\002(\002". $pkg{'desc'} ."\002)\002";
745 $pkg{'info'} .= ", section ".$pkg{'section'};
746 $pkg{'info'} .= ", is ".$pkg{'priority'};
747 # $pkg{'info'} .= ". Version: \002$pkg{'version'}\002";
748 $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)";
749 $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
750 $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
753 &::status("iP: info requested and pkg is in incoming, too.");
754 my %incpkg = &getPackageInfo($query, $debian_dir ."/Packages-incoming");
756 if (scalar keys %incpkg) {
757 $pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
759 &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
764 if ($dist eq "incoming") {
765 $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
766 $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
767 $pkg{'info'} .= ", is in incoming!!!";
770 if (!exists $pkg{$query}) {
771 if ($query eq "suggests") {
772 $pkg{$query} = "has no suggestions";
773 } elsif ($query eq "conflicts") {
774 $pkg{$query} = "does not conflict with any other package";
775 } elsif ($query eq "depends") {
776 $pkg{$query} = "does not depend on anything";
777 } elsif ($query eq "maint") {
778 $pkg{$query} = "has no maintainer";
780 $pkg{$query} = "has nothing about $query";
784 &::performStrictReply("$package: $pkg{$query}");
787 # Usage: &infoStats($dist);
790 $dist = &getDistro($dist);
791 return unless (defined $dist);
793 &::DEBUG("deb: infoS: dist => '$dist'.");
795 # download packages file if needed.
796 my %urls = &fixDist($dist,'packages');
797 &::DEBUG("deb: download 4.");
798 if (!&DebianDownload($dist, %urls)) {
799 &::WARN("Debian(iS): could not download ANY files.");
800 &::msg($::who, "Debian(iS): internal error.");
805 my %total = (count => 0, maint => 0, isize => 0, csize => 0);
807 foreach $file (keys %urls) {
808 &::DEBUG("deb: file => '$file'.");
809 if (exists $stats{$file}{'count'}) {
810 &::DEBUG("deb: hrm... duplicate open with $file???");
814 open(IN, "zcat $file 2>&1 |");
817 &::DEBUG("deb: iS: $file does not exist.");
824 next if (/^ \S+/); # package long description.
826 if (/^Package: (.*)\n$/) { # counter.
827 $stats{$file}{'count'}++;
829 } elsif (/^Maintainer: .* <(\S+)>$/) {
830 $stats{$file}{'maint'}{$1}++;
831 $total{'maint'}{$1}++;
832 } elsif (/^Size: (.*)$/) { # compressed size.
833 $stats{$file}{'csize'} += $1;
834 $total{'csize'} += $1;
835 } elsif (/^i.*size: (.*)$/i) { # installed size.
836 $stats{$file}{'isize'} += $1;
837 $total{'isize'} += $1;
840 ### &::DEBUG("=> '$_'.");
845 ### TODO: don't count ppl with multiple email addresses.
847 &::performStrictReply(
848 "Debian Distro Stats on $dist... ".
849 "\002$total{'count'}\002 packages, ".
850 "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ".
851 "\002". int($total{'isize'}/1024)."\002 MB installed size, ".
852 "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size."
855 ### TODO: do individual stats? if so, we need _another_ arg.
856 # foreach $file (keys %stats) {
857 # foreach (keys %{ $stats{$file} }) {
858 # &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
866 # HELPER FUNCTIONS FOR INFOPACKAGES...
869 # Usage: &generateIndex();
872 &::DEBUG("D: generateIndex($dists[0]) called! ".join(':',caller(),));
873 if (!scalar @dists or $dists[0] eq '') {
874 &::ERROR("gI: no dists to generate index.");
879 my $dist = &getDistro($_); # incase the alias is returned, possible?
880 my $idx = $debian_dir."/Packages-$dist.idx";
881 my %urls = fixDist($_,'packages');
883 # TODO: check if any of the Packages file have been updated then
884 # regenerate it, even if it's not stale.
885 # TODO: also, regenerate the index if the packages file is newer
887 next unless (&::isStale($idx, $refresh));
890 &::DEBUG("deb: gIndex: calling generateIncoming()!");
896 # &::DEBUG("deb: Copying old index of sarge to -old");
897 # system("cp $idx $idx-old");
900 &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug);
901 &DebianDownload($dist, &fixDist($dist,'packages') );
903 &::status("Debian: generating index for '$dist'.");
904 if (!open OUT, ">$idx") {
905 &::ERROR("cannot write to $idx.");
910 foreach $packages (keys %urls) {
911 if (! -e $packages) {
912 &::ERROR("gIndex: '$packages' does not exist?");
916 print OUT "*$packages\n";
917 open(IN,"zcat $packages |");
920 next unless (/^Package: (.*)\n$/);
931 # Usage: &validPackage($package, $dist);
933 my ($package,$dist) = @_;
937 ### this majorly sucks, we need some standard in place.
938 # why is this needed... need to investigate later.
940 $dist = &getDistro($dist);
942 &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug);
945 while (!open IN, $debian_dir."/Packages-$dist.idx") {
947 &::ERROR("Packages-$dist.idx does not exist (#1).");
951 &generateIndex($dist);
963 if (/^\Q$package\E\n$/) {
970 &::VERB("vP: scanned $count items in index.",2);
976 my ($dist, $query) = &getDistroFromStr($_[0]);
977 my $file = $debian_dir."/Packages-$dist.idx";
978 my $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0;
982 &::status("Debian: Search package matching '$query' in '$dist'.");
983 unlink $file if ( -z $file );
985 while (!open IN, $file) {
986 if ($dist eq "incoming") {
987 &::DEBUG("deb: sP: dist == incoming; calling gI().");
992 &::ERROR("could not generate index ($file)!");
997 &::DEBUG("deb: should we be doing this?");
998 &generateIndex(($dist));
1007 if (&::isStale($file, $refresh)) {
1008 &::DEBUG("deb: STALE $file! regen.") if ($debug);
1009 &generateIndex(($dist));
1010 ### @files = searchPackage("$query $dist");
1011 &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug);
1024 if (scalar @files and $warn) {
1025 &::msg($::who, "searching for package name should be fully lowercase!");
1034 if (!defined $dist or $dist eq "") {
1035 &::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
1036 $dist = $defaultdist;
1039 if (exists $dists{$dist}) {
1040 &::VERB("gD: returning dists{$dist} ($dists{$dist})",2);
1041 return $dists{$dist};
1044 elsif (exists $archived_dists{$dist}){
1045 &::VERB("gD: returning archivedists{$dist} ($archived_dists{$dist})",2);
1046 return $archived_dists{$dist};
1049 if (!grep(/^\Q$dist\E$/i, %dists) and !grep(/^\Q$dist\E$/i, %archived_dists)) {
1050 &::msg($::who, "invalid dist '$dist'.");
1054 &::VERB("gD: returning $dist (no change or conversion)",2);
1059 sub getDistroFromStr {
1061 my $dists = join '|', %dists, %archived_dists;
1062 my $dist = $defaultdist;
1064 if ($str =~ s/\s+($dists)$//i) {
1065 $dist = &getDistro(lc $1);
1068 $str =~ s/\\([\$\^])/$1/g;
1074 my ($dist, $type) = @_;
1079 if (exists $archived_dists{$dist}){
1080 if ($type eq 'contents'){
1081 %dist_urls = %archiveurlcontents;
1084 %dist_urls = %archiveurlpackages;
1088 if ($type eq 'contents'){
1089 %dist_urls = %urlcontents;
1092 %dist_urls = %urlpackages;
1096 while (($key,$val) = each %dist_urls) {
1097 $key =~ s/##DIST/$dist/;
1098 $val =~ s/##DIST/$dist/;
1099 ### TODO: what should we do if the sar wasn't done.
1100 $new{$debian_dir."/".$key} = $val;
1109 my ($dist, $query) = &getDistroFromStr($str);
1110 my @results = sort &searchPackage($str);
1112 if (!scalar @results) {
1113 &::Forker("Debian", sub { &searchContents($str); } );
1114 } elsif (scalar @results == 1) {
1115 &::status("searchPackage returned one result; getting info of package instead!");
1116 &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } );
1118 my $prefix = "Debian Package Listing of '$query' ";
1119 &::performStrictReply( &::formListReply(0, $prefix, @results) );
1126 &::status("debianCheck() called.");
1128 ### TODO: remove the following loop (check if dir exists before)
1130 last if (opendir(DEBIAN, $debian_dir));
1133 &::ERROR("dC: cannot opendir debian.");
1137 mkdir $debian_dir, 0755;
1143 while (defined($file = readdir DEBIAN)) {
1144 next unless ($file =~ /(gz|bz2)$/);
1146 # TODO: add bzip2 support (debian doesn't do .bz2 anyway)
1147 my $exit = system("/bin/gzip -t '$debian_dir/$file'");
1148 next unless ($exit);
1149 &::DEBUG("deb: hmr... => ".(time() - (stat($debian_dir/$file))[8])."'.");
1150 next unless (time() - (stat($file))[8] > 3600);
1152 #&::DEBUG("deb: dC: exit => '$exit'.");
1153 &::WARN("dC: '$debian_dir/$file' corrupted? deleting!");
1154 unlink $debian_dir."/".$file;
1165 &::WARN("cE: $str");
1173 # &::DEBUG("deb: FE called for searchDesc");
1175 my @list = &searchDesc($query);
1177 if (!scalar @list) {
1178 my $prefix = "Debian Desc Search of '$query' ";
1179 &::performStrictReply( &::formListReply(0, $prefix, ) );
1180 } elsif (scalar @list == 1) { # list = 1.
1181 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
1182 &infoPackages("info", $list[0]);
1183 } else { # list > 1.
1184 my $prefix = "Debian Desc Search of '$query' ";
1185 &::performStrictReply( &::formListReply(0, $prefix, @list) );