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';
19 &::getChanConfDefault( 'debianRefreshInterval', 7, $::chan ) * 60 * 60 * 24;
21 my $debian_dir = $::bot_state_dir . '/debian';
22 my $country = 'nl'; # well .config it yourself then. ;-)
23 my $protocol = 'http';
25 # EDIT THIS (i386, amd64, powerpc, [etc.]):
28 # format: "alias=real".
33 'experimental' => 'experimental',
34 'oldstable' => 'sarge',
35 'incoming' => 'incoming',
38 my %archived_dists = (
48 my %archiveurlcontents =
49 ( "Contents-##DIST-$arch.gz" =>
50 "$protocol://debian.crosslink.net/debian-archive"
51 . "/dists/##DIST/Contents-$arch.gz", );
53 my %archiveurlpackages = (
54 "Packages-##DIST-main-$arch.gz" =>
55 "$protocol://debian.crosslink.net/debian-archive".
56 "/dists/##DIST/main/binary-$arch/Packages.gz",
57 "Packages-##DIST-contrib-$arch.gz" =>
58 "$protocol://debian.crosslink.net/debian-archive".
59 "/dists/##DIST/contrib/binary-$arch/Packages.gz",
60 "Packages-##DIST-non-free-$arch.gz" =>
61 "$protocol://debian.crosslink.net/debian-archive".
62 "/dists/##DIST/non-free/binary-$arch/Packages.gz",
66 "Contents-##DIST-$arch.gz" => "$protocol://ftp.$country.debian.org"
67 . "/debian/dists/##DIST/Contents-$arch.gz",
68 "Contents-##DIST-$arch-non-US.gz" => "$protocol://non-us.debian.org"
69 . "/debian-non-US/dists/##DIST/non-US/Contents-$arch.gz",
73 "Packages-##DIST-main-$arch.gz" => "$protocol://ftp.$country.debian.org"
74 . "/debian/dists/##DIST/main/binary-$arch/Packages.gz",
75 "Packages-##DIST-contrib-$arch.gz" => "$protocol://ftp.$country.debian.org"
76 . "/debian/dists/##DIST/contrib/binary-$arch/Packages.gz",
77 "Packages-##DIST-non-free-$arch.gz" => "$protocol://ftp.$country.debian.org"
78 . "/debian/dists/##DIST/non-free/binary-$arch/Packages.gz",
82 ### COMMON FUNCTION....
83 #######################
86 # Usage: &DebianDownload($dist, %hash);
88 my ( $dist, %urls ) = @_;
92 if ( !-d $debian_dir ) {
93 &::status("Debian: creating debian dir.");
94 mkdir( $debian_dir, 0755 );
100 foreach $file ( keys %urls ) {
101 my $url = $urls{$file};
102 $url =~ s/##DIST/$dist/g;
103 $file =~ s/##DIST/$dist/g;
107 my $last_refresh = ( stat $file )[9];
108 $update++ if ( time() - $last_refresh > $refresh );
114 next unless ($update);
116 &::DEBUG("announce == $announce.") if ($debug);
117 if ( $good + $bad == 0 and !$announce ) {
118 &::status("Debian: Downloading files for '$dist'.");
119 &::msg( $::who, "Updating debian files... please wait." );
123 if ( exists $::debian{$url} ) {
124 &::DEBUG( "2: " . ( time - $::debian{$url} ) . " <= $refresh" )
126 next if ( time() - $::debian{$url} <= $refresh );
127 &::DEBUG("stale for url $url; updating!") if ($debug);
130 if ( $url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/ ) {
131 my ( $host, $path, $thisfile ) = ( $1, $2, $3 );
133 if ( !&::ftpGet( $host, $path, $thisfile, $file ) ) {
134 &::WARN("deb: down: $file == BAD.");
140 elsif ( $url =~ /^http:\/\/\S+\/\S+$/ ) {
142 if ( !&::getURLAsFile( $url, $file ) ) {
143 &::WARN("deb: down: http: $file == BAD.");
150 &::ERROR("Debian: invalid format of url => ($url).");
156 &::WARN("deb: down: http: !file");
161 # my $exit = system("/bin/gzip -t $file");
163 # &::WARN("deb: $file is corrupted ($exit) :/");
168 &::DEBUG("deb: download: good.") if ($debug);
172 # ok... lets just run this.
173 &::miscCheck() if ( &::whatInterface() =~ /IRC/ );
176 &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.');
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]";
233 elsif ( $query =~ s/^\^// ) {
234 &::DEBUG("deb: front marker regex found.") if ($debug);
239 $grepRE = "$query*\[ \t]";
242 # fix up grepRE for "*".
243 $grepRE =~ s/\*/.*/g;
246 foreach ( keys %urls ) {
247 next unless ( -f $_ );
251 if ( !scalar @files ) {
252 &::ERROR("sC: no files?");
253 &::msg( $::who, "failed." );
257 my $files = join( ' ', @files );
260 $regex =~ s/\./\\./g;
261 $regex =~ s/\*/\\S*/g;
264 open( IN, "zegrep -h '$grepRE' $files |" );
266 # wonderful abuse of if, last, next, return, and, unless ;)
268 last if ( $found > 100 );
270 next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/);
271 my ( $file, $package ) = ( "/" . $1, $2 );
273 if ( $query =~ /[\/\*\\]/ ) {
274 next unless ( eval { $file =~ /$regex/ } );
275 return unless &checkEval($@);
278 my ($basename) = $file =~ /^.*\/(.*)$/;
279 next unless ( eval { $basename =~ /$regex/ } );
280 return unless &checkEval($@);
282 next if ( $query !~ /\.\d\.gz/ and $file =~ /\/man\// );
283 next if ( $front and eval { $file !~ /^\/$query/ } );
284 return unless &checkEval($@);
286 $contents{$package}{$file} = 1;
293 ### send results with dcc.
295 if ( exists $::dcc{'SEND'}{$::who} ) {
296 &::msg( $::who, "DCC already active!" );
300 if ( !scalar %contents ) {
301 &::msg( $::who, "search returned no results." );
305 my $file = "$::param{tempDir}/$::who.txt";
306 if ( !open OUT, ">$file" ) {
307 &::ERROR("Debian: cannot write file for dcc send.");
311 foreach $pkg ( keys %contents ) {
312 foreach ( keys %{ $contents{$pkg} } ) {
314 # TODO: correct padding.
315 print OUT "$_\t\t\t$pkg\n";
320 &::shmWrite( $::shm, "DCC SEND $::who $file" );
325 &::status("Debian: $found contents results found.");
328 foreach $pkg ( keys %contents ) {
329 my @tmplist = &::fixFileList( keys %{ $contents{$pkg} } );
330 my @sublist = sort { length $a <=> length $b } @tmplist;
332 pop @sublist while ( scalar @sublist > 3 );
334 $pkg =~ s/\,/\037\,\037/g; # underline ','.
335 push( @list, "(" . join( ', ', @sublist ) . ") in $pkg" );
338 # sort the total list from shortest to longest...
339 @list = sort { length $a <=> length $b } @list;
341 # show how long it took.
342 my $delta_time = &::timedelta($start_time);
343 &::status( sprintf( "Debian: %.02f sec to complete query.", $delta_time ) )
344 if ( $delta_time > 0 );
346 my $prefix = "Debian Search of '$query' ";
347 if ( scalar @list ) { # @list.
348 &::performStrictReply( &::formListReply( 0, $prefix, @list ) );
353 &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug);
354 @list = &searchDesc($query);
356 if ( !scalar @list ) {
357 my $prefix = "Debian Package/File/Desc Search of '$query' ";
358 &::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] );
367 my $prefix = "Debian Desc Search of '$query' ";
368 &::performStrictReply( &::formListReply( 0, $prefix, @list ) );
373 # Usage: &searchAuthor($query);
375 my ( $dist, $query ) = &getDistroFromStr( $_[0] );
376 &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.")
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+)$/) {
415 elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
416 my ( $name, $email ) = ( $1, $2 );
417 if ( $package eq "" ) {
418 &::DEBUG("deb: sA: package == NULL.");
421 $maint{$name}{$email} = 1;
422 $pkg{$name}{$package} = 1;
428 &::WARN("debian: invalid line: '$_' (1).");
435 # TODO: can we use 'map' here?
436 foreach ( grep /\Q$query\E/i, keys %maint ) {
440 # TODO: should we only search email if '@' is used?
441 if ( scalar keys %hash < 15 ) {
444 foreach $name ( keys %maint ) {
447 foreach $email ( keys %{ $maint{$name} } ) {
448 next unless ( $email =~ /\Q$query\E/i );
449 next if ( exists $hash{$name} );
455 my @list = keys %hash;
456 if ( scalar @list != 1 ) {
457 my $prefix = "Debian Author Search of '$query' ";
458 &::performStrictReply( &::formListReply( 0, $prefix, @list ) );
462 &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug);
464 my @pkg = sort keys %{ $pkg{ $list[0] } };
466 # show how long it took.
467 my $delta_time = &::timedelta($start_time);
468 &::status( sprintf( "Debian: %.02f sec to complete query.", $delta_time ) )
469 if ( $delta_time > 0 );
471 my $email = join( ', ', keys %{ $maint{ $list[0] } } );
472 my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
473 &::performStrictReply( &::formListReply( 0, $prefix, @pkg ) );
477 # Usage: &searchDesc($query);
479 my ( $dist, $query ) = &getDistroFromStr( $_[0] );
480 &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.")
482 $query =~ s/^\s+|\s+$//g;
485 my $start_time = &::timeget();
486 &::status("Debian: starting desc search.");
489 my ( $bad, $good ) = ( 0, 0 );
490 my %urls = fixDist( $dist, 'packages' );
492 # XXX This should be abstracted elsewhere.
493 foreach ( keys %urls ) {
503 &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug);
505 if ( $good == 0 and $bad != 0 ) {
506 &::DEBUG("deb: download 2c.") if ($debug);
508 if ( !&DebianDownload( $dist, %urls ) ) {
509 &::ERROR("deb: sD: could not download files.");
515 $regex =~ s/\./\\./g;
516 $regex =~ s/\*/\\S*/g;
519 my ( %desc, $package );
520 open( IN, "zegrep -h '^Package|^Description' $files |" );
522 if (/^Package: (\S+)$/) {
525 elsif (/^Description: (.*)$/) {
527 next unless ( eval { $desc =~ /$regex/i } );
528 return unless &checkEval($@);
530 if ( $package eq "" ) {
531 &::WARN("sD: package == NULL?");
535 $desc{$package} = $desc;
541 &::WARN("debian: invalid line: '$_'. (2)");
546 # show how long it took.
547 my $delta_time = &::timedelta($start_time);
548 &::status( sprintf( "Debian: %.02f sec to complete query.", $delta_time ) )
549 if ( $delta_time > 0 );
555 # Usage: &generateIncoming();
556 sub generateIncoming {
557 my $pkgfile = $debian_dir . "/Packages-incoming";
558 my $idxfile = $pkgfile . ".idx";
560 $stale++ if ( &::isStale( $pkgfile . ".gz", $refresh ) );
561 $stale++ if ( &::isStale( $idxfile, $refresh ) );
562 &::DEBUG("deb: gI: stale => '$stale'.") if ($debug);
563 return 0 unless ($stale);
566 my %ftp = &::ftpList( "llug.sep.bnl.gov", "/pub/debian/Incoming/" );
568 if ( !open PKG, ">$pkgfile" ) {
569 &::ERROR("cannot write to pkg $pkgfile.");
572 if ( !open IDX, ">$idxfile" ) {
573 &::ERROR("cannot write to idx $idxfile.");
577 print IDX "*$pkgfile.gz\n";
579 foreach $file ( sort keys %ftp ) {
580 next unless ( $file =~ /deb$/ );
582 if ( $file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/ ) {
584 print PKG "Package: $1\n";
585 print PKG "Version: $2\n";
586 print PKG "Architecture: ", ( defined $4 ) ? $4 : "all", "\n";
588 print PKG "Filename: $file\n";
589 print PKG "Size: $ftp{$file}\n";
595 system("gzip -9fv $pkgfile"); # lame fix.
597 &::status("Debian: generateIncoming() complete.");
601 ##############################
602 # DEBIAN PACKAGE INFO FUNCTIONS.
605 # Usage: &getPackageInfo($query,$file);
607 my ( $package, $file ) = @_;
610 &::status("gPI: file $file does not exist?");
617 open( IN, "/bin/zcat $file 2>&1 |" );
623 next if (/^ \S+/); # package long description.
626 if (/^Package: (.*)\n$/) {
628 if ( $pkg =~ /^\Q$package\E$/i ) {
629 $found++; # we can use pkg{'package'} instead.
630 $pkg{'package'} = $pkg;
639 if (/^Version: (.*)$/) {
640 $pkg{'version'} = $1;
642 elsif (/^Priority: (.*)$/) {
643 $pkg{'priority'} = $1;
645 elsif (/^Section: (.*)$/) {
646 $pkg{'section'} = $1;
648 elsif (/^Size: (.*)$/) {
651 elsif (/^Installed-Size: (.*)$/i) {
652 $pkg{'installed'} = $1;
654 elsif (/^Description: (.*)$/) {
657 elsif (/^Filename: (.*)$/) {
660 elsif (/^Pre-Depends: (.*)$/) {
661 $pkg{'depends'} = "pre-depends on $1";
663 elsif (/^Depends: (.*)$/) {
664 if ( exists $pkg{'depends'} ) {
665 $pkg{'depends'} .= "; depends on $1";
668 $pkg{'depends'} = "depends on $1";
671 elsif (/^Maintainer: (.*)$/) {
674 elsif (/^Provides: (.*)$/) {
675 $pkg{'provides'} = $1;
677 elsif (/^Suggests: (.*)$/) {
678 $pkg{'suggests'} = $1;
680 elsif (/^Conflicts: (.*)$/) {
681 $pkg{'conflicts'} = $1;
684 ### &::DEBUG("=> '$_'.");
694 next if ( defined $pkg );
702 # Usage: &infoPackages($query,$package);
704 my ( $query, $dist, $package ) = ( $_[0], &getDistroFromStr( $_[1] ) );
706 &::status("Debian: Searching for package '$package' in '$dist'.");
708 # download packages file.
710 my %urls = &fixDist( $dist, 'packages' );
711 if ( $dist ne "incoming" ) {
712 &::DEBUG("deb: download 3.") if ($debug);
714 if ( !&DebianDownload( $dist, %urls ) ) { # no good download.
715 &::WARN("Debian(iP): could not download ANY files.");
719 # check if the package is valid.
721 my @files = &validPackage( $package, $dist );
722 if ( !scalar @files ) {
723 &::status("Debian: no valid package found; checking incoming.");
724 @files = &validPackage( $package, "incoming" );
726 if ( scalar @files ) {
727 &::status("Debian: cool, it exists in incoming.");
731 &::msg( $::who, "Package '$package' does not exist." );
736 if ( scalar @files > 1 ) {
737 &::WARN("same package in more than one file; random.");
738 &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
739 $files[0] = &::getRandom(@files);
742 if ( !-f $files[0] ) {
743 &::WARN("files[0] ($files[0]) doesn't exist.");
744 &::msg( $::who, "FIXME: $files[0] does not exist?" );
748 ### TODO: if specific package is requested, note down that a version
749 ### exists in incoming.
752 my $file = $files[0];
755 ### TODO: use fe, dump to a hash. if only one version of the package
756 ### exists. do as normal otherwise list all versions.
758 &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
761 my %pkg = &getPackageInfo( $package, $file );
763 $query = "info" if ( $query eq "dinfo" );
766 if ( $query eq "info" ) {
767 if ( scalar keys %pkg <= 5 ) {
768 &::DEBUG( "deb: running debianCheck() due to problems ("
769 . scalar( keys %pkg )
772 &::DEBUG("deb: end of debianCheck()");
775 "Debian: Package appears to exist but I could not retrieve info about it..."
780 $pkg{'info'} = "\002(\002" . $pkg{'desc'} . "\002)\002";
781 $pkg{'info'} .= ", section " . $pkg{'section'};
782 $pkg{'info'} .= ", is " . $pkg{'priority'};
784 # $pkg{'info'} .= ". Version: \002$pkg{'version'}\002";
785 $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)";
787 ", Packaged size: \002" . int( $pkg{'size'} / 1024 ) . "\002 kB";
788 $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
791 &::status("iP: info requested and pkg is in incoming, too.");
793 &getPackageInfo( $query, $debian_dir . "/Packages-incoming" );
795 if ( scalar keys %incpkg ) {
796 $pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
800 "iP: pkg $query is in incoming but we couldn't get any info?"
806 if ( $dist eq "incoming" ) {
807 $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
809 ", Packaged size: \002" . int( $pkg{'size'} / 1024 ) . "\002 kB";
810 $pkg{'info'} .= ", is in incoming!!!";
813 if ( !exists $pkg{$query} ) {
814 if ( $query eq "suggests" ) {
815 $pkg{$query} = "has no suggestions";
817 elsif ( $query eq "conflicts" ) {
818 $pkg{$query} = "does not conflict with any other package";
820 elsif ( $query eq "depends" ) {
821 $pkg{$query} = "does not depend on anything";
823 elsif ( $query eq "maint" ) {
824 $pkg{$query} = "has no maintainer";
827 $pkg{$query} = "has nothing about $query";
831 &::performStrictReply("$package: $pkg{$query}");
834 # Usage: &infoStats($dist);
837 $dist = &getDistro($dist);
838 return unless ( defined $dist );
840 &::DEBUG("deb: infoS: dist => '$dist'.");
842 # download packages file if needed.
843 my %urls = &fixDist( $dist, 'packages' );
844 &::DEBUG("deb: download 4.");
845 if ( !&DebianDownload( $dist, %urls ) ) {
846 &::WARN("Debian(iS): could not download ANY files.");
847 &::msg( $::who, "Debian(iS): internal error." );
852 my %total = ( count => 0, maint => 0, isize => 0, csize => 0 );
854 foreach $file ( keys %urls ) {
855 &::DEBUG("deb: file => '$file'.");
856 if ( exists $stats{$file}{'count'} ) {
857 &::DEBUG("deb: hrm... duplicate open with $file???");
861 open( IN, "zcat $file 2>&1 |" );
864 &::DEBUG("deb: iS: $file does not exist.");
871 next if (/^ \S+/); # package long description.
873 if (/^Package: (.*)\n$/) { # counter.
874 $stats{$file}{'count'}++;
877 elsif (/^Maintainer: .* <(\S+)>$/) {
878 $stats{$file}{'maint'}{$1}++;
879 $total{'maint'}{$1}++;
881 elsif (/^Size: (.*)$/) { # compressed size.
882 $stats{$file}{'csize'} += $1;
883 $total{'csize'} += $1;
885 elsif (/^i.*size: (.*)$/i) { # installed size.
886 $stats{$file}{'isize'} += $1;
887 $total{'isize'} += $1;
890 ### &::DEBUG("=> '$_'.");
895 ### TODO: don't count ppl with multiple email addresses.
897 &::performStrictReply( "Debian Distro Stats on $dist... "
898 . "\002$total{'count'}\002 packages, " . "\002"
899 . scalar( keys %{ $total{'maint'} } )
900 . "\002 maintainers, " . "\002"
901 . int( $total{'isize'} / 1024 )
902 . "\002 MB installed size, " . "\002"
903 . int( $total{'csize'} / 1024 / 1024 )
904 . "\002 MB compressed size." );
906 ### TODO: do individual stats? if so, we need _another_ arg.
907 # foreach $file (keys %stats) {
908 # foreach (keys %{ $stats{$file} }) {
909 # &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
917 # HELPER FUNCTIONS FOR INFOPACKAGES...
920 # Usage: &generateIndex();
923 &::DEBUG( "D: generateIndex($dists[0]) called! " . join( ':', caller(), ) );
924 if ( !scalar @dists or $dists[0] eq '' ) {
925 &::ERROR("gI: no dists to generate index.");
930 my $dist = &getDistro($_); # incase the alias is returned, possible?
931 my $idx = $debian_dir . "/Packages-$dist.idx";
932 my %urls = fixDist( $_, 'packages' );
934 # TODO: check if any of the Packages file have been updated then
935 # regenerate it, even if it's not stale.
936 # TODO: also, regenerate the index if the packages file is newer
938 next unless ( &::isStale( $idx, $refresh ) );
941 &::DEBUG("deb: gIndex: calling generateIncoming()!");
947 # &::DEBUG("deb: Copying old index of sarge to -old");
948 # system("cp $idx $idx-old");
951 &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).")
953 &DebianDownload( $dist, &fixDist( $dist, 'packages' ) );
955 &::status("Debian: generating index for '$dist'.");
956 if ( !open OUT, ">$idx" ) {
957 &::ERROR("cannot write to $idx.");
962 foreach $packages ( keys %urls ) {
963 if ( !-e $packages ) {
964 &::ERROR("gIndex: '$packages' does not exist?");
968 print OUT "*$packages\n";
969 open( IN, "zcat $packages |" );
972 next unless (/^Package: (.*)\n$/);
983 # Usage: &validPackage($package, $dist);
985 my ( $package, $dist ) = @_;
989 ### this majorly sucks, we need some standard in place.
990 # why is this needed... need to investigate later.
992 $dist = &getDistro($dist);
994 &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug);
997 while ( !open IN, $debian_dir . "/Packages-$dist.idx" ) {
999 &::ERROR("Packages-$dist.idx does not exist (#1).");
1003 &generateIndex($dist);
1015 if (/^\Q$package\E\n$/) {
1016 push( @files, $file );
1022 &::VERB( "vP: scanned $count items in index.", 2 );
1028 my ( $dist, $query ) = &getDistroFromStr( $_[0] );
1029 my $file = $debian_dir . "/Packages-$dist.idx";
1030 my $warn = ( $query =~ tr/A-Z/a-z/ ) ? 1 : 0;
1034 &::status("Debian: Search package matching '$query' in '$dist'.");
1035 unlink $file if ( -z $file );
1037 while ( !open IN, $file ) {
1038 if ( $dist eq "incoming" ) {
1039 &::DEBUG("deb: sP: dist == incoming; calling gI().");
1040 &generateIncoming();
1044 &::ERROR("could not generate index ($file)!");
1049 &::DEBUG("deb: should we be doing this?");
1050 &generateIndex( ($dist) );
1059 if ( &::isStale( $file, $refresh ) ) {
1060 &::DEBUG("deb: STALE $file! regen.") if ($debug);
1061 &generateIndex( ($dist) );
1062 ### @files = searchPackage("$query $dist");
1063 &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug);
1076 if ( scalar @files and $warn ) {
1078 "searching for package name should be fully lowercase!" );
1087 if ( !defined $dist or $dist eq "" ) {
1088 &::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
1089 $dist = $defaultdist;
1092 if ( exists $dists{$dist} ) {
1093 &::VERB( "gD: returning dists{$dist} ($dists{$dist})", 2 );
1094 return $dists{$dist};
1097 elsif ( exists $archived_dists{$dist} ) {
1098 &::VERB( "gD: returning archivedists{$dist} ($archived_dists{$dist})",
1100 return $archived_dists{$dist};
1103 if ( !grep( /^\Q$dist\E$/i, %dists )
1104 and !grep( /^\Q$dist\E$/i, %archived_dists ) )
1106 &::msg( $::who, "invalid dist '$dist'." );
1110 &::VERB( "gD: returning $dist (no change or conversion)", 2 );
1115 sub getDistroFromStr {
1117 my $dists = join '|', %dists, %archived_dists;
1118 my $dist = $defaultdist;
1120 if ( $str =~ s/\s+($dists)$//i ) {
1121 $dist = &getDistro( lc $1 );
1124 $str =~ s/\\([\$\^])/$1/g;
1126 return ( $dist, $str );
1130 my ( $dist, $type ) = @_;
1135 if ( exists $archived_dists{$dist} ) {
1136 if ( $type eq 'contents' ) {
1137 %dist_urls = %archiveurlcontents;
1140 %dist_urls = %archiveurlpackages;
1144 if ( $type eq 'contents' ) {
1145 %dist_urls = %urlcontents;
1148 %dist_urls = %urlpackages;
1152 while ( ( $key, $val ) = each %dist_urls ) {
1153 $key =~ s/##DIST/$dist/;
1154 $val =~ s/##DIST/$dist/;
1155 ### TODO: what should we do if the sar wasn't done.
1156 $new{ $debian_dir . "/" . $key } = $val;
1166 my ( $dist, $query ) = &getDistroFromStr($str);
1167 my @results = sort &searchPackage($str);
1169 if ( !scalar @results ) {
1170 &::Forker( "Debian", sub { &searchContents($str); } );
1172 elsif ( scalar @results == 1 ) {
1174 "searchPackage returned one result; getting info of package instead!"
1176 &::Forker( "Debian",
1177 sub { &infoPackages( "info", "$results[0] $dist" ); } );
1180 my $prefix = "Debian Package Listing of '$query' ";
1181 &::performStrictReply( &::formListReply( 0, $prefix, @results ) );
1188 &::status("debianCheck() called.");
1190 ### TODO: remove the following loop (check if dir exists before)
1192 last if ( opendir( DEBIAN, $debian_dir ) );
1195 &::ERROR("dC: cannot opendir debian.");
1199 mkdir $debian_dir, 0755;
1205 while ( defined( $file = readdir DEBIAN ) ) {
1206 next unless ( $file =~ /(gz|bz2)$/ );
1208 # TODO: add bzip2 support (debian doesn't do .bz2 anyway)
1209 my $exit = system("/bin/gzip -t '$debian_dir/$file'");
1210 next unless ($exit);
1211 &::DEBUG( "deb: hmr... => "
1212 . ( time() - ( stat( $debian_dir / $file ) )[8] )
1214 next unless ( time() - ( stat($file) )[8] > 3600 );
1216 #&::DEBUG("deb: dC: exit => '$exit'.");
1217 &::WARN("dC: '$debian_dir/$file' corrupted? deleting!");
1218 unlink $debian_dir . "/" . $file;
1229 &::WARN("cE: $str");
1239 # &::DEBUG("deb: FE called for searchDesc");
1241 my @list = &searchDesc($query);
1243 if ( !scalar @list ) {
1244 my $prefix = "Debian Desc Search of '$query' ";
1245 &::performStrictReply( &::formListReply( 0, $prefix, ) );
1247 elsif ( scalar @list == 1 ) { # list = 1.
1248 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
1249 &infoPackages( "info", $list[0] );
1252 my $prefix = "Debian Desc Search of '$query' ";
1253 &::performStrictReply( &::formListReply( 0, $prefix, @list ) );
1259 # vim:ts=4:sw=4:expandtab:tw=80