5 # Look through a provided database to find which CD/DVD image(s)
6 # contain a specified Debian package or source file.
8 # Copyright (c) 2011-2017 Steve McIntyre <93sam@debian.org>
10 # This program is free software; you can redistribute it and/or modify
11 # it under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; either version 2 of the License, or
13 # (at your option) any later version.
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 # GNU General Public License for more details.
20 # You should have received a copy of the GNU General Public License
21 # along with this program; if not, write to the Free Software
22 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
29 use ConfigReader::Simple;
32 my $cdimage_url = "http://cdimage.debian.org/cdimage/";
33 my $source_url = "https://git.einval.com/cgi-bin/gitweb.cgi?p=debian-cd-search.git";
51 my $title_base = "Debian CD search engine";
55 my $authorname = "Steve McIntyre";
56 my $authormail = '93sam@debian.org';
58 sub set_default_config () {
59 $conf{'dbdir'} = "/home/steve/debian/debian-cd/search/search-db";
60 $conf{'htmldir'} = "/home/steve/debian/debian-cd/html";
64 # If we can find an appropriately-name config file, read it and
65 # over-write the default config for $conf{'dbdir'} and $conf{'htmldir'}
70 $config_file =~ s/find_file.cgi/find_file.cfg/;
71 if (-r $config_file) {
72 my $config = ConfigReader::Simple->new($config_file);
73 foreach my $key (keys %conf) {
74 if ($config->exists($key)) {
75 $conf{$key} = $config->get($key);
83 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
84 $atime,$mtime,$ctime,$blksize,$blocks)
95 open IN, "<", "$conf{'htmldir'}/header1.$lang.html";
96 while(<IN>) { $header1 .= $_; }
98 open IN, "<", "$conf{'htmldir'}/header2.$lang.html";
99 while(<IN>) { $header2 .= $_; }
101 open IN, "<", "$conf{'htmldir'}/footer1.$lang.html";
102 while(<IN>) { $footer1 .= $_; }
104 open IN, "<", "$conf{'htmldir'}/footer2.$lang.html";
105 while(<IN>) { $footer2 .= $_; }
109 sub date_string ($) {
111 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
115 return sprintf("%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d UTC", $year, $mon, $mday, $hour, $min, $sec);
118 sub print_header () {
122 sub print_html_header ($) {
124 print $q->start_html(
126 -author=>"$authormail",
127 -style=>{'src'=>'https://www.debian.org/debian.css'},
130 print '<p id="breadcrumbs">cdimage-search.debian.org</p>';
132 print '<div id="maincol">';
135 sub print_config_if_debug () {
136 if ($conf{'debug'}) {
137 print $q->h2("CONFIG DEBUG"), "\n<ul>\n";
138 foreach my $key (keys %conf) {
139 print $q->li("config.$key: $conf{$key}");
145 sub print_footer () {
146 my $date = date_string($last_update);
149 $q->address("Database last updated $date\n"),
150 $q->address("$title_base version $version, source at <a href=\"$source_url\">$source_url</a>\n"),
151 $q->address("$authorname <$authormail>\n"),
154 print '</div> <!-- end footer -->';
157 # Borrowed from Ikiwiki.pm
159 my $re=quotemeta(shift);
166 my $filename = shift;
167 my $text = "no description";
169 open INFILE, "<", "$filename" || return $text;
181 my $errornum = shift;
182 my $errortext = shift;
185 print_html_header("$title_base");
188 $q->p("Error: $errortext"),
189 $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
190 print_config_if_debug();
202 foreach my $area(@AREAS) {
203 $area_labels{$area} = "$area (" . read_text("$area.text") . ")";
205 $type_labels{"simple"} = "simple substring search";
206 $type_labels{"exact"} = "exact filename search (faster); shell globs (*,?) are permitted";
209 print_html_header("$title_base");
210 $q->autoEscape(undef);
211 print $q->h1("$title_base"), "\n";
212 print_config_if_debug();
213 print $q->p("This tool searches for files contained in Debian CD/DVD images, such as:"), "\n";
216 $q->li("package files (.deb, .udeb)"), "\n",
217 $q->li("source files (.tar.gz, .tar.bz2, .diff.gz, etc.)"), "\n",
219 print $q->start_form(-method=>"GET");
220 print $q->p("Select which set(s) of images you wish to look in:"), "\n";
221 print $q->checkbox_group(-name=>'search_area',
223 -defaults=>['release'],
225 -labels=>\%area_labels);
226 print $q->p("And a search type: ");
227 print $q->radio_group(-name=>'type',
228 -values=>['simple', 'exact'],
231 -labels=>\%type_labels);
232 print $q->p("Exact lookups with no globbing will give the fastest results.");
234 print $q->textfield(-name=>'query',
238 print $q->submit(-name=>'Search',
240 if (length($error)) {
241 print $q->p({-style=>'color: red'}, "ERROR: $error"), "\n";
250 my $link = $cdimage_url . shift;
255 my $link = $cdimage_url . shift;
256 $link =~ s/list-/iso-/g;
257 $link =~ s/list\.gz$/iso/g;
262 my $link = $cdimage_url . shift;
263 $link =~ s/list-/jigdo-/g;
264 $link =~ s/list\.gz$/jigdo/g;
268 sub pretty_name ($) {
271 $name =~ s/\.list\.gz$//g;
275 sub keepalive_thread () {
277 $SIG{'KILL'} = sub { threads->exit(); };
280 print "<!-- processing, please wait... -->\n";
284 set_default_config();
287 chdir($conf{'dbdir'}) || log_error(500, "Failed to cd to $conf{'dbdir'}: $!\n");
288 opendir(my $dh, ".") || log_error(500, "Failed to open $conf{'dbdir'}: $!\n");
289 while (defined($_ = readdir($dh))) {
291 my $mtime = file_mtime("$1.db");
292 if ($mtime > $last_update) {
293 $last_update = $mtime;
300 @chosen_areas = $q->param('search_area');
301 $query_term = $q->param('query');
302 $query_type = $q->param('type');
304 # Check what we've been given, if anything
305 if ( (!@chosen_areas) &&
306 (!defined($query_term) || length($query_term) == 0)) {
310 if (defined($query_term)) {
311 if ($query_term =~ m/[\@\~\[\]\{\}|#\%\<\>\'\";\\\/]/) {
312 $q->param(-name=>'query', -value=>'');
313 $q->param(-name=>'type', -value=>'');
314 $q->param(-name=>'search_area', -value=>());
315 blank_form("Invalid query string");
319 if (defined($query_type)) {
320 if (!($query_type eq "exact" or $query_type eq "simple")) {
321 $q->param(-name=>'query', -value=>'');
322 $q->param(-name=>'type', -value=>'');
323 $q->param(-name=>'search_area', -value=>());
324 blank_form("Invalid query string");
328 if (!(@chosen_areas) && defined($query_term)) {
329 blank_form("No search areas chosen");
333 (!defined($query_term) || length($query_term) == 0)) {
334 blank_form("No search terms entered");
340 if ($query_type eq "simple") {
341 $re_search = glob2re('*' . join('*', split(/ /, $query_term)) . '*');
343 $re_search = glob2re($query_term);
346 # If we get here, we have stuff to work with. Yay!
348 select STDERR; $| = 1; # make unbuffered
349 select STDOUT; $| = 1; # make unbuffered
351 my $start_time = time();
353 print_html_header("$title_base results");
355 # Now start the keepalive thread to print something every few seconds
356 my $thr = threads->create(\&keepalive_thread);
358 foreach my $area (@chosen_areas) {
359 my $db_file_name = "$conf{'dbdir'}/$area.db";
360 $l .= "Looking in area $area, file $db_file_name<br>\n";
361 dbmopen(%fileinfo, "$db_file_name", 0000) ||
362 log_error(500, "Failed to open db file: $!\n");
364 if ($query_term =~ /[\*\?]/ || $query_type eq "simple") {
365 $using_glob = "(using globs)";
366 # Will need to search through all the keys to allow for glob
367 foreach my $file (keys %fileinfo) {
368 if ($file =~ $re_search) {
370 push(@results, "$file $fileinfo{$file}");
371 if ($count >= $max_count) {
377 # We've been given an exact name - do the exact key lookup \o/
378 if (defined($fileinfo{$query_term})) {
379 push (@results, "$query_term $fileinfo{$query_term}");
383 if ($count >= $max_count) {
389 # Kill the keepalive thread
390 $thr->kill('KILL')->detach();
392 my $end_time = time();
393 my $time_taken = $end_time - $start_time;
396 $q->start_html("$title_base: $count results"),
397 $q->h1($title_base), "\n";
398 print_config_if_debug();
399 if ($conf{'debug'}) {
400 print $q->h2("QUERY DEBUG"), "\n<ul>\n";
401 print $q->li("areas: @chosen_areas");
402 print $q->li("query type: $query_type");
403 print $q->li("query term: \"$query_term\" $using_glob");
404 print $q->li("re_search: \"$re_search\"");
405 print $q->li("time taken: $time_taken sec\n");
408 print $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
409 if ($count >= $max_count) {
410 print $q->p("More than $max_count results for $query_type search \"$query_term\". Showing the first $count only\n");
412 print $q->p("$count result(s) for $query_type search \"$query_term\".\n");
416 foreach my $result (sort (@results)) {
417 my($found, @list) = split(' ', $result);
418 print "<li> $found appears in:\n";
420 foreach my $image (sort(@list)) {
421 print "<li>" . pretty_name($image);
422 print " (<a href=\"" . list_link($image) . "\">list.gz</a> |";
423 print " <a href=\"" . jigdo_link($image) . "\">jigdo</a> |";
424 print " <a href=\"" . iso_link($image) . "\">iso</a>)\n";
430 print $q->p("<a href=\"" . $q->url . "\">Search again.</a>");