X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FModules%2FDebian.pl;h=48ce83026ca888b939970afa819ef3c9b5c275db;hb=c68ac9b2d4b88535c1a2cfa695f6c4f683f0373c;hp=8ddd66d89ae956ffafbe9663572ebdaf3bcb4aee;hpb=bc7f145a419f1a292949ac87352fcbb27d18a6de;p=infobot.git diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl index 8ddd66d..48ce830 100644 --- a/src/Modules/Debian.pl +++ b/src/Modules/Debian.pl @@ -11,52 +11,55 @@ use strict; # format: "alias=real". my $announce = 0; -my $defaultdist = "unstable"; +my $defaultdist = "sid"; my $refresh = &::getChanConfDefault("debianRefreshInterval",7) * 60 * 60 * 24; - +my $debug = 0; +my $debian_dir = "$::bot_state_dir/debian"; + +### ... old +#my %dists = ( +# "sid" => "unstable", +# "woody" => "testing", # new since 20001219. +# "potato" => "stable", +# "incoming" => "incoming", +#); + +### new... the right way. my %dists = ( "unstable" => "sid", "testing" => "woody", # new since 20001219. "stable" => "potato", "incoming" => "incoming", -### the following don't work. too much effort to get 3 types of distros -### to work harmoniously :-) - "slink" => "archive-2.1", - "hamm" => "archive-2.0", - "rex" => "archive-1.?", - "bo" => "archive-1.?", ); my %urlcontents = ( - "debian/Contents-##DIST-i386.gz" => + "Contents-##DIST-i386.gz" => "ftp://ftp.us.debian.org". "/debian/dists/##DIST/Contents-i386.gz", -### APPEARS TO BE FIXED? -# => strip control chars just to be safe. - "debian/Contents-##DIST-i386-non-US.gz" => + "Contents-##DIST-i386-non-US.gz" => "ftp://non-us.debian.org". "/debian-non-US/dists/##DIST/non-US/Contents-i386.gz", ); my %urlpackages = ( - "debian/Packages-##DIST-main-i386.gz" => + "Packages-##DIST-main-i386.gz" => "ftp://ftp.us.debian.org". "/debian/dists/##DIST/main/binary-i386/Packages.gz", - "debian/Packages-##DIST-contrib-i386.gz" => + "Packages-##DIST-contrib-i386.gz" => "ftp://ftp.us.debian.org". "/debian/dists/##DIST/contrib/binary-i386/Packages.gz", - "debian/Packages-##DIST-non-free-i386.gz" => + "Packages-##DIST-non-free-i386.gz" => "ftp://ftp.us.debian.org". "/debian/dists/##DIST/non-free/binary-i386/Packages.gz", - "debian/Packages-##DIST-non-US-main-i386.gz" => + "Packages-##DIST-non-US-main-i386.gz" => "ftp://non-us.debian.org". "/debian-non-US/dists/##DIST/non-US/main/binary-i386/Packages.gz", - "debian/Packages-##DIST-non-US-contrib-i386.gz" => + "Packages-##DIST-non-US-contrib-i386.gz" => "ftp://non-us.debian.org". "/debian-non-US/dists/##DIST/non-US/contrib/binary-i386/Packages.gz", - "debian/Packages-##DIST-non-US-non-free-i386.gz" => + "Packages-##DIST-non-US-non-free-i386.gz" => "ftp://non-us.debian.org". "/debian-non-US/dists/##DIST/non-US/non-free/binary-i386/Packages.gz", ); @@ -66,29 +69,28 @@ my %urlpackages = ( ####################### #### -# Usage: &DebianDownload(%hash); +# Usage: &DebianDownload($dist, %hash); sub DebianDownload { my ($dist, %urls) = @_; my $bad = 0; my $good = 0; - if (! -d "debian/") { + if (! -d $debian_dir) { &::status("Debian: creating debian dir."); - mkdir("debian/",0755); + mkdir($debian_dir, 0755); } # fe dists. # Download the files. my $file; -## my %ret; foreach $file (keys %urls) { my $url = $urls{$file}; $url =~ s/##DIST/$dist/g; $file =~ s/##DIST/$dist/g; my $update = 0; - if ( -f $file) { - my $last_refresh = (stat($file))[9]; + if ( -f $file ) { + my $last_refresh = (stat $file)[9]; $update++ if (time() - $last_refresh > $refresh); } else { $update++; @@ -96,7 +98,7 @@ sub DebianDownload { next unless ($update); - &::DEBUG("announce == $announce."); + &::DEBUG("announce == $announce.") if ($debug); if ($good + $bad == 0 and !$announce) { &::status("Debian: Downloading files for '$dist'."); &::msg($::who, "Updating debian files... please wait."); @@ -104,22 +106,21 @@ sub DebianDownload { } if (exists $::debian{$url}) { - &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh"); + &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug); next if (time() - $::debian{$url} <= $refresh); - &::DEBUG("stale for url $url; updating!"); + &::DEBUG("stale for url $url; updating!") if ($debug); } if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) { my ($host,$path,$thisfile) = ($1,$2,$3); - # error internally to ftp. - # hope it doesn't do anything bad. - if ($file =~ /Contents-woody-i386-non-US/) { - &::DEBUG("Skipping Contents-woody-i386-non-US."); +### HACK 1 +# if ($file =~ /Contents-woody-i386-non-US/) { +# &::DEBUG("Skipping Contents-woody-i386-non-US."); # $file =~ s/woody/potato/; # $path =~ s/woody/potato/; -### next; - } +# next; +# } if (!&::ftpGet($host,$path,$thisfile,$file)) { &::WARN("deb: down: $file == BAD."); @@ -128,18 +129,18 @@ sub DebianDownload { } if (! -f $file) { - &::DEBUG("deb: down: ftpGet: !file"); + &::WARN("deb: down: ftpGet: !file"); $bad++; next; } - if ($file =~ /Contents-potato-i386-non-US/) { - &::DEBUG("hack: using potato's non-US contents for woody."); - system("cp debian/Contents-potato-i386-non-US.gz debian/Contents-woody-i386-non-US.gz"); - } +### HACK2 +# if ($file =~ /Contents-potato-i386-non-US/) { +# &::DEBUG("hack: using potato's non-US contents for woody."); +# system("cp debian/Contents-potato-i386-non-US.gz debian/Contents-woody-i386-non-US.gz"); +# } - &::DEBUG("deb: download: good."); -## $ret{$ + &::DEBUG("deb: download: good.") if ($debug); $good++; } else { &::ERROR("Debian: invalid format of url => ($url)."); @@ -148,6 +149,9 @@ sub DebianDownload { } } + # ok... lets just run this. + &::miscCheck(); + if ($good) { &generateIndex($dist); return 1; @@ -166,12 +170,10 @@ sub DebianDownload { # Usage: &searchContents($query); sub searchContents { my ($dist, $query) = &getDistroFromStr($_[0]); - &::status("Debian: Contents search for '$query' on $dist."); + &::status("Debian: Contents search for '$query' in '$dist'."); my $dccsend = 0; $dccsend++ if ($query =~ s/^dcc\s+//i); - ### larne's regex. - # $query = $query.'(\.so\.)?([.[[:digit:]]+\.]+)?$'; $query =~ s/\\([\^\$])/$1/g; # hrm? $query =~ s/^\s+|\s+$//g; @@ -187,7 +189,7 @@ sub searchContents { } else { my %urls = &fixDist($dist, %urlcontents); # download contents file. - &::DEBUG("deb: download 1."); + &::DEBUG("deb: download 1.") if ($debug); if (!&DebianDownload($dist, %urls)) { &::WARN("Debian: could not download files."); } @@ -196,31 +198,31 @@ sub searchContents { # start of search. my $start_time = &::timeget(); - my $found = 0; + my $found = 0; + my $front = 0; my %contents; my $grepRE; - my $front = 0; ### TODO: search properly if /usr/bin/blah is done. if ($query =~ s/\$$//) { - &::DEBUG("search-regex found."); + &::DEBUG("deb: search-regex found.") if ($debug); $grepRE = "$query\[ \t]"; } elsif ($query =~ s/^\^//) { - &::DEBUG("front marker regex found."); + &::DEBUG("deb: front marker regex found.") if ($debug); $front = 1; $grepRE = $query; } else { $grepRE = "$query*\[ \t]"; } - ### fix up grepRE for "*". + # fix up grepRE for "*". $grepRE =~ s/\*/.*/g; my @files; foreach (keys %urlcontents) { s/##DIST/$dist/g; - next unless ( -f $_); - push(@files,$_); + next unless ( -f "$debian_dir/$_" ); + push(@files, "$debian_dir/$_"); } if (!scalar @files) { @@ -231,24 +233,33 @@ sub searchContents { my $files = join(' ', @files); + my $regex = $query; + $regex =~ s/\./\\./g; + $regex =~ s/\*/\\S*/g; + $regex =~ s/\?/./g; + open(IN,"zegrep -h '$grepRE' $files |"); + # wonderful abuse of last and next and unless ;) while () { - if (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/) { - my ($file,$package) = ("/".$1,$2); - if ($query =~ /\//) { - next unless ($file =~ /\Q$query\E/); - } else { - my ($basename) = $file =~ /^.*\/(.*)$/; - next unless ($basename =~ /\Q$query\E/); - } - next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//); - next if ($front and $file !~ /^\/\Q$query\E/); + last if ($found > 100); + + next unless if (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/); - $contents{$package}{$file} = 1; - $found++; + my ($file,$package) = ("/".$1,$2); + if ($query =~ /[\/\*\\]/) { + next unless (eval { $file =~ /$regex/ }); + return unless &checkEval($@); + } else { + my ($basename) = $file =~ /^.*\/(.*)$/; + next unless (eval { $basename =~ /$regex/ }); + return unless &checkEval($@); } + next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//); + next if ($front and eval { $file !~ /^\/$query/ }); + return unless &checkEval($@); - last if ($found > 100); + $contents{$package}{$file} = 1; + $found++; } close IN; @@ -267,13 +278,13 @@ sub searchContents { } my $file = "$::param{tempDir}/$::who.txt"; - if (!open(OUT,">$file")) { + if (!open OUT, ">$file") { &::ERROR("Debian: cannot write file for dcc send."); return; } foreach $pkg (keys %contents) { - foreach (keys %{$contents{$pkg}}) { + foreach (keys %{ $contents{$pkg} }) { # TODO: correct padding. print OUT "$_\t\t\t$pkg\n"; } @@ -289,7 +300,7 @@ sub searchContents { my @list; foreach $pkg (keys %contents) { - my @tmplist = &::fixFileList(keys %{$contents{$pkg}}); + my @tmplist = &::fixFileList(keys %{ $contents{$pkg} }); my @sublist = sort { length $a <=> length $b } @tmplist; pop @sublist while (scalar @sublist > 3); @@ -307,9 +318,23 @@ sub searchContents { my $prefix = "Debian Search of '$query' "; if (scalar @list) { # @list. &::pSReply( &::formListReply(0, $prefix, @list) ); + } else { # !@list. - &::DEBUG("ok, !\@list, searching desc for '$query'."); - &searchDesc($query); + &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug); + my @list = &searchDesc($query); + + if (!scalar @list) { + my $prefix = "Debian Package/File/Desc Search of '$query' "; + &::pSReply( &::formListReply(0, $prefix, ) ); + + } elsif (scalar @list == 1) { # list = 1. + &::DEBUG("deb: list == 1; showing package info of '$list[0]'."); + &infoPackages("info", $list[0]); + + } else { # list > 1. + my $prefix = "Debian Desc Search of '$query' "; + &::pSReply( &::formListReply(0, $prefix, @list) ); + } } } @@ -317,7 +342,7 @@ sub searchContents { # Usage: &searchAuthor($query); sub searchAuthor { my ($dist, $query) = &getDistroFromStr($_[0]); - &::DEBUG("searchAuthor: dist => '$dist', query => '$query'."); + &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug); $query =~ s/^\s+|\s+$//g; # start of search. @@ -331,7 +356,7 @@ sub searchAuthor { foreach (keys %urlpackages) { s/##DIST/$dist/g; - if (! -f $_) { + if (! -f "$debian_dir/$_" ) { $bad++; next; } @@ -340,11 +365,12 @@ sub searchAuthor { $files .= " ".$_; } - &::DEBUG("good = $good, bad = $bad..."); + &::DEBUG("deb: good = $good, bad = $bad...") if ($debug); if ($good == 0 and $bad != 0) { my %urls = &fixDist($dist, %urlpackages); &::DEBUG("deb: download 2."); + if (!&DebianDownload($dist, %urls)) { &::ERROR("Debian(sA): could not download files."); return; @@ -356,17 +382,19 @@ sub searchAuthor { while () { if (/^Package: (\S+)$/) { $package = $1; + } elsif (/^Maintainer: (.*) \<(\S+)\>$/) { my($name,$email) = ($1,$2); if ($package eq "") { - &::DEBUG("sA: package == NULL."); + &::DEBUG("deb: sA: package == NULL."); next; } $maint{$name}{$email} = 1; $pkg{$name}{$package} = 1; $package = ""; + } else { - &::WARN("invalid line: '$_'."); + &::WARN("debian: invalid line: '$_' (1)."); } } close IN; @@ -380,9 +408,11 @@ sub searchAuthor { # TODO: should we only search email if '@' is used? if (scalar keys %hash < 15) { my $name; + foreach $name (keys %maint) { my $email; - foreach $email (keys %{$maint{$name}}) { + + foreach $email (keys %{ $maint{$name} }) { next unless ($email =~ /\Q$query\E/i); next if (exists $hash{$name}); $hash{$name} = 1; @@ -397,15 +427,15 @@ sub searchAuthor { return 1; } - &::DEBUG("showing all packages by '$list[0]'..."); + &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug); - my @pkg = sort keys %{$pkg{$list[0]}}; + my @pkg = sort keys %{ $pkg{$list[0]} }; # show how long it took. my $delta_time = &::timedelta($start_time); &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); - my $email = join(', ', keys %{$maint{$list[0]}}); + my $email = join(', ', keys %{ $maint{$list[0]} }); my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 "; &::pSReply( &::formListReply(0, $prefix, @pkg) ); } @@ -414,7 +444,7 @@ sub searchAuthor { # Usage: &searchDesc($query); sub searchDesc { my ($dist, $query) = &getDistroFromStr($_[0]); - &::DEBUG("searchDesc: dist => '$dist', query => '$query'."); + &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.") if ($debug); $query =~ s/^\s+|\s+$//g; # start of search. @@ -428,83 +458,82 @@ sub searchDesc { foreach (keys %urlpackages) { s/##DIST/$dist/g; - if (! -f $_) { + if (! -f "$debian_dir/$_" ) { $bad++; next; } $good++; - $files .= " ".$_; + $files .= " $debian_dir/$_"; } - &::DEBUG("good = $good, bad = $bad..."); + &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug); if ($good == 0 and $bad != 0) { my %urls = &fixDist($dist, %urlpackages); - &::DEBUG("deb: download 2c."); + &::DEBUG("deb: download 2c.") if ($debug); + if (!&DebianDownload($dist, %urls)) { - &::ERROR("Debian(sD): could not download files."); + &::ERROR("deb: sD: could not download files."); return; } } + my $regex = $query; + $regex =~ s/\./\\./g; + $regex =~ s/\*/\\S*/g; + $regex =~ s/\?/./g; + my (%desc, $package); open(IN,"zegrep -h '^Package|^Description' $files |"); - $query =~ s/\*/\\S*/g; # regex. while () { if (/^Package: (\S+)$/) { $package = $1; } elsif (/^Description: (.*)$/) { my $desc = $1; - next unless ($desc =~ /\Q$query\E/i); + next unless (eval { $desc =~ /$regex/i }); + return unless &checkEval($@); + if ($package eq "") { &::WARN("sD: package == NULL?"); next; } + $desc{$package} = $desc; $package = ""; + } else { - &::WARN("invalid line: '$_'."); + &::WARN("debian: invalid line: '$_'. (2)"); } } close IN; - my @list = keys %desc; - if (!scalar @list) { - my $prefix = "Debian Desc Search of '$query' "; - &::pSReply( &::formListReply(0, $prefix, ) ); - } elsif (scalar @list == 1) { # list = 1. - &::DEBUG("list == 1; showing package info of '$list[0]'."); - &infoPackages("info", $list[0]); - } else { # list > 1. - my $prefix = "Debian Desc Search of '$query' "; - &::pSReply( &::formListReply(0, $prefix, @list) ); - } - # show how long it took. my $delta_time = &::timedelta($start_time); &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); + + return keys %desc; } #### # Usage: &generateIncoming(); sub generateIncoming { - my $pkgfile = "debian/Packages-incoming"; + my $pkgfile = $debian_dir."/Packages-incoming"; my $idxfile = $pkgfile.".idx"; my $stale = 0; $stale++ if (&::isStale($pkgfile.".gz", $refresh)); $stale++ if (&::isStale($idxfile, $refresh)); - &::DEBUG("gI: stale => '$stale'."); + &::DEBUG("deb: gI: stale => '$stale'.") if ($debug); return 0 unless ($stale); ### STATIC URL. my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/"); - if (!open(PKG,">$pkgfile")) { + if (!open PKG, ">$pkgfile") { &::ERROR("cannot write to pkg $pkgfile."); return 0; } - if (!open(IDX,">$idxfile")) { + if (!open IDX, ">$idxfile") { &::ERROR("cannot write to idx $idxfile."); return 0; } @@ -631,7 +660,8 @@ sub infoPackages { # hrm... my %urls = &fixDist($dist, %urlpackages); if ($dist ne "incoming") { - &::DEBUG("deb: download 3."); + &::DEBUG("deb: download 3.") if ($debug); + if (!&DebianDownload($dist, %urls)) { # no good download. &::WARN("Debian(iP): could not download ANY files."); } @@ -685,13 +715,14 @@ sub infoPackages { $pkg{'info'} = "\002(\002". $pkg{'desc'} ."\002)\002"; $pkg{'info'} .= ", section ".$pkg{'section'}; $pkg{'info'} .= ", is ".$pkg{'priority'}; - $pkg{'info'} .= ". Version: \002$pkg{'version'}\002"; +# $pkg{'info'} .= ". Version: \002$pkg{'version'}\002"; + $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)"; $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB"; $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB"; if ($incoming) { &::status("iP: info requested and pkg is in incoming, too."); - my %incpkg = &getPackageInfo($query, "debian/Packages-incoming"); + my %incpkg = &getPackageInfo($query, $debian_dir ."/Packages-incoming"); if (scalar keys %incpkg) { $pkg{'info'} .= ". Is in incoming ($incpkg{'file'})."; @@ -700,9 +731,9 @@ sub infoPackages { } } } else { - &::DEBUG("running debianCheck() due to problems (".scalar(keys %pkg).")."); + &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).")."); &debianCheck(); - &::DEBUG("end of debianCheck()"); + &::DEBUG("deb: end of debianCheck()"); &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it..."); return; @@ -738,7 +769,7 @@ sub infoStats { $dist = &getDistro($dist); return unless (defined $dist); - &::DEBUG("infoS: dist => '$dist'."); + &::DEBUG("deb: infoS: dist => '$dist'."); # download packages file if needed. my %urls = &fixDist($dist, %urlpackages); @@ -754,16 +785,16 @@ sub infoStats { my $file; foreach $file (keys %urlpackages) { $file =~ s/##DIST/$dist/g; # won't work for incoming. - &::DEBUG("file => '$file'."); + &::DEBUG("deb: file => '$file'."); if (exists $stats{$file}{'count'}) { - &::DEBUG("hrm... duplicate open with $file???"); + &::DEBUG("deb: hrm... duplicate open with $file???"); next; } - open(IN,"zcat $file 2>&1 |"); + open(IN, "zcat $file 2>&1 |"); if (! -e $file) { - &::DEBUG("iS: $file does not exist."); + &::DEBUG("deb: iS: $file does not exist."); next; } @@ -796,14 +827,14 @@ sub infoStats { &::pSReply( "Debian Distro Stats on $dist... ". "\002$total{'count'}\002 packages, ". - "\002".scalar(keys %{$total{'maint'}})."\002 maintainers, ". + "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ". "\002". int($total{'isize'}/1024)."\002 MB installed size, ". "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size." ); ### TODO: do individual stats? if so, we need _another_ arg. # foreach $file (keys %stats) { -# foreach (keys %{$stats{$file}}) { +# foreach (keys %{ $stats{$file} }) { # &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'."); # } # } @@ -811,8 +842,6 @@ sub infoStats { return; } - - ### # HELPER FUNCTIONS FOR INFOPACKAGES... ### @@ -820,7 +849,7 @@ sub infoStats { # Usage: &generateIndex(); sub generateIndex { my (@dists) = @_; - &::status("Debian: !!! generateIndex() called !!!"); + &::status("Debian: !!! generateIndex($dists[0]) called !!!"); if (!scalar @dists or $dists[0] eq '') { &::ERROR("gI: no dists to generate index."); return 1; @@ -828,29 +857,30 @@ sub generateIndex { foreach (@dists) { my $dist = &getDistro($_); # incase the alias is returned, possible? - my $idx = "debian/Packages-$dist.idx"; + my $idx = $debian_dir."/Packages-$dist.idx"; # TODO: check if any of the Packages file have been updated then # regenerate it, even if it's not stale. # TODO: also, regenerate the index if the packages file is newer # than the index. - next unless (&::isStale($idx, $::param{'debianRefreshInterval'})); + next unless (&::isStale($idx, $refresh)); + if (/^incoming$/i) { - &::DEBUG("gIndex: calling generateIncoming()!"); + &::DEBUG("deb: gIndex: calling generateIncoming()!"); &generateIncoming(); next; } if (/^woody$/i) { - &::DEBUG("Copying old index of woody to -old"); + &::DEBUG("deb: Copying old index of woody to -old"); system("cp $idx $idx-old"); } - &::DEBUG("gIndeX: calling DebianDownload($dist, ...)."); - &DebianDownload($dist, %urlpackages); + &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug); + &DebianDownload($dist, &fixDist($dist, %urlpackages) ); &::status("Debian: generating index for '$dist'."); - if (!open(OUT,">$idx")) { + if (!open OUT, ">$idx") { &::ERROR("cannot write to $idx."); return 0; } @@ -858,6 +888,7 @@ sub generateIndex { my $packages; foreach $packages (keys %urlpackages) { $packages =~ s/##DIST/$dist/; + $packages = "$debian_dir/$packages"; if (! -e $packages) { &::ERROR("gIndex: '$packages' does not exist?"); @@ -885,10 +916,15 @@ sub validPackage { my @files; my $file; - &::DEBUG("D: validPackage($package, $dist) called."); + ### this majorly sucks, we need some standard in place. + # why is this needed... need to investigate later. + my $olddist = $dist; + $dist = &getDistro($dist); + + &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug); my $error = 0; - while (!open(IN, "debian/Packages-$dist.idx")) { + while (!open IN, $debian_dir."/Packages-$dist.idx") { if ($error) { &::ERROR("Packages-$dist.idx does not exist (#1)."); return; @@ -913,38 +949,34 @@ sub validPackage { } close IN; - &::DEBUG("vP: scanned $count items in index."); + &::VERB("vP: scanned $count items in index.",2); return @files; } sub searchPackage { my ($dist, $query) = &getDistroFromStr($_[0]); - my $file = "debian/Packages-$dist.idx"; + my $file = $debian_dir."/Packages-$dist.idx"; my @files; my $error = 0; - my $warn = 0; - - if ($query =~ tr/A-Z/a-z/) { - $warn++; - } + my $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0; &::status("Debian: Search package matching '$query' in '$dist'."); - unlink $file if ( -z $file); + unlink $file if ( -z $file ); - while (!open(IN, $file)) { + while (!open IN, $file) { if ($dist eq "incoming") { - &::DEBUG("sP: dist == incoming; calling gI()."); + &::DEBUG("deb: sP: dist == incoming; calling gI()."); &generateIncoming(); } if ($error) { - &::ERROR("could not generate index!!!"); + &::ERROR("could not generate index ($file)!!!"); return; } $error++; - &::DEBUG("should we be doing this?"); + &::DEBUG("deb: should we be doing this?"); &generateIndex(($dist)); } @@ -954,11 +986,11 @@ sub searchPackage { if (/^\*(.*)$/) { $file = $1; - if (&::isStale($file, $::param{'debianRefreshInterval'})) { - &::DEBUG("STALE $file! regen."); + if (&::isStale($file, $refresh)) { + &::DEBUG("deb: STALE $file! regen.") if ($debug); &generateIndex(($dist)); ### @files = searchPackage("$query $dist"); - &::DEBUG("EVIL HACK HACK HACK."); + &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug); last; } @@ -982,24 +1014,27 @@ sub getDistro { my $dist = $_[0]; if (!defined $dist or $dist eq "") { - &::DEBUG("gD: dist == NULL; dist = defaultdist."); + &::DEBUG("deb: gD: dist == NULL; dist = defaultdist."); $dist = $defaultdist; } if ($dist =~ /^(slink|hamm|rex|bo)$/i) { - &::DEBUG("Debian: deprecated version ($dist)."); + &::DEBUG("deb: deprecated version ($dist)."); &::msg($::who, "Debian: deprecated distribution version."); return; } if (exists $dists{$dist}) { + &::VERB("gD: returning dists{$dist} ($dists{$dist})",2); return $dists{$dist}; + } else { if (!grep /^\Q$dist\E$/i, %dists) { &::msg($::who, "invalid dist '$dist'."); return; } + &::VERB("gD: returning $dist (no change or conversion)",2); return $dist; } } @@ -1027,13 +1062,14 @@ sub fixDist { $key =~ s/##DIST/$dist/; $val =~ s/##DIST/$dist/; ### TODO: what should we do if the sar wasn't done. - $new{$key} = $val; + $new{$debian_dir."/".$key} = $val; } + return %new; } sub DebianFind { - ### H-H-H-HACK HACK HACK :) + # HACK! HACK! HACK! my ($str) = @_; my ($dist, $query) = &getDistroFromStr($str); my @results = sort &searchPackage($str); @@ -1044,25 +1080,26 @@ sub DebianFind { &::status("searchPackage returned one result; getting info of package instead!"); &::Forker("debian", sub { &infoPackages("info", "$results[0] $dist"); } ); } else { - my $prefix = "Debian Package Listing of '$str' "; + my $prefix = "Debian Package Listing of '$query' "; &::pSReply( &::formListReply(0, $prefix, @results) ); } } sub debianCheck { - my $dir = "debian/"; my $error = 0; &::status("debianCheck() called."); ### TODO: remove the following loop (check if dir exists before) while (1) { - last if (opendir(DEBIAN, $dir)); + last if (opendir(DEBIAN, $debian_dir)); + if ($error) { &::ERROR("dC: cannot opendir debian."); return; } - mkdir $dir, 0755; + + mkdir $debian_dir, 0755; $error++; } @@ -1071,18 +1108,46 @@ sub debianCheck { while (defined($file = readdir DEBIAN)) { next unless ($file =~ /(gz|bz2)$/); - my $exit = system("gzip -t '$dir/$file'"); + my $exit = system("gzip -t '$debian_dir/$file'"); next unless ($exit); - &::DEBUG("hmr... => ".(time() - (stat($file))[8])."'."); + &::DEBUG("deb: hmr... => ".(time() - (stat($file))[8])."'."); next unless (time() - (stat($file))[8] > 3600); - &::DEBUG("dC: exit => '$exit'."); - &::WARN("dC: '$dir/$file' corrupted? deleting!"); - unlink $dir."/".$file; + &::DEBUG("deb: dC: exit => '$exit'."); + &::WARN("dC: '$debian_dir/$file' corrupted? deleting!"); + unlink $debian_dir."/".$file; $retval++; } return $retval; } +sub checkEval { + my($str) = @_; + + if ($str) { + &::WARN("cE: $str"); + return 0; + } else { + return 1; + } +} + +sub searchDescFE { +# &::DEBUG("deb: FE called for searchDesc"); + my ($query) = @_; + my @list = &searchDesc($query); + + if (!scalar @list) { + my $prefix = "Debian Desc Search of '$query' "; + &::pSReply( &::formListReply(0, $prefix, ) ); + } elsif (scalar @list == 1) { # list = 1. + &::DEBUG("deb: list == 1; showing package info of '$list[0]'."); + &infoPackages("info", $list[0]); + } else { # list > 1. + my $prefix = "Debian Desc Search of '$query' "; + &::pSReply( &::formListReply(0, $prefix, @list) ); + } +} + 1;