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".
31 'testing' => 'wheezy',
32 'stable' => 'squeeze',
33 'experimental' => 'experimental',
34 'oldstable' => 'lenny',
35 'incoming' => 'incoming',
38 my %archived_dists = (
51 my %archiveurlcontents =
52 ( "Contents-##DIST-$arch.gz" =>
53 "$protocol://debian.crosslink.net/debian-archive"
54 . "/dists/##DIST/Contents-$arch.gz", );
56 my %archiveurlpackages = (
57 "Packages-##DIST-main-$arch.gz" =>
58 "$protocol://debian.crosslink.net/debian-archive".
59 "/dists/##DIST/main/binary-$arch/Packages.gz",
60 "Packages-##DIST-contrib-$arch.gz" =>
61 "$protocol://debian.crosslink.net/debian-archive".
62 "/dists/##DIST/contrib/binary-$arch/Packages.gz",
63 "Packages-##DIST-non-free-$arch.gz" =>
64 "$protocol://debian.crosslink.net/debian-archive".
65 "/dists/##DIST/non-free/binary-$arch/Packages.gz",
69 "Contents-##DIST-$arch.gz" => "$protocol://ftp.$country.debian.org"
70 . "/debian/dists/##DIST/Contents-$arch.gz",
71 "Contents-##DIST-$arch-non-US.gz" => "$protocol://non-us.debian.org"
72 . "/debian-non-US/dists/##DIST/non-US/Contents-$arch.gz",
76 "Packages-##DIST-main-$arch.gz" => "$protocol://ftp.$country.debian.org"
77 . "/debian/dists/##DIST/main/binary-$arch/Packages.gz",
78 "Packages-##DIST-contrib-$arch.gz" => "$protocol://ftp.$country.debian.org"
79 . "/debian/dists/##DIST/contrib/binary-$arch/Packages.gz",
80 "Packages-##DIST-non-free-$arch.gz" => "$protocol://ftp.$country.debian.org"
81 . "/debian/dists/##DIST/non-free/binary-$arch/Packages.gz",
85 ### COMMON FUNCTION....
86 #######################
89 # Usage: &DebianDownload($dist, %hash);
91 my ( $dist, %urls ) = @_;
95 if ( !-d $debian_dir ) {
96 &::status("Debian: creating debian dir.");
97 mkdir( $debian_dir, 0755 );
101 # Download the files.
103 foreach $file ( keys %urls ) {
104 my $url = $urls{$file};
105 $url =~ s/##DIST/$dist/g;
106 $file =~ s/##DIST/$dist/g;
110 my $last_refresh = ( stat $file )[9];
111 $update++ if ( time() - $last_refresh > $refresh );
117 next unless ($update);
119 &::DEBUG("announce == $announce.") if ($debug);
120 if ( $good + $bad == 0 and !$announce ) {
121 &::status("Debian: Downloading files for '$dist'.");
122 &::msg( $::who, "Updating debian files... please wait." );
126 if ( exists $::debian{$url} ) {
127 &::DEBUG( "2: " . ( time - $::debian{$url} ) . " <= $refresh" )
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.");
143 elsif ( $url =~ /^http:\/\/\S+\/\S+$/ ) {
145 if ( !&::getURLAsFile( $url, $file ) ) {
146 &::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);
183 return -1 unless ($bad); # no download.
184 &::DEBUG("DD: !good and bad($bad). :(");
189 ###########################
190 # DEBIAN CONTENTS SEARCH FUNCTIONS.
194 # Usage: &searchContents($query);
196 my ( $dist, $query ) = &getDistroFromStr( $_[0] );
197 &::status("Debian: Contents search for '$query' in '$dist'.");
200 $dccsend++ if ( $query =~ s/^dcc\s+//i );
202 $query =~ s/\\([\^\$])/$1/g; # hrm?
203 $query =~ s/^\s+|\s+$//g;
205 if ( !&::validExec($query) ) {
206 &::msg( $::who, 'search string looks fuzzy.' );
210 my %urls = fixDist( $dist, 'contents' );
211 if ( $dist eq 'incoming' ) { # nothing yet.
212 &::DEBUG('sC: dist = "incoming". no contents yet.');
217 # download contents file.
218 &::DEBUG('deb: download 1.') if ($debug);
219 if ( !&DebianDownload( $dist, %urls ) ) {
220 &::WARN('Debian: could not download files.');
225 my $start_time = &::timeget();
231 ### TODO: search properly if /usr/bin/blah is done.
232 if ( $query =~ s/\$$// ) {
233 &::DEBUG("deb: search-regex found.") if ($debug);
234 $grepRE = "$query\[ \t]";
236 elsif ( $query =~ s/^\^// ) {
237 &::DEBUG("deb: front marker regex found.") if ($debug);
242 $grepRE = "$query*\[ \t]";
245 # fix up grepRE for "*".
246 $grepRE =~ s/\*/.*/g;
249 foreach ( keys %urls ) {
250 next unless ( -f $_ );
254 if ( !scalar @files ) {
255 &::ERROR("sC: no files?");
256 &::msg( $::who, "failed." );
260 my $files = join( ' ', @files );
263 $regex =~ s/\./\\./g;
264 $regex =~ s/\*/\\S*/g;
267 open( IN, "zegrep -h '$grepRE' $files |" );
269 # wonderful abuse of if, last, next, return, and, unless ;)
271 last if ( $found > 100 );
273 next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/);
274 my ( $file, $package ) = ( "/" . $1, $2 );
276 if ( $query =~ /[\/\*\\]/ ) {
277 next unless ( eval { $file =~ /$regex/ } );
278 return unless &checkEval($@);
281 my ($basename) = $file =~ /^.*\/(.*)$/;
282 next unless ( eval { $basename =~ /$regex/ } );
283 return unless &checkEval($@);
285 next if ( $query !~ /\.\d\.gz/ and $file =~ /\/man\// );
286 next if ( $front and eval { $file !~ /^\/$query/ } );
287 return unless &checkEval($@);
289 $contents{$package}{$file} = 1;
296 ### send results with dcc.
298 if ( exists $::dcc{'SEND'}{$::who} ) {
299 &::msg( $::who, "DCC already active!" );
303 if ( !scalar %contents ) {
304 &::msg( $::who, "search returned no results." );
308 my $file = "$::param{tempDir}/$::who.txt";
309 if ( !open OUT, ">$file" ) {
310 &::ERROR("Debian: cannot write file for dcc send.");
314 foreach $pkg ( keys %contents ) {
315 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" );
341 # sort the total list from shortest to longest...
342 @list = sort { length $a <=> length $b } @list;
344 # show how long it took.
345 my $delta_time = &::timedelta($start_time);
346 &::status( sprintf( "Debian: %.02f sec to complete query.", $delta_time ) )
347 if ( $delta_time > 0 );
349 my $prefix = "Debian Search of '$query' ";
350 if ( scalar @list ) { # @list.
351 &::performStrictReply( &::formListReply( 0, $prefix, @list ) );
356 &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug);
357 @list = &searchDesc($query);
359 if ( !scalar @list ) {
360 my $prefix = "Debian Package/File/Desc Search of '$query' ";
361 &::performStrictReply( &::formListReply( 0, $prefix, ) );
364 elsif ( scalar @list == 1 ) { # list = 1.
365 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
366 &infoPackages( "info", $list[0] );
370 my $prefix = "Debian Desc Search of '$query' ";
371 &::performStrictReply( &::formListReply( 0, $prefix, @list ) );
376 # Usage: &searchAuthor($query);
378 my ( $dist, $query ) = &getDistroFromStr( $_[0] );
379 &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.")
381 $query =~ s/^\s+|\s+$//g;
384 my $start_time = &::timeget();
385 &::status("Debian: starting author search.");
387 my %urls = fixDist( $dist, 'packages' );
389 my ( $bad, $good ) = ( 0, 0 );
390 foreach ( keys %urls ) {
400 &::DEBUG("deb: good = $good, bad = $bad...") if ($debug);
402 if ( $good == 0 and $bad != 0 ) {
403 &::DEBUG("deb: download 2.");
405 if ( !&DebianDownload( $dist, %urls ) ) {
406 &::ERROR("Debian(sA): could not download files.");
411 my ( %maint, %pkg, $package );
412 open( IN, "zegrep -h '^Package|^Maintainer' $files |" );
414 if (/^Package: (\S+)$/) {
418 elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
419 my ( $name, $email ) = ( $1, $2 );
420 if ( $package eq "" ) {
421 &::DEBUG("deb: sA: package == NULL.");
424 $maint{$name}{$email} = 1;
425 $pkg{$name}{$package} = 1;
431 &::WARN("debian: invalid line: '$_' (1).");
438 # TODO: can we use 'map' here?
439 foreach ( grep /\Q$query\E/i, keys %maint ) {
443 # TODO: should we only search email if '@' is used?
444 if ( scalar keys %hash < 15 ) {
447 foreach $name ( keys %maint ) {
450 foreach $email ( keys %{ $maint{$name} } ) {
451 next unless ( $email =~ /\Q$query\E/i );
452 next if ( exists $hash{$name} );
458 my @list = keys %hash;
459 if ( scalar @list != 1 ) {
460 my $prefix = "Debian Author Search of '$query' ";
461 &::performStrictReply( &::formListReply( 0, $prefix, @list ) );
465 &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug);
467 my @pkg = sort keys %{ $pkg{ $list[0] } };
469 # show how long it took.
470 my $delta_time = &::timedelta($start_time);
471 &::status( sprintf( "Debian: %.02f sec to complete query.", $delta_time ) )
472 if ( $delta_time > 0 );
474 my $email = join( ', ', keys %{ $maint{ $list[0] } } );
475 my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
476 &::performStrictReply( &::formListReply( 0, $prefix, @pkg ) );
480 # Usage: &searchDesc($query);
482 my ( $dist, $query ) = &getDistroFromStr( $_[0] );
483 &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.")
485 $query =~ s/^\s+|\s+$//g;
488 my $start_time = &::timeget();
489 &::status("Debian: starting desc search.");
492 my ( $bad, $good ) = ( 0, 0 );
493 my %urls = fixDist( $dist, 'packages' );
495 # XXX This should be abstracted elsewhere.
496 foreach ( keys %urls ) {
506 &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug);
508 if ( $good == 0 and $bad != 0 ) {
509 &::DEBUG("deb: download 2c.") if ($debug);
511 if ( !&DebianDownload( $dist, %urls ) ) {
512 &::ERROR("deb: sD: could not download files.");
518 $regex =~ s/\./\\./g;
519 $regex =~ s/\*/\\S*/g;
522 my ( %desc, $package );
523 open( IN, "zegrep -h '^Package|^Description' $files |" );
525 if (/^Package: (\S+)$/) {
528 elsif (/^Description: (.*)$/) {
530 next unless ( eval { $desc =~ /$regex/i } );
531 return unless &checkEval($@);
533 if ( $package eq "" ) {
534 &::WARN("sD: package == NULL?");
538 $desc{$package} = $desc;
544 &::WARN("debian: invalid line: '$_'. (2)");
549 # show how long it took.
550 my $delta_time = &::timedelta($start_time);
551 &::status( sprintf( "Debian: %.02f sec to complete query.", $delta_time ) )
552 if ( $delta_time > 0 );
558 # Usage: &generateIncoming();
559 sub generateIncoming {
560 my $pkgfile = $debian_dir . "/Packages-incoming";
561 my $idxfile = $pkgfile . ".idx";
563 $stale++ if ( &::isStale( $pkgfile . ".gz", $refresh ) );
564 $stale++ if ( &::isStale( $idxfile, $refresh ) );
565 &::DEBUG("deb: gI: stale => '$stale'.") if ($debug);
566 return 0 unless ($stale);
569 my %ftp = &::ftpList( "llug.sep.bnl.gov", "/pub/debian/Incoming/" );
571 if ( !open PKG, ">$pkgfile" ) {
572 &::ERROR("cannot write to pkg $pkgfile.");
575 if ( !open IDX, ">$idxfile" ) {
576 &::ERROR("cannot write to idx $idxfile.");
580 print IDX "*$pkgfile.gz\n";
582 foreach $file ( sort keys %ftp ) {
583 next unless ( $file =~ /deb$/ );
585 if ( $file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/ ) {
587 print PKG "Package: $1\n";
588 print PKG "Version: $2\n";
589 print PKG "Architecture: ", ( defined $4 ) ? $4 : "all", "\n";
591 print PKG "Filename: $file\n";
592 print PKG "Size: $ftp{$file}\n";
598 system("gzip -9fv $pkgfile"); # lame fix.
600 &::status("Debian: generateIncoming() complete.");
604 ##############################
605 # DEBIAN PACKAGE INFO FUNCTIONS.
608 # Usage: &getPackageInfo($query,$file);
610 my ( $package, $file ) = @_;
613 &::status("gPI: file $file does not exist?");
620 open( IN, "/bin/zcat $file 2>&1 |" );
626 next if (/^ \S+/); # package long description.
629 if (/^Package: (.*)\n$/) {
631 if ( $pkg =~ /^\Q$package\E$/i ) {
632 $found++; # we can use pkg{'package'} instead.
633 $pkg{'package'} = $pkg;
642 if (/^Version: (.*)$/) {
643 $pkg{'version'} = $1;
645 elsif (/^Priority: (.*)$/) {
646 $pkg{'priority'} = $1;
648 elsif (/^Section: (.*)$/) {
649 $pkg{'section'} = $1;
651 elsif (/^Size: (.*)$/) {
654 elsif (/^Installed-Size: (.*)$/i) {
655 $pkg{'installed'} = $1;
657 elsif (/^Description: (.*)$/) {
660 elsif (/^Filename: (.*)$/) {
663 elsif (/^Pre-Depends: (.*)$/) {
664 $pkg{'depends'} = "pre-depends on $1";
666 elsif (/^Depends: (.*)$/) {
667 if ( exists $pkg{'depends'} ) {
668 $pkg{'depends'} .= "; depends on $1";
671 $pkg{'depends'} = "depends on $1";
674 elsif (/^Maintainer: (.*)$/) {
677 elsif (/^Provides: (.*)$/) {
678 $pkg{'provides'} = $1;
680 elsif (/^Suggests: (.*)$/) {
681 $pkg{'suggests'} = $1;
683 elsif (/^Conflicts: (.*)$/) {
684 $pkg{'conflicts'} = $1;
687 ### &::DEBUG("=> '$_'.");
697 next if ( defined $pkg );
705 # Usage: &infoPackages($query,$package);
707 my ( $query, $dist, $package ) = ( $_[0], &getDistroFromStr( $_[1] ) );
709 &::status("Debian: Searching for package '$package' in '$dist'.");
711 # download packages file.
713 my %urls = &fixDist( $dist, 'packages' );
714 if ( $dist ne "incoming" ) {
715 &::DEBUG("deb: download 3.") if ($debug);
717 if ( !&DebianDownload( $dist, %urls ) ) { # no good download.
718 &::WARN("Debian(iP): could not download ANY files.");
722 # check if the package is valid.
724 my @files = &validPackage( $package, $dist );
725 if ( !scalar @files ) {
726 &::status("Debian: no valid package found; checking incoming.");
727 @files = &validPackage( $package, "incoming" );
729 if ( scalar @files ) {
730 &::status("Debian: cool, it exists in incoming.");
734 &::msg( $::who, "Package '$package' does not exist." );
739 if ( scalar @files > 1 ) {
740 &::WARN("same package in more than one file; random.");
741 &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
742 $files[0] = &::getRandom(@files);
745 if ( !-f $files[0] ) {
746 &::WARN("files[0] ($files[0]) doesn't exist.");
747 &::msg( $::who, "FIXME: $files[0] does not exist?" );
751 ### TODO: if specific package is requested, note down that a version
752 ### exists in incoming.
755 my $file = $files[0];
758 ### TODO: use fe, dump to a hash. if only one version of the package
759 ### exists. do as normal otherwise list all versions.
761 &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
764 my %pkg = &getPackageInfo( $package, $file );
766 $query = "info" if ( $query eq "dinfo" );
769 if ( $query eq "info" ) {
770 if ( scalar keys %pkg <= 5 ) {
771 &::DEBUG( "deb: running debianCheck() due to problems ("
772 . scalar( keys %pkg )
775 &::DEBUG("deb: end of debianCheck()");
778 "Debian: Package appears to exist but I could not retrieve info about it..."
783 $pkg{'info'} = "\002(\002" . $pkg{'desc'} . "\002)\002";
784 $pkg{'info'} .= ", section " . $pkg{'section'};
785 $pkg{'info'} .= ", is " . $pkg{'priority'};
787 # $pkg{'info'} .= ". Version: \002$pkg{'version'}\002";
788 $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)";
790 ", Packaged size: \002" . int( $pkg{'size'} / 1024 ) . "\002 kB";
791 $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
794 &::status("iP: info requested and pkg is in incoming, too.");
796 &getPackageInfo( $query, $debian_dir . "/Packages-incoming" );
798 if ( scalar keys %incpkg ) {
799 $pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
803 "iP: pkg $query is in incoming but we couldn't get any info?"
809 if ( $dist eq "incoming" ) {
810 $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
812 ", Packaged size: \002" . int( $pkg{'size'} / 1024 ) . "\002 kB";
813 $pkg{'info'} .= ", is in incoming!!!";
816 if ( !exists $pkg{$query} ) {
817 if ( $query eq "suggests" ) {
818 $pkg{$query} = "has no suggestions";
820 elsif ( $query eq "conflicts" ) {
821 $pkg{$query} = "does not conflict with any other package";
823 elsif ( $query eq "depends" ) {
824 $pkg{$query} = "does not depend on anything";
826 elsif ( $query eq "maint" ) {
827 $pkg{$query} = "has no maintainer";
830 $pkg{$query} = "has nothing about $query";
834 &::performStrictReply("$package: $pkg{$query}");
837 # Usage: &infoStats($dist);
840 $dist = &getDistro($dist);
841 return unless ( defined $dist );
843 &::DEBUG("deb: infoS: dist => '$dist'.");
845 # download packages file if needed.
846 my %urls = &fixDist( $dist, 'packages' );
847 &::DEBUG("deb: download 4.");
848 if ( !&DebianDownload( $dist, %urls ) ) {
849 &::WARN("Debian(iS): could not download ANY files.");
850 &::msg( $::who, "Debian(iS): internal error." );
855 my %total = ( count => 0, maint => 0, isize => 0, csize => 0 );
857 foreach $file ( keys %urls ) {
858 &::DEBUG("deb: file => '$file'.");
859 if ( exists $stats{$file}{'count'} ) {
860 &::DEBUG("deb: hrm... duplicate open with $file???");
864 open( IN, "zcat $file 2>&1 |" );
867 &::DEBUG("deb: iS: $file does not exist.");
874 next if (/^ \S+/); # package long description.
876 if (/^Package: (.*)\n$/) { # counter.
877 $stats{$file}{'count'}++;
880 elsif (/^Maintainer: .* <(\S+)>$/) {
881 $stats{$file}{'maint'}{$1}++;
882 $total{'maint'}{$1}++;
884 elsif (/^Size: (.*)$/) { # compressed size.
885 $stats{$file}{'csize'} += $1;
886 $total{'csize'} += $1;
888 elsif (/^i.*size: (.*)$/i) { # installed size.
889 $stats{$file}{'isize'} += $1;
890 $total{'isize'} += $1;
893 ### &::DEBUG("=> '$_'.");
898 ### TODO: don't count ppl with multiple email addresses.
900 &::performStrictReply( "Debian Distro Stats on $dist... "
901 . "\002$total{'count'}\002 packages, " . "\002"
902 . scalar( keys %{ $total{'maint'} } )
903 . "\002 maintainers, " . "\002"
904 . int( $total{'isize'} / 1024 )
905 . "\002 MB installed size, " . "\002"
906 . int( $total{'csize'} / 1024 / 1024 )
907 . "\002 MB compressed size." );
909 ### TODO: do individual stats? if so, we need _another_ arg.
910 # foreach $file (keys %stats) {
911 # foreach (keys %{ $stats{$file} }) {
912 # &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
920 # HELPER FUNCTIONS FOR INFOPACKAGES...
923 # Usage: &generateIndex();
926 &::DEBUG( "D: generateIndex($dists[0]) called! " . join( ':', caller(), ) );
927 if ( !scalar @dists or $dists[0] eq '' ) {
928 &::ERROR("gI: no dists to generate index.");
933 my $dist = &getDistro($_); # incase the alias is returned, possible?
934 my $idx = $debian_dir . "/Packages-$dist.idx";
935 my %urls = fixDist( $_, 'packages' );
937 # TODO: check if any of the Packages file have been updated then
938 # regenerate it, even if it's not stale.
939 # TODO: also, regenerate the index if the packages file is newer
941 next unless ( &::isStale( $idx, $refresh ) );
944 &::DEBUG("deb: gIndex: calling generateIncoming()!");
950 # &::DEBUG("deb: Copying old index of sarge to -old");
951 # system("cp $idx $idx-old");
954 &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).")
956 &DebianDownload( $dist, &fixDist( $dist, 'packages' ) );
958 &::status("Debian: generating index for '$dist'.");
959 if ( !open OUT, ">$idx" ) {
960 &::ERROR("cannot write to $idx.");
965 foreach $packages ( keys %urls ) {
966 if ( !-e $packages ) {
967 &::ERROR("gIndex: '$packages' does not exist?");
971 print OUT "*$packages\n";
972 open( IN, "zcat $packages |" );
975 next unless (/^Package: (.*)\n$/);
986 # Usage: &validPackage($package, $dist);
988 my ( $package, $dist ) = @_;
992 ### this majorly sucks, we need some standard in place.
993 # why is this needed... need to investigate later.
995 $dist = &getDistro($dist);
997 &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug);
1000 while ( !open IN, $debian_dir . "/Packages-$dist.idx" ) {
1002 &::ERROR("Packages-$dist.idx does not exist (#1).");
1006 &generateIndex($dist);
1018 if (/^\Q$package\E\n$/) {
1019 push( @files, $file );
1025 &::VERB( "vP: scanned $count items in index.", 2 );
1031 my ( $dist, $query ) = &getDistroFromStr( $_[0] );
1032 my $file = $debian_dir . "/Packages-$dist.idx";
1033 my $warn = ( $query =~ tr/A-Z/a-z/ ) ? 1 : 0;
1037 &::status("Debian: Search package matching '$query' in '$dist'.");
1038 unlink $file if ( -z $file );
1040 while ( !open IN, $file ) {
1041 if ( $dist eq "incoming" ) {
1042 &::DEBUG("deb: sP: dist == incoming; calling gI().");
1043 &generateIncoming();
1047 &::ERROR("could not generate index ($file)!");
1052 &::DEBUG("deb: should we be doing this?");
1053 &generateIndex( ($dist) );
1062 if ( &::isStale( $file, $refresh ) ) {
1063 &::DEBUG("deb: STALE $file! regen.") if ($debug);
1064 &generateIndex( ($dist) );
1065 ### @files = searchPackage("$query $dist");
1066 &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug);
1079 if ( scalar @files and $warn ) {
1081 "searching for package name should be fully lowercase!" );
1090 if ( !defined $dist or $dist eq "" ) {
1091 &::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
1092 $dist = $defaultdist;
1095 if ( exists $dists{$dist} ) {
1096 &::VERB( "gD: returning dists{$dist} ($dists{$dist})", 2 );
1097 return $dists{$dist};
1100 elsif ( exists $archived_dists{$dist} ) {
1101 &::VERB( "gD: returning archivedists{$dist} ($archived_dists{$dist})",
1103 return $archived_dists{$dist};
1106 if ( !grep( /^\Q$dist\E$/i, %dists )
1107 and !grep( /^\Q$dist\E$/i, %archived_dists ) )
1109 &::msg( $::who, "invalid dist '$dist'." );
1113 &::VERB( "gD: returning $dist (no change or conversion)", 2 );
1118 sub getDistroFromStr {
1120 my $dists = join '|', %dists, %archived_dists;
1121 my $dist = $defaultdist;
1123 if ( $str =~ s/\s+($dists)$//i ) {
1124 $dist = &getDistro( lc $1 );
1127 $str =~ s/\\([\$\^])/$1/g;
1129 return ( $dist, $str );
1133 my ( $dist, $type ) = @_;
1138 if ( exists $archived_dists{$dist} ) {
1139 if ( $type eq 'contents' ) {
1140 %dist_urls = %archiveurlcontents;
1143 %dist_urls = %archiveurlpackages;
1147 if ( $type eq 'contents' ) {
1148 %dist_urls = %urlcontents;
1151 %dist_urls = %urlpackages;
1155 while ( ( $key, $val ) = each %dist_urls ) {
1156 $key =~ s/##DIST/$dist/;
1157 $val =~ s/##DIST/$dist/;
1158 ### TODO: what should we do if the sar wasn't done.
1159 $new{ $debian_dir . "/" . $key } = $val;
1169 my ( $dist, $query ) = &getDistroFromStr($str);
1170 my @results = sort &searchPackage($str);
1172 if ( !scalar @results ) {
1173 &::Forker( "Debian", sub { &searchContents($str); } );
1175 elsif ( scalar @results == 1 ) {
1177 "searchPackage returned one result; getting info of package instead!"
1179 &::Forker( "Debian",
1180 sub { &infoPackages( "info", "$results[0] $dist" ); } );
1183 my $prefix = "Debian Package Listing of '$query' ";
1184 &::performStrictReply( &::formListReply( 0, $prefix, @results ) );
1191 &::status("debianCheck() called.");
1193 ### TODO: remove the following loop (check if dir exists before)
1195 last if ( opendir( DEBIAN, $debian_dir ) );
1198 &::ERROR("dC: cannot opendir debian.");
1202 mkdir $debian_dir, 0755;
1208 while ( defined( $file = readdir DEBIAN ) ) {
1209 next unless ( $file =~ /(gz|bz2)$/ );
1211 # TODO: add bzip2 support (debian doesn't do .bz2 anyway)
1212 my $exit = system("/bin/gzip -t '$debian_dir/$file'");
1213 next unless ($exit);
1214 &::DEBUG( "deb: hmr... => "
1215 . ( time() - ( stat( $debian_dir / $file ) )[8] )
1217 next unless ( time() - ( stat($file) )[8] > 3600 );
1219 #&::DEBUG("deb: dC: exit => '$exit'.");
1220 &::WARN("dC: '$debian_dir/$file' corrupted? deleting!");
1221 unlink $debian_dir . "/" . $file;
1232 &::WARN("cE: $str");
1242 # &::DEBUG("deb: FE called for searchDesc");
1244 my @list = &searchDesc($query);
1246 if ( !scalar @list ) {
1247 my $prefix = "Debian Desc Search of '$query' ";
1248 &::performStrictReply( &::formListReply( 0, $prefix, ) );
1250 elsif ( scalar @list == 1 ) { # list = 1.
1251 &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
1252 &infoPackages( "info", $list[0] );
1255 my $prefix = "Debian Desc Search of '$query' ";
1256 &::performStrictReply( &::formListReply( 0, $prefix, @list ) );
1262 # vim:ts=4:sw=4:expandtab:tw=80