X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FModules%2FDebian.pl;h=97c59fd411c324c0f0bb87f91a6f4193826f1699;hb=cb81fea9939f349b36e3b5a0cdc0343a6b781da1;hp=8eb2fe9e058a96332267628eae68421b7e4fbb80;hpb=471a241a0253bd442af48df0bd3d96c3753b8303;p=infobot.git diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl index 8eb2fe9..97c59fd 100644 --- a/src/Modules/Debian.pl +++ b/src/Modules/Debian.pl @@ -1,46 +1,88 @@ # # Debian.pl: Frontend to debian contents and packages files # Author: dms -# Version: v0.7b (20000527) +# Version: v0.8 (20000918) # Created: 20000106 # + +# XXX Add uploader field support + package Debian; use strict; +no strict 'refs'; # FIXME: dstats aborts if set + +my $announce = 0; +my $defaultdist = 'sid'; +my $refresh = &::getChanConfDefault('debianRefreshInterval', 7, $::chan) * 60 * 60 * 24; +my $debug = 0; +my $debian_dir = $::bot_state_dir . '/debian'; +my $country = 'nl'; # well .config it yourself then. ;-) +my $protocol = 'http'; +# EDIT THIS (i386, amd64, powerpc, [etc.]): +my $arch = "i386"; # format: "alias=real". -my $defaultdist = "woody"; my %dists = ( - "unstable" => "woody", - "frozen" => "potato", - "stable" => "slink", - "incoming" => "incoming", + 'unstable' => 'sid', + 'testing' => 'lenny', + 'stable' => 'etch', + 'experimental' => 'experimental', + 'oldstable' => 'sarge', + 'incoming' => 'incoming', ); -my %urlcontents = ( - "debian/Contents-##DIST-i386.gz" => - "ftp://ftp.us.debian.org". - "/debian/dists/##DIST/Contents-i386.gz", +my %archived_dists = ( + woody => 'woody', + potato => 'potato', + hamm => 'hamm', + buzz => 'buzz', + bo => 'bo', + rex => 'rex', + slink => 'slink', +); + +my %archiveurlcontents = ( + "Contents-##DIST-$arch.gz" => + "$protocol://debian.crosslink.net/debian-archive". + "/dists/##DIST/Contents-$arch.gz", +); - "debian/Contents-##DIST-i386-non-US.gz" => - "ftp://non-us.debian.org". - "/debian-non-US/dists/##DIST/non-US/Contents-i386.gz", +my %archiveurlpackages = ( + "Packages-##DIST-main-$arch.gz" => + "$protocol://debian.crosslink.net/debian-archive". + "/dists/##DIST/main/binary-$arch/Packages.gz", + "Packages-##DIST-contrib-$arch.gz" => + "$protocol://debian.crosslink.net/debian-archive". + "/dists/##DIST/contrib/binary-$arch/Packages.gz", + "Packages-##DIST-non-free-$arch.gz" => + "$protocol://debian.crosslink.net/debian-archive". + "/dists/##DIST/non-free/binary-$arch/Packages.gz", +); + + + + +my %urlcontents = ( + "Contents-##DIST-$arch.gz" => + "$protocol://ftp.$country.debian.org". + "/debian/dists/##DIST/Contents-$arch.gz", + "Contents-##DIST-$arch-non-US.gz" => + "$protocol://non-us.debian.org". + "/debian-non-US/dists/##DIST/non-US/Contents-$arch.gz", ); my %urlpackages = ( - "debian/Packages-##DIST-main-i386.gz" => - "ftp://ftp.us.debian.org". - "/debian/dists/##DIST/main/binary-i386/Packages.gz", - "debian/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" => - "ftp://ftp.us.debian.org". - "/debian/dists/##DIST/non-free/binary-i386/Packages.gz", - "debian/Packages-##DIST-non-US-i386.gz" => - "ftp://non-us.debian.org". - "/debian-non-US/dists/##DIST/non-US/binary-i386/Packages.gz", + "Packages-##DIST-main-$arch.gz" => + "$protocol://ftp.$country.debian.org". + "/debian/dists/##DIST/main/binary-$arch/Packages.gz", + "Packages-##DIST-contrib-$arch.gz" => + "$protocol://ftp.$country.debian.org". + "/debian/dists/##DIST/contrib/binary-$arch/Packages.gz", + "Packages-##DIST-non-free-$arch.gz" => + "$protocol://ftp.$country.debian.org". + "/debian/dists/##DIST/non-free/binary-$arch/Packages.gz", ); ##################### @@ -48,22 +90,17 @@ my %urlpackages = ( ####################### #### -# Usage: &DebianDownload(%hash); +# Usage: &DebianDownload($dist, %hash); sub DebianDownload { my ($dist, %urls) = @_; - my $refresh = $main::param{'debianRefreshInterval'} * 60 * 60 * 24; my $bad = 0; my $good = 0; - &main::status("Debian: Downloading files for '$dist'."); - - if (! -d "debian/") { - &main::status("Debian: creating debian dir."); - mkdir("debian/",0755); + if (! -d $debian_dir) { + &::status("Debian: creating debian dir."); + mkdir($debian_dir, 0755); } - %urls = &fixNonUS($dist, %urls); - # fe dists. # Download the files. my $file; @@ -73,58 +110,77 @@ sub DebianDownload { $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 { - &main::DEBUG("Debian: local '$file' does not exist."); $update++; } next unless ($update); - if ($good + $bad == 0) { - &main::msg($main::who, "Updating debian files... please wait."); + &::DEBUG("announce == $announce.") if ($debug); + if ($good + $bad == 0 and !$announce) { + &::status("Debian: Downloading files for '$dist'."); + &::msg($::who, "Updating debian files... please wait."); + $announce++; } - if (exists $main::debian{$url}) { - &main::DEBUG("2: ".(time - $main::debian{$url})." <= $refresh"); - next if (time() - $main::debian{$url} <= $refresh); - &main::DEBUG("stale for url $url; updating!"); + if (exists $::debian{$url}) { + &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug); + next if (time() - $::debian{$url} <= $refresh); + &::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 (!&main::ftpGet($host,$path,$thisfile,$file)) { - &main::DEBUG("deb: down: ftpGet: bad."); + if (!&::ftpGet($host,$path,$thisfile,$file)) { + &::WARN("deb: down: $file == BAD."); $bad++; next; } - if (! -f $file) { - &main::DEBUG("deb: down: ftpGet: !file"); + } elsif ($url =~ /^http:\/\/\S+\/\S+$/) { + + if (!&::getURLAsFile($url,$file)) { + &::WARN("deb: down: http: $file == BAD."); $bad++; next; } - &main::DEBUG("deb: download: good."); - $good++; } else { - &main::ERROR("Debian: invalid format of url => ($url)."); + &::ERROR("Debian: invalid format of url => ($url)."); + $bad++; + next; + } + + if (! -f $file) { + &::WARN("deb: down: http: !file"); $bad++; next; } + +# my $exit = system("/bin/gzip -t $file"); +# if ($exit) { +# &::WARN("deb: $file is corrupted ($exit) :/"); +# unlink $file; +# next; +# } + + &::DEBUG("deb: download: good.") if ($debug); + $good++; } + # ok... lets just run this. + &::miscCheck() if (&::whatInterface() =~ /IRC/); + if ($good) { &generateIndex($dist); return 1; } else { return -1 unless ($bad); # no download. - &main::DEBUG("DD: !good and bad($bad). :("); + &::DEBUG("DD: !good and bad($bad). :("); return 0; } } @@ -137,69 +193,94 @@ sub DebianDownload { # Usage: &searchContents($query); sub searchContents { my ($dist, $query) = &getDistroFromStr($_[0]); - &main::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; + $query =~ s/\\([\^\$])/$1/g; # hrm? $query =~ s/^\s+|\s+$//g; - $query =~ s/\*/\\S*/g; # does it even work? - if (!&main::validExec($query)) { - &main::msg($main::who, "search string looks fuzzy."); + if (!&::validExec($query)) { + &::msg($::who, 'search string looks fuzzy.'); return; } - if ($dist eq "incoming") { # nothing yet. - &main::DEBUG("sC: dist = 'incoming'. no contents yet."); + my %urls = fixDist($dist,'contents'); + if ($dist eq 'incoming') { # nothing yet. + &::DEBUG('sC: dist = "incoming". no contents yet.'); return; } else { - my %urls = &fixDist($dist, %urlcontents); # download contents file. - &main::DEBUG("deb: download 1."); + &::DEBUG('deb: download 1.') if ($debug); if (!&DebianDownload($dist, %urls)) { - &main::WARN("Debian: could not download files."); + &::WARN('Debian: could not download files.'); } } # start of search. - my $start_time = &main::gettimeofday(); + my $start_time = &::timeget(); - my $found = 0; + my $found = 0; + my $front = 0; my %contents; - my $search = "$query.*\[ \t]"; - foreach (keys %urlcontents) { - next unless ( -f $_); - push(@files,$_); + my $grepRE; + ### TODO: search properly if /usr/bin/blah is done. + if ($query =~ s/\$$//) { + &::DEBUG("deb: search-regex found.") if ($debug); + $grepRE = "$query\[ \t]"; + } elsif ($query =~ s/^\^//) { + &::DEBUG("deb: front marker regex found.") if ($debug); + $front = 1; + $grepRE = $query; + } else { + $grepRE = "$query*\[ \t]"; + } + + # fix up grepRE for "*". + $grepRE =~ s/\*/.*/g; + + my @files; + foreach (keys %urls) { + next unless ( -f $_ ); + push(@files, $_); } if (!scalar @files) { - &main::ERROR("sC: no files?"); - &main::msg($main::who, "failed."); + &::ERROR("sC: no files?"); + &::msg($::who, "failed."); return; } my $files = join(' ', @files); - $files =~ s/##DIST/$dist/g; - open(IN,"zegrep -h '$search' $files |"); + my $regex = $query; + $regex =~ s/\./\\./g; + $regex =~ s/\*/\\S*/g; + $regex =~ s/\?/./g; + + open(IN,"zegrep -h '$grepRE' $files |"); + # wonderful abuse of if, last, next, return, 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\//); + last if ($found > 100); + + next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/); + my ($file,$package) = ("/".$1,$2); - $contents{$package}{$file} = 1; - $found++; + 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($@); + + $contents{$package}{$file} = 1; + $found++; } close IN; @@ -207,44 +288,40 @@ sub searchContents { ### send results with dcc. if ($dccsend) { - if (exists $main::dcc{'SEND'}{$main::who}) { - &main::msg($main::who, "DCC already active!"); + if (exists $::dcc{'SEND'}{$::who}) { + &::msg($::who, "DCC already active!"); return; } if (!scalar %contents) { - &main::msg($main::who,"search returned no results."); + &::msg($::who,"search returned no results."); return; } - if (! -d "Temp/") { - mkdir("Temp",0755); - } - - my $file = "temp/$main::who.txt"; - if (!open(OUT,">$file")) { - &main::ERROR("Debian: cannot write file for dcc send."); + my $file = "$::param{tempDir}/$::who.txt"; + 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"; } } close OUT; - &main::shmWrite($main::shm, "DCC SEND $main::who $file"); + &::shmWrite($::shm, "DCC SEND $::who $file"); return; } - &main::status("Debian: $found results."); + &::status("Debian: $found contents results found."); my @list; foreach $pkg (keys %contents) { - my @tmplist = &main::fixFileList(keys %{$contents{$pkg}}); + my @tmplist = &::fixFileList(keys %{ $contents{$pkg} }); my @sublist = sort { length $a <=> length $b } @tmplist; pop @sublist while (scalar @sublist > 3); @@ -256,36 +333,49 @@ sub searchContents { @list = sort { length $a <=> length $b } @list; # show how long it took. - my $delta_time = &main::gettimeofday() - $start_time; - &main::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); + my $delta_time = &::timedelta($start_time); + &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); my $prefix = "Debian Search of '$query' "; - &main::performStrictReply( &main::formListReply(0, $prefix, @list) ); + if (scalar @list) { # @list. + &::performStrictReply( &::formListReply(0, $prefix, @list) ); + return; + } + + # !@list. + &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug); + @list = &searchDesc($query); + + if (!scalar @list) { + my $prefix = "Debian Package/File/Desc Search of '$query' "; + &::performStrictReply( &::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' "; + &::performStrictReply( &::formListReply(0, $prefix, @list) ); + } } #### # Usage: &searchAuthor($query); sub searchAuthor { my ($dist, $query) = &getDistroFromStr($_[0]); - &main::DEBUG("searchAuthor: dist => '$dist', query => '$query'."); + &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug); $query =~ s/^\s+|\s+$//g; # start of search. - my $start_time = &main::gettimeofday(); - &main::status("Debian: starting author search."); + my $start_time = &::timeget(); + &::status("Debian: starting author search."); + my %urls = fixDist($dist,'packages'); my $files; my ($bad,$good) = (0,0); - my %urls = %urlpackages; - ### potato now has the "new" non-US tree like woody does. - if ($dist =~ /^(woody|potato)$/) { - %urls = &fixNonUS($dist, %urlpackages); - } - - foreach (keys %urlpackages) { - s/##DIST/$dist/g; - - if (! -f $_) { + foreach (keys %urls) { + if (! -f $_ ) { $bad++; next; } @@ -294,13 +384,13 @@ sub searchAuthor { $files .= " ".$_; } - &main::DEBUG("good = $good, bad = $bad..."); + &::DEBUG("deb: good = $good, bad = $bad...") if ($debug); if ($good == 0 and $bad != 0) { - my %urls = &fixDist($dist, %urlpackages); - &main::DEBUG("deb: download 2."); + &::DEBUG("deb: download 2."); + if (!&DebianDownload($dist, %urls)) { - &main::ERROR("Debian(sA): could not download files."); + &::ERROR("Debian(sA): could not download files."); return; } } @@ -310,11 +400,20 @@ sub searchAuthor { while () { if (/^Package: (\S+)$/) { $package = $1; + } elsif (/^Maintainer: (.*) \<(\S+)\>$/) { - $maint{$1}{$2} = 1; - $pkg{$1}{$package} = 1; + my($name,$email) = ($1,$2); + if ($package eq "") { + &::DEBUG("deb: sA: package == NULL."); + next; + } + $maint{$name}{$email} = 1; + $pkg{$name}{$package} = 1; + $package = ""; + } else { - &main::WARN("invalid line: '$_'."); + chop; + &::WARN("debian: invalid line: '$_' (1)."); } } close IN; @@ -328,9 +427,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; @@ -341,44 +442,117 @@ sub searchAuthor { my @list = keys %hash; if (scalar @list != 1) { my $prefix = "Debian Author Search of '$query' "; - &main::performStrictReply( &main::formListReply(0, $prefix, @list) ); + &::performStrictReply( &::formListReply(0, $prefix, @list) ); return 1; } - &main::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 = &main::gettimeofday() - $start_time; - &main::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); + 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 "; - &main::performStrictReply( &main::formListReply(0, $prefix, @pkg) ); + &::performStrictReply( &::formListReply(0, $prefix, @pkg) ); +} + +#### +# Usage: &searchDesc($query); +sub searchDesc { + my ($dist, $query) = &getDistroFromStr($_[0]); + &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.") if ($debug); + $query =~ s/^\s+|\s+$//g; + + # start of search. + my $start_time = &::timeget(); + &::status("Debian: starting desc search."); + + my $files; + my ($bad,$good) = (0,0); + my %urls = fixDist($dist,'packages'); + + # XXX This should be abstracted elsewhere. + foreach (keys %urls) { + if (! -f $_ ) { + $bad++; + next; + } + + $good++; + $files .= " $_"; + } + + &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug); + + if ($good == 0 and $bad != 0) { + &::DEBUG("deb: download 2c.") if ($debug); + + if (!&DebianDownload($dist, %urls)) { + &::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 |"); + while () { + if (/^Package: (\S+)$/) { + $package = $1; + } elsif (/^Description: (.*)$/) { + my $desc = $1; + next unless (eval { $desc =~ /$regex/i }); + return unless &checkEval($@); + + if ($package eq "") { + &::WARN("sD: package == NULL?"); + next; + } + + $desc{$package} = $desc; + $package = ""; + + } else { + chop; + &::WARN("debian: invalid line: '$_'. (2)"); + } + } + close IN; + + # 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 $interval = $main::param{'debianRefreshInterval'}; - my $pkgfile = "debian/Packages-incoming"; + my $pkgfile = $debian_dir."/Packages-incoming"; my $idxfile = $pkgfile.".idx"; my $stale = 0; - $stale++ if (&main::isStale($pkgfile.".gz", $interval)); - $stale++ if (&main::isStale($idxfile.".gz", $interval)); - &main::DEBUG("gI: stale => '$stale'."); + $stale++ if (&::isStale($pkgfile.".gz", $refresh)); + $stale++ if (&::isStale($idxfile, $refresh)); + &::DEBUG("deb: gI: stale => '$stale'.") if ($debug); return 0 unless ($stale); ### STATIC URL. - my %ftp = &main::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/"); + my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/"); - if (!open(PKG,">$pkgfile")) { - &main::ERROR("cannot write to pkg $pkgfile."); + if (!open PKG, ">$pkgfile") { + &::ERROR("cannot write to pkg $pkgfile."); return 0; } - if (!open(IDX,">$idxfile")) { - &main::ERROR("cannot write to idx $idxfile."); + if (!open IDX, ">$idxfile") { + &::ERROR("cannot write to idx $idxfile."); return 0; } @@ -402,7 +576,7 @@ sub generateIncoming { system("gzip -9fv $pkgfile"); # lame fix. - &main::status("Debian: generateIncoming() complete."); + &::status("Debian: generateIncoming() complete."); } @@ -415,14 +589,14 @@ sub getPackageInfo { my ($package, $file) = @_; if (! -f $file) { - &main::status("gPI: file $file does not exist?"); + &::status("gPI: file $file does not exist?"); return 'NULL'; } my $found = 0; my (%pkg, $pkg); - open(IN, "zcat $file 2>&1 |"); + open(IN, "/bin/zcat $file 2>&1 |"); my $done = 0; while (!eof IN) { @@ -433,7 +607,7 @@ sub getPackageInfo { # package line. if (/^Package: (.*)\n$/) { $pkg = $1; - if ($pkg =~ /^$package$/i) { + if ($pkg =~ /^\Q$package\E$/i) { $found++; # we can use pkg{'package'} instead. $pkg{'package'} = $pkg; } @@ -452,7 +626,7 @@ sub getPackageInfo { $pkg{'section'} = $1; } elsif (/^Size: (.*)$/) { $pkg{'size'} = $1; - } elsif (/^i.*size: (.*)$/) { + } elsif (/^Installed-Size: (.*)$/i) { $pkg{'installed'} = $1; } elsif (/^Description: (.*)$/) { $pkg{'desc'} = $1; @@ -476,7 +650,7 @@ sub getPackageInfo { $pkg{'conflicts'} = $1; } -### &main::DEBUG("=> '$_'."); +### &::DEBUG("=> '$_'."); } # blank line. @@ -497,17 +671,17 @@ sub getPackageInfo { # Usage: &infoPackages($query,$package); sub infoPackages { my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1])); - my $interval = $main::param{'debianRefreshInterval'} || 7; - &main::status("Debian: Searching for package '$package' in '$dist'."); + &::status("Debian: Searching for package '$package' in '$dist'."); # download packages file. # hrm... - my %urls = &fixDist($dist, %urlpackages); + my %urls = &fixDist($dist,'packages'); if ($dist ne "incoming") { - &main::DEBUG("deb: download 3."); + &::DEBUG("deb: download 3.") if ($debug); + if (!&DebianDownload($dist, %urls)) { # no good download. - &main::WARN("Debian(iP): could not download ANY files."); + &::WARN("Debian(iP): could not download ANY files."); } } @@ -515,26 +689,27 @@ sub infoPackages { my $incoming = 0; my @files = &validPackage($package, $dist); if (!scalar @files) { - &main::status("Debian: no valid package found; checking incoming."); + &::status("Debian: no valid package found; checking incoming."); @files = &validPackage($package, "incoming"); + if (scalar @files) { - &main::status("Debian: cool, it exists in incoming."); + &::status("Debian: cool, it exists in incoming."); $incoming++; } else { - &main::msg($main::who, "Package '$package' does not exist."); + &::msg($::who, "Package '$package' does not exist."); return 0; } } if (scalar @files > 1) { - &main::WARN("same package in more than one file; random."); - &main::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!"); - $files[0] = &main::getRandom(@files); + &::WARN("same package in more than one file; random."); + &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!"); + $files[0] = &::getRandom(@files); } if (! -f $files[0]) { - &main::WARN("files[0] ($files[0]) doesn't exist."); - &main::msg($main::who, "WARNING: $files[0] does not exist? FIXME"); + &::WARN("files[0] ($files[0]) doesn't exist."); + &::msg($::who, "FIXME: $files[0] does not exist?"); return 'NULL'; } @@ -548,40 +723,43 @@ sub infoPackages { ### TODO: use fe, dump to a hash. if only one version of the package ### exists. do as normal otherwise list all versions. if (! -f $file) { - &main::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen."); + &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen."); return 0; } my %pkg = &getPackageInfo($package, $file); + $query = "info" if ($query eq "dinfo"); + # 'fm'-like output. if ($query eq "info") { - if (scalar keys %pkg > 5) { - $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'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB"; - $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB"; - - if ($incoming) { - &main::status("iP: info requested and pkg is in incoming, too."); - my %incpkg = &getPackageInfo($query, "debian/Packages-incoming"); - - if (scalar keys %incpkg) { - $pkg{'info'} .= ". Is in incoming ($incpkg{'file'})."; - } else { - &main::ERROR("iP: pkg $query is in incoming but we couldn't get any info?"); - } - } - } else { - &main::DEBUG("running debianCheck() due to problems (".scalar(keys %pkg).")."); + if (scalar keys %pkg <= 5) { + &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).")."); &debianCheck(); - &main::DEBUG("end of debianCheck()"); + &::DEBUG("deb: end of debianCheck()"); - &main::msg($main::who,"Debian: Package appears to exist but I could not retrieve info about it..."); + &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it..."); return; } - } + + $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 ($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_dir ."/Packages-incoming"); + + if (scalar keys %incpkg) { + $pkg{'info'} .= ". Is in incoming ($incpkg{'file'})."; + } else { + &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?"); + } + } + } if ($dist eq "incoming") { $pkg{'info'} .= "Version: \002$pkg{'version'}\002"; @@ -603,7 +781,7 @@ sub infoPackages { } } - &main::performStrictReply("$package: $pkg{$query}"); + &::performStrictReply("$package: $pkg{$query}"); } # Usage: &infoStats($dist); @@ -612,33 +790,31 @@ sub infoStats { $dist = &getDistro($dist); return unless (defined $dist); - &main::DEBUG("infoS: dist => '$dist'."); - my $interval = $main::param{'debianRefreshInterval'} || 7; + &::DEBUG("deb: infoS: dist => '$dist'."); # download packages file if needed. - my %urls = &fixDist($dist, %urlpackages); - &main::DEBUG("deb: download 4."); + my %urls = &fixDist($dist,'packages'); + &::DEBUG("deb: download 4."); if (!&DebianDownload($dist, %urls)) { - &main::WARN("Debian(iS): could not download ANY files."); - &main::msg($main::who, "Debian(iS): internal error."); + &::WARN("Debian(iS): could not download ANY files."); + &::msg($::who, "Debian(iS): internal error."); return; } my %stats; - my %total; + my %total = (count => 0, maint => 0, isize => 0, csize => 0); my $file; - foreach $file (keys %urlpackages) { - $file =~ s/##DIST/$dist/g; # won't work for incoming. - &main::DEBUG("file => '$file'."); + foreach $file (keys %urls) { + &::DEBUG("deb: file => '$file'."); if (exists $stats{$file}{'count'}) { - &main::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) { - &main::DEBUG("iS: $file does not exist."); + if (! -e "$file") { + &::DEBUG("deb: iS: $file does not exist."); next; } @@ -656,36 +832,36 @@ sub infoStats { } elsif (/^Size: (.*)$/) { # compressed size. $stats{$file}{'csize'} += $1; $total{'csize'} += $1; - } elsif (/^i.*size: (.*)$/) { # installed size. + } elsif (/^i.*size: (.*)$/i) { # installed size. $stats{$file}{'isize'} += $1; $total{'isize'} += $1; } -### &main::DEBUG("=> '$_'."); +### &::DEBUG("=> '$_'."); } close IN; } - &main::performStrictReply( + ### TODO: don't count ppl with multiple email addresses. + + &::performStrictReply( "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}}) { -# &main::DEBUG(" '$file' '$_' '$stats{$file}{$_}'."); +# foreach (keys %{ $stats{$file} }) { +# &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'."); # } # } return; } - - ### # HELPER FUNCTIONS FOR INFOPACKAGES... ### @@ -693,42 +869,47 @@ sub infoStats { # Usage: &generateIndex(); sub generateIndex { my (@dists) = @_; - &main::DEBUG("Debian: generateIndex() called."); - if (!scalar @dists) { - &main::ERROR("gI: no dists to generate index."); + &::DEBUG("D: generateIndex($dists[0]) called! ".join(':',caller(),)); + if (!scalar @dists or $dists[0] eq '') { + &::ERROR("gI: no dists to generate index."); return 1; } foreach (@dists) { my $dist = &getDistro($_); # incase the alias is returned, possible? - my $idx = "debian/Packages-$dist.idx"; + my $idx = $debian_dir."/Packages-$dist.idx"; + my %urls = fixDist($_,'packages'); # 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 (&main::isStale($idx, $main::param{'debianRefreshInterval'})); + next unless (&::isStale($idx, $refresh)); + if (/^incoming$/i) { - &main::DEBUG("gIndex: calling generateIncoming()!"); + &::DEBUG("deb: gIndex: calling generateIncoming()!"); &generateIncoming(); next; } - &main::DEBUG("gIndeX: calling DebianDownload($dist, ...)."); - &DebianDownload($dist, %urlpackages); +# if (/^sarge$/i) { +# &::DEBUG("deb: Copying old index of sarge to -old"); +# system("cp $idx $idx-old"); +# } - &main::status("Debian: generating index for '$_'."); - if (!open(OUT,">$idx")) { - &main::ERROR("cannot write to $idx."); + &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug); + &DebianDownload($dist, &fixDist($dist,'packages') ); + + &::status("Debian: generating index for '$dist'."); + if (!open OUT, ">$idx") { + &::ERROR("cannot write to $idx."); return 0; } my $packages; - foreach $packages (keys %urlpackages) { - $packages =~ s/##DIST/$dist/; - + foreach $packages (keys %urls) { if (! -e $packages) { - &main::ERROR("gIndex: '$packages' does not exist?"); + &::ERROR("gIndex: '$packages' does not exist?"); next; } @@ -736,9 +917,8 @@ sub generateIndex { open(IN,"zcat $packages |"); while () { - if (/^Package: (.*)\n$/) { - print OUT $1."\n"; - } + next unless (/^Package: (.*)\n$/); + print OUT $1."\n"; } close IN; } @@ -754,12 +934,17 @@ sub validPackage { my @files; my $file; - &main::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) { - &main::ERROR("Packages-$dist.idx does not exist (#1)."); + &::ERROR("Packages-$dist.idx does not exist (#1)."); return; } @@ -775,42 +960,41 @@ sub validPackage { next; } - if (/^$package\n$/) { + if (/^\Q$package\E\n$/) { push(@files,$file); } $count++; } close IN; - &main::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 $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0; + my $error = 0; my @files; - my $error = 0; - &main::status("Debian: Search package matching '$query' in '$dist'."); - if ( -z $file) { - &main::DEBUG("sP: $file == NULL; removing, redoing."); - unlink $file; - } + &::status("Debian: Search package matching '$query' in '$dist'."); + unlink $file if ( -z $file ); - while (!open(IN, $file)) { - &main::ERROR("$file does not exist (#2)."); + while (!open IN, $file) { if ($dist eq "incoming") { - &main::DEBUG("sP: dist == incoming; calling gI()."); + &::DEBUG("deb: sP: dist == incoming; calling gI()."); &generateIncoming(); } if ($error) { - &main::ERROR("could not generate index!!!"); + &::ERROR("could not generate index ($file)!"); return; } + $error++; + &::DEBUG("deb: should we be doing this?"); &generateIndex(($dist)); } @@ -818,17 +1002,16 @@ sub searchPackage { chop; if (/^\*(.*)$/) { - &main::DEBUG("sP: hrm => '$1'."); + $file = $1; - if (&main::isStale($file, $main::param{'debianRefreshInterval'})) { - &main::DEBUG("STALE $file! regen."); + if (&::isStale($file, $refresh)) { + &::DEBUG("deb: STALE $file! regen.") if ($debug); &generateIndex(($dist)); ### @files = searchPackage("$query $dist"); - &main::DEBUG("EVIL HACK HACK HACK."); + &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug); last; } - $file = $1; next; } @@ -838,6 +1021,10 @@ sub searchPackage { } close IN; + if (scalar @files and $warn) { + &::msg($::who, "searching for package name should be fully lowercase!"); + } + return @files; } @@ -845,25 +1032,33 @@ sub getDistro { my $dist = $_[0]; if (!defined $dist or $dist eq "") { - &main::DEBUG("gD: dist == NULL; dist = defaultdist."); + &::DEBUG("deb: gD: dist == NULL; dist = defaultdist."); $dist = $defaultdist; } if (exists $dists{$dist}) { + &::VERB("gD: returning dists{$dist} ($dists{$dist})",2); return $dists{$dist}; - } else { - if (!grep /^\Q$dist\E$/i, %dists) { - &main::msg($main::who, "invalid dist '$dist'."); + + } + elsif (exists $archived_dists{$dist}){ + &::VERB("gD: returning archivedists{$dist} ($archived_dists{$dist})",2); + return $archived_dists{$dist}; + } + else { + if (!grep(/^\Q$dist\E$/i, %dists) and !grep(/^\Q$dist\E$/i, %archived_dists)) { + &::msg($::who, "invalid dist '$dist'."); return; } + &::VERB("gD: returning $dist (no change or conversion)",2); return $dist; } } sub getDistroFromStr { my ($str) = @_; - my $dists = join '|', %dists; + my $dists = join '|', %dists, %archived_dists; my $dist = $defaultdist; if ($str =~ s/\s+($dists)$//i) { @@ -876,78 +1071,70 @@ sub getDistroFromStr { } sub fixDist { - my ($dist, %urls) = @_; + my ($dist, $type) = @_; my %new; my ($key,$val); - - while (($key,$val) = each %urls) { + my %dist_urls; + + if (exists $archived_dists{$dist}){ + if ($type eq 'contents'){ + %dist_urls = %archiveurlcontents; + } + else { + %dist_urls = %archiveurlpackages; + } + } + else { + if ($type eq 'contents'){ + %dist_urls = %urlcontents; + } + else { + %dist_urls = %urlpackages; + } + } + + while (($key,$val) = each %dist_urls) { $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); if (!scalar @results) { - &main::Forker("debian", sub { &searchContents($str); } ); + &::Forker("Debian", sub { &searchContents($str); } ); } elsif (scalar @results == 1) { - &main::status("searchPackage returned one result; getting info of package instead!"); - &main::Forker("debian", sub { &infoPackages("info", "$results[0] $dist"); } ); + &::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' "; - &main::performStrictReply( &main::formListReply(0, $prefix, @results) ); + my $prefix = "Debian Package Listing of '$query' "; + &::performStrictReply( &::formListReply(0, $prefix, @results) ); } } -### TODO: move DWH to &fixDist() or leave it being called by DD? -sub fixNonUS { - my ($dist, %urls) = @_; - - foreach (keys %urls) { - last unless ($dist =~ /^(woody|potato)$/); - next unless (/non-US/); - &main::DEBUG("DD: Enabling hack(??) for $dist non-US."); - - my $file = $_; - my $url = $urls{$_}; - delete $urls{$file}; # heh. - - foreach ("main","contrib","non-free") { - my ($newfile,$newurl) = ($file,$url); - # only needed for Packages for now, not Contents; good. - $newfile =~ s/non-US/non-US_$_/; - $newurl =~ s#non-US/bin#non-US/$_/bin#; - $urls{$newfile} = $newurl; - } - - &main::DEBUG("DD: Files: ".scalar(keys %urls)); - last; - } - - %urls; -} - sub debianCheck { - my $dir = "debian/"; my $error = 0; - &main::status("debianCheck() called."); + &::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) { - &main::ERROR("dC: cannot opendir debian."); + &::ERROR("dC: cannot opendir debian."); return; } - mkdir $dir, 0755; + + mkdir $debian_dir, 0755; $error++; } @@ -956,18 +1143,49 @@ sub debianCheck { while (defined($file = readdir DEBIAN)) { next unless ($file =~ /(gz|bz2)$/); - my $exit = system("gzip -t '$dir/$file'"); + # TODO: add bzip2 support (debian doesn't do .bz2 anyway) + my $exit = system("/bin/gzip -t '$debian_dir/$file'"); next unless ($exit); - &main::DEBUG("hmr... => ".(time() - (stat($file))[8])."'."); + &::DEBUG("deb: hmr... => ".(time() - (stat($debian_dir/$file))[8])."'."); next unless (time() - (stat($file))[8] > 3600); - &main::DEBUG("dC: exit => '$exit'."); - &main::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' "; + &::performStrictReply( &::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' "; + &::performStrictReply( &::formListReply(0, $prefix, @list) ); + } +} + 1; + +# vim:ts=4:sw=4:expandtab:tw=80