X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FModules%2FDebian.pl;h=4dfadfb8c2a29c78e535b49d164940b94d6ef36c;hb=d3faaba2ad8c02cdf10e1a9698592afc6ed928bc;hp=2bbe82ee2da5f4559602070af44570efebd280ef;hpb=b39c9477e23feb2c0938d8fd565c410178582141;p=infobot.git diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl index 2bbe82e..4dfadfb 100644 --- a/src/Modules/Debian.pl +++ b/src/Modules/Debian.pl @@ -5,63 +5,92 @@ # Created: 20000106 # + +# XXX Add uploader field support + package Debian; use strict; +no strict 'refs'; # FIXME: dstats aborts if set -# format: "alias=real". my $announce = 0; -my $defaultdist = "sid"; -my $refresh = &::getChanConfDefault("debianRefreshInterval",7) - * 60 * 60 * 24; +my $defaultdist = 'sid'; +my $refresh = &::getChanConfDefault('debianRefreshInterval', 7, $::chan) * 60 * 60 * 24; my $debug = 0; -my $debian_dir = "$::bot_state_dir/debian"; +my $debian_dir = $::bot_state_dir . 'debian'; +my $country = 'us'; # well .config it yourself then. ;-) +my $protocol = 'http'; -### ... old -#my %dists = ( -# "sid" => "unstable", -# "woody" => "testing", # new since 20001219. -# "potato" => "stable", -# "incoming" => "incoming", -#); - -### new... the right way. +# format: "alias=real". my %dists = ( - "unstable" => "sid", - "testing" => "woody", # new since 20001219. - "stable" => "potato", - "incoming" => "incoming", + 'unstable' => 'sid', + 'testing' => 'lenny', + 'stable' => 'etch', + 'experimental' => 'experimental', + 'oldstable' => 'sarge', + 'incoming' => 'incoming', +); + +my %archived_dists = ( + woody => 'woody', + potato => 'potato', + hamm => 'hamm', + buzz => 'buzz', + bo => 'bo', + rex => 'rex', + slink => 'slink', +); + +my %archiveurlcontents = ( + "Contents-##DIST-i386.gz" => + "$protocol://debian.crosslink.net/debian-archive". + "/dists/##DIST/Contents-i386.gz", ); +my %archiveurlpackages = ( + "Packages-##DIST-main-i386.gz" => + "$protocol://debian.crosslink.net/debian-archive". + "/dists/##DIST/main/binary-i386/Packages.gz", + "Packages-##DIST-contrib-i386.gz" => + "$protocol://debian.crosslink.net/debian-archive". + "/dists/##DIST/contrib/binary-i386/Packages.gz", + "Packages-##DIST-non-free-i386.gz" => + "$protocol://debian.crosslink.net/debian-archive". + "/dists/##DIST/non-free/binary-i386/Packages.gz", +); + + + + my %urlcontents = ( "Contents-##DIST-i386.gz" => - "ftp://ftp.us.debian.org". - "/debian/dists/##DIST/Contents-i386.gz", + "$protocol://debian.usc.edu". + "/dists/##DIST/Contents-i386.gz", "Contents-##DIST-i386-non-US.gz" => - "ftp://non-us.debian.org". + "$protocol://non-us.debian.org". "/debian-non-US/dists/##DIST/non-US/Contents-i386.gz", ); my %urlpackages = ( "Packages-##DIST-main-i386.gz" => - "ftp://ftp.us.debian.org". - "/debian/dists/##DIST/main/binary-i386/Packages.gz", + "$protocol://debian.usc.edu". + "/dists/##DIST/main/binary-i386/Packages.gz", "Packages-##DIST-contrib-i386.gz" => - "ftp://ftp.us.debian.org". - "/debian/dists/##DIST/contrib/binary-i386/Packages.gz", + "$protocol://debian.usc.edu". + "/dists/##DIST/contrib/binary-i386/Packages.gz", "Packages-##DIST-non-free-i386.gz" => - "ftp://ftp.us.debian.org". - "/debian/dists/##DIST/non-free/binary-i386/Packages.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", - "Packages-##DIST-non-US-contrib-i386.gz" => - "ftp://non-us.debian.org". - "/debian-non-US/dists/##DIST/non-US/contrib/binary-i386/Packages.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", + "$protocol://debian.usc.edu". + "/dists/##DIST/non-free/binary-i386/Packages.gz", + +# "Packages-##DIST-non-US-main-i386.gz" => +# "$protocol://non-us.debian.org". +# "/debian-non-US/dists/##DIST/non-US/main/binary-i386/Packages.gz", +# "Packages-##DIST-non-US-contrib-i386.gz" => +# "$protocol://non-us.debian.org". +# "/debian-non-US/dists/##DIST/non-US/contrib/binary-i386/Packages.gz", +# "Packages-##DIST-non-US-non-free-i386.gz" => +# "$protocol://non-us.debian.org". +# "/debian-non-US/dists/##DIST/non-US/non-free/binary-i386/Packages.gz", ); ##################### @@ -89,7 +118,7 @@ sub DebianDownload { $file =~ s/##DIST/$dist/g; my $update = 0; - if ( -f $file) { + if ( -f $file ) { my $last_refresh = (stat $file)[9]; $update++ if (time() - $last_refresh > $refresh); } else { @@ -114,41 +143,46 @@ sub DebianDownload { if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) { my ($host,$path,$thisfile) = ($1,$2,$3); -### 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; -# } - if (!&::ftpGet($host,$path,$thisfile,$file)) { &::WARN("deb: down: $file == BAD."); $bad++; next; } - if (! -f $file) { - &::WARN("deb: down: ftpGet: !file"); + } elsif ($url =~ /^http:\/\/\S+\/\S+$/) { + + if (!&::getURLAsFile($url,$file)) { + &::WARN("deb: down: http: $file == BAD."); $bad++; next; } -### 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.") if ($debug); - $good++; } else { &::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; @@ -176,19 +210,19 @@ sub searchContents { $query =~ s/^\s+|\s+$//g; if (!&::validExec($query)) { - &::msg($::who, "search string looks fuzzy."); + &::msg($::who, 'search string looks fuzzy.'); return; } - if ($dist eq "incoming") { # nothing yet. - &::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. - &::DEBUG("deb: download 1.") if ($debug); + &::DEBUG('deb: download 1.') if ($debug); if (!&DebianDownload($dist, %urls)) { - &::WARN("Debian: could not download files."); + &::WARN('Debian: could not download files.'); } } @@ -215,11 +249,9 @@ sub searchContents { $grepRE =~ s/\*/.*/g; my @files; - foreach (keys %urlcontents) { - s/##DIST/$dist/g; - - next unless ( -f "$debian_dir/$_" ); - push(@files, "$debian_dir/$_" ); + foreach (keys %urls) { + next unless ( -f $_ ); + push(@files, $_); } if (!scalar @files) { @@ -236,26 +268,27 @@ sub searchContents { $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 (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); + + 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($@); - last if ($found > 100); + $contents{$package}{$file} = 1; + $found++; } close IN; @@ -274,7 +307,7 @@ 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; } @@ -313,24 +346,25 @@ sub searchContents { my $prefix = "Debian Search of '$query' "; if (scalar @list) { # @list. - &::pSReply( &::formListReply(0, $prefix, @list) ); + &::performStrictReply( &::formListReply(0, $prefix, @list) ); + return; + } - } else { # !@list. - &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug); - my @list = &searchDesc($query); + # !@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' "; - &::pSReply( &::formListReply(0, $prefix, ) ); + 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]); + } 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) ); - } + } else { # list > 1. + my $prefix = "Debian Desc Search of '$query' "; + &::performStrictReply( &::formListReply(0, $prefix, @list) ); } } @@ -345,14 +379,11 @@ sub searchAuthor { my $start_time = &::timeget(); &::status("Debian: starting author search."); + my %urls = fixDist($dist,'packages'); my $files; my ($bad,$good) = (0,0); - my %urls = %urlpackages; - - foreach (keys %urlpackages) { - s/##DIST/$dist/g; - - if (! -f "$debian_dir/$_" ) { + foreach (keys %urls) { + if (! -f $_ ) { $bad++; next; } @@ -364,8 +395,7 @@ sub searchAuthor { &::DEBUG("deb: good = $good, bad = $bad...") if ($debug); if ($good == 0 and $bad != 0) { - my %urls = &fixDist($dist, %urlpackages); - &::DEBUG("deb: download 2."); + &::DEBUG("deb: download 2."); if (!&DebianDownload($dist, %urls)) { &::ERROR("Debian(sA): could not download files."); @@ -390,7 +420,8 @@ sub searchAuthor { $package = ""; } else { - &::WARN("invalid line: '$_'."); + chop; + &::WARN("debian: invalid line: '$_' (1)."); } } close IN; @@ -419,7 +450,7 @@ sub searchAuthor { my @list = keys %hash; if (scalar @list != 1) { my $prefix = "Debian Author Search of '$query' "; - &::pSReply( &::formListReply(0, $prefix, @list) ); + &::performStrictReply( &::formListReply(0, $prefix, @list) ); return 1; } @@ -433,7 +464,7 @@ sub searchAuthor { my $email = join(', ', keys %{ $maint{$list[0]} }); my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 "; - &::pSReply( &::formListReply(0, $prefix, @pkg) ); + &::performStrictReply( &::formListReply(0, $prefix, @pkg) ); } #### @@ -449,24 +480,22 @@ sub searchDesc { my $files; my ($bad,$good) = (0,0); - my %urls = %urlpackages; - - foreach (keys %urlpackages) { - s/##DIST/$dist/g; + my %urls = fixDist($dist,'packages'); - if (! -f "$debian_bot/$_" ) { + # XXX This should be abstracted elsewhere. + foreach (keys %urls) { + if (! -f $_ ) { $bad++; next; } $good++; - $files .= " $debian_dir/$_"; + $files .= " $_"; } &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug); if ($good == 0 and $bad != 0) { - my %urls = &fixDist($dist, %urlpackages); &::DEBUG("deb: download 2c.") if ($debug); if (!&DebianDownload($dist, %urls)) { @@ -494,10 +523,13 @@ sub searchDesc { &::WARN("sD: package == NULL?"); next; } + $desc{$package} = $desc; $package = ""; + } else { - &::WARN("invalid line: '$_'."); + chop; + &::WARN("debian: invalid line: '$_'. (2)"); } } close IN; @@ -523,11 +555,11 @@ sub generateIncoming { ### 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; } @@ -572,7 +604,7 @@ sub getPackageInfo { 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) { @@ -583,7 +615,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; } @@ -652,7 +684,7 @@ sub infoPackages { # download packages file. # hrm... - my %urls = &fixDist($dist, %urlpackages); + my %urls = &fixDist($dist,'packages'); if ($dist ne "incoming") { &::DEBUG("deb: download 3.") if ($debug); @@ -667,6 +699,7 @@ sub infoPackages { if (!scalar @files) { &::status("Debian: no valid package found; checking incoming."); @files = &validPackage($package, "incoming"); + if (scalar @files) { &::status("Debian: cool, it exists in incoming."); $incoming++; @@ -684,7 +717,7 @@ sub infoPackages { if (! -f $files[0]) { &::WARN("files[0] ($files[0]) doesn't exist."); - &::msg($::who, "WARNING: $files[0] does not exist? FIXME"); + &::msg($::who, "FIXME: $files[0] does not exist?"); return 'NULL'; } @@ -703,28 +736,11 @@ sub infoPackages { } 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'} .= ". 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?"); - } - } - } else { + if (scalar keys %pkg <= 5) { &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).")."); &debianCheck(); &::DEBUG("deb: end of debianCheck()"); @@ -732,7 +748,26 @@ sub infoPackages { &::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"; @@ -754,7 +789,7 @@ sub infoPackages { } } - &::pSReply("$package: $pkg{$query}"); + &::performStrictReply("$package: $pkg{$query}"); } # Usage: &infoStats($dist); @@ -766,7 +801,7 @@ sub infoStats { &::DEBUG("deb: infoS: dist => '$dist'."); # download packages file if needed. - my %urls = &fixDist($dist, %urlpackages); + my %urls = &fixDist($dist,'packages'); &::DEBUG("deb: download 4."); if (!&DebianDownload($dist, %urls)) { &::WARN("Debian(iS): could not download ANY files."); @@ -775,19 +810,18 @@ sub infoStats { } 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. + foreach $file (keys %urls) { &::DEBUG("deb: file => '$file'."); if (exists $stats{$file}{'count'}) { &::DEBUG("deb: hrm... duplicate open with $file???"); next; } - open(IN,"zcat $file 2>&1 |"); + open(IN, "zcat $file 2>&1 |"); - if (! -e $file) { + if (! -e "$file") { &::DEBUG("deb: iS: $file does not exist."); next; } @@ -818,7 +852,7 @@ sub infoStats { ### TODO: don't count ppl with multiple email addresses. - &::pSReply( + &::performStrictReply( "Debian Distro Stats on $dist... ". "\002$total{'count'}\002 packages, ". "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ". @@ -843,7 +877,7 @@ sub infoStats { # Usage: &generateIndex(); sub generateIndex { my (@dists) = @_; - &::status("Debian: !!! generateIndex($dists[0]) called !!!"); + &::DEBUG("D: generateIndex($dists[0]) called! ".join(':',caller(),)); if (!scalar @dists or $dists[0] eq '') { &::ERROR("gI: no dists to generate index."); return 1; @@ -852,6 +886,7 @@ sub generateIndex { foreach (@dists) { my $dist = &getDistro($_); # incase the alias is returned, possible? 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. @@ -865,25 +900,22 @@ sub generateIndex { next; } - if (/^woody$/i) { - &::DEBUG("deb: Copying old index of woody to -old"); - system("cp $idx $idx-old"); - } +# if (/^sarge$/i) { +# &::DEBUG("deb: Copying old index of sarge to -old"); +# system("cp $idx $idx-old"); +# } - &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...)."); - &DebianDownload($dist, &fixDist($dist, %urlpackages) ); + &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug); + &DebianDownload($dist, &fixDist($dist,'packages') ); &::status("Debian: generating index for '$dist'."); - if (!open(OUT,">$idx")) { + if (!open OUT, ">$idx") { &::ERROR("cannot write to $idx."); return 0; } my $packages; - foreach $packages (keys %urlpackages) { - $packages =~ s/##DIST/$dist/; - $packages = "$debian_dir/$packages"; - + foreach $packages (keys %urls) { if (! -e $packages) { &::ERROR("gIndex: '$packages' does not exist?"); next; @@ -918,7 +950,7 @@ sub validPackage { &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug); my $error = 0; - while (!open(IN, $debian_dir. "/Packages-$dist.idx")) { + while (!open IN, $debian_dir."/Packages-$dist.idx") { if ($error) { &::ERROR("Packages-$dist.idx does not exist (#1)."); return; @@ -950,26 +982,22 @@ sub validPackage { sub searchPackage { my ($dist, $query) = &getDistroFromStr($_[0]); - my $file = $debian_dir."/Packages-$dist.idx"; - my @files; + my $file = $debian_dir."/Packages-$dist.idx"; + my $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0; my $error = 0; - my $warn = 0; - - if ($query =~ tr/A-Z/a-z/) { - $warn++; - } + my @files; &::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("deb: sP: dist == incoming; calling gI()."); &generateIncoming(); } if ($error) { - &::ERROR("could not generate index ($file)!!!"); + &::ERROR("could not generate index ($file)!"); return; } @@ -1016,18 +1044,17 @@ sub getDistro { $dist = $defaultdist; } - if ($dist =~ /^(slink|hamm|rex|bo)$/i) { - &::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) { + } + 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; } @@ -1039,7 +1066,7 @@ sub getDistro { sub getDistroFromStr { my ($str) = @_; - my $dists = join '|', %dists; + my $dists = join '|', %dists, %archived_dists; my $dist = $defaultdist; if ($str =~ s/\s+($dists)$//i) { @@ -1052,33 +1079,52 @@ 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{$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) { - &::Forker("debian", sub { &searchContents($str); } ); + &::Forker("Debian", sub { &searchContents($str); } ); } elsif (scalar @results == 1) { &::status("searchPackage returned one result; getting info of package instead!"); - &::Forker("debian", sub { &infoPackages("info", "$results[0] $dist"); } ); + &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } ); } else { my $prefix = "Debian Package Listing of '$query' "; - &::pSReply( &::formListReply(0, $prefix, @results) ); + &::performStrictReply( &::formListReply(0, $prefix, @results) ); } } @@ -1090,10 +1136,12 @@ sub debianCheck { ### TODO: remove the following loop (check if dir exists before) while (1) { last if (opendir(DEBIAN, $debian_dir)); + if ($error) { &::ERROR("dC: cannot opendir debian."); return; } + mkdir $debian_dir, 0755; $error++; } @@ -1103,12 +1151,13 @@ sub debianCheck { while (defined($file = readdir DEBIAN)) { next unless ($file =~ /(gz|bz2)$/); - my $exit = system("gzip -t '$debian_dir/$file'"); + # TODO: add bzip2 support (debian doesn't do .bz2 anyway) + my $exit = system("/bin/gzip -t '$debian_dir/$file'"); next unless ($exit); - &::DEBUG("deb: hmr... => ".(time() - (stat($file))[8])."'."); + &::DEBUG("deb: hmr... => ".(time() - (stat($debian_dir/$file))[8])."'."); next unless (time() - (stat($file))[8] > 3600); - &::DEBUG("deb: dC: exit => '$exit'."); + #&::DEBUG("deb: dC: exit => '$exit'."); &::WARN("dC: '$debian_dir/$file' corrupted? deleting!"); unlink $debian_dir."/".$file; $retval++; @@ -1129,19 +1178,19 @@ sub checkEval { } sub searchDescFE { - &::DEBUG("deb: FE called for searchDesc"); +# &::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, ) ); + &::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' "; - &::pSReply( &::formListReply(0, $prefix, @list) ); + &::performStrictReply( &::formListReply(0, $prefix, @list) ); } }