Tweak to cope with different DB file names
[debian-cd-search.git] / find_file.cgi
1 #!/usr/bin/perl
2 #
3 # find_file.cgi
4 #
5 # Look through a provided database to find which CD/DVD image(s)
6 # contain a specified Debian package or source file.
7
8 # Copyright (c) 2011-2017 Steve McIntyre <93sam@debian.org>
9
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.
14 #
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.
19 #
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
23
24 use strict;
25 use warnings;
26 use threads;
27 use DB_File;
28 use CGI;
29 use ConfigReader::Simple;
30 use DBI;
31 use DBD::SQLite;
32
33 my %conf;
34 my $cdimage_url = "http://cdimage.debian.org/cdimage/";
35 my $source_url = "https://git.einval.com/cgi-bin/gitweb.cgi?p=debian-cd-search.git";
36 my @AREAS;
37 my %num_files;
38 my %fileinfo;
39 my %imageinfo;
40 my $query_term;
41 my $query_type;
42 my %results;
43 my @chosen_areas;
44 my $l = "";
45 my $max_count = 1000;
46 my $header1 = "";
47 my $header2 = "";
48 my $footer1 = "";
49 my $footer2 = "";
50 my $last_update = 0;
51
52 my $version = "0.11";
53 my $title_base = "Debian CD search engine";
54
55 my $q = new CGI;
56 my $mode = "none";
57 my $authorname = "Steve McIntyre";
58 my $authormail = '93sam@debian.org';
59
60 sub set_default_config () {
61     $conf{'dbdir'} = "/home/steve/debian/debian-cd/search/search-db";
62     $conf{'htmldir'} = "/home/steve/debian/debian-cd/html";
63     $conf{'debug'} = 0;
64     $conf{'dbtype'} = "sqlite";
65 }
66
67 # If we can find an appropriately-name config file, read it and
68 # over-write the default config for $conf{'dbdir'} and $conf{'htmldir'}
69 sub read_config () {
70     my $config_file;
71
72     $config_file = $0;
73     $config_file =~ s/find_file.cgi/find_file.cfg/;
74     if (-r $config_file) {
75         my $config = ConfigReader::Simple->new($config_file);
76         foreach my $key (keys %conf) {
77             if ($config->exists($key)) {
78                 $conf{$key} = $config->get($key);
79             }
80         }
81     }
82 }
83
84 sub file_mtime {
85     my ($file) = shift;
86     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
87         $atime,$mtime,$ctime,$blksize,$blocks)
88         = lstat($file);
89     if (! $dev) {
90         return -$!;
91     }
92     return $mtime;
93 }
94
95 sub read_files ($) {
96     my $lang = shift;
97     
98     open IN, "<", "$conf{'htmldir'}/header1.$lang.html";
99     while(<IN>) { $header1 .= $_; }
100     close(IN);
101     open IN, "<", "$conf{'htmldir'}/header2.$lang.html";
102     while(<IN>) { $header2 .= $_; }
103     close(IN);
104     open IN, "<", "$conf{'htmldir'}/footer1.$lang.html";
105     while(<IN>) { $footer1 .= $_; }
106     close(IN);
107     open IN, "<", "$conf{'htmldir'}/footer2.$lang.html";
108     while(<IN>) { $footer2 .= $_; }
109     close(IN);
110 }
111
112 sub date_string ($) {
113     my $time = shift;
114     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
115         gmtime($time);
116     $year += 1900;
117     $mon += 1;
118     return sprintf("%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d UTC", $year, $mon, $mday, $hour, $min, $sec);
119 }
120
121 sub print_header () {
122     print $q->header;
123 }
124
125 sub print_html_header ($) {
126     my $title = shift;
127     print $q->start_html(
128         -title=>"$title",
129         -author=>"$authormail",
130         -style=>{'src'=>'https://www.debian.org/debian.css'},
131         );
132     print $header1;
133     print '<p id="breadcrumbs">cdimage-search.debian.org</p>';
134     print $header2;
135     print '<div id="maincol">';
136 }
137
138 sub print_config_if_debug () {
139     if ($conf{'debug'}) {
140         print $q->h2("CONFIG DEBUG"), "\n<ul>\n";
141         foreach my $key (keys %conf) {
142             print $q->li("config.$key: $conf{$key}");
143         }
144         print "</ul>\n";
145     }
146 }
147
148 sub print_footer () {
149     my $date = date_string($last_update);
150     print $footer1;
151     print
152         $q->address("Database last updated $date\n"),
153         $q->address("$title_base version $version, source at <a href=\"$source_url\">$source_url</a>\n"),
154         $q->address("$authorname &lt;$authormail&gt;\n"),
155         $q->hr;
156     print $footer2;
157     print '</div> <!-- end footer -->';
158 }
159
160 # Borrowed from Ikiwiki.pm
161 sub glob2re ($) {
162     my $re=quotemeta(shift);
163     $re=~s/\\\*/.*/g;
164     $re=~s/\\\?/./g;
165     return qr/^$re$/i;
166 }
167
168 sub read_text ($) {
169     my $filename = shift;
170     my $text = "no description";
171     if (-f $filename) {
172         open INFILE, "<", "$filename" || return $text;
173         $text = "";
174         while (<INFILE>) {
175             chomp;
176             $text .= $_;
177         }
178         close INFILE;
179     }
180     return $text;
181 }
182
183 sub log_error ($$) {
184     my $errornum = shift;
185     my $errortext = shift;
186
187     print_header();
188     print_html_header("$title_base");
189     print
190         $q->h1($title_base),
191         $q->p("Error: $errortext"),
192         $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
193     print_config_if_debug();
194     print_footer();
195     print $q->end_html;
196     exit 0;
197 }
198
199 sub blank_form ($) {
200     my $error = shift;
201
202     my %area_labels;
203     my %type_labels;
204
205     foreach my $area(@AREAS) {
206         $area_labels{$area} = "$area (" . read_text("$area.text") . ")";
207     }
208     $type_labels{"simple"} = "simple substring search";
209     $type_labels{"exact"} = "exact filename search (faster); shell globs (*,?) are permitted";
210
211     print_header();
212     print_html_header("$title_base");
213     $q->autoEscape(undef);
214     print $q->h1("$title_base"), "\n";
215     print_config_if_debug();
216     print $q->p("This tool searches for files contained in Debian CD/DVD images, such as:"), "\n";
217     print
218         "<ul>\n",
219         $q->li("package files (.deb, .udeb)"), "\n",
220         $q->li("source files (.tar.gz, .tar.bz2, .diff.gz, etc.)"), "\n",
221         "</ul>\n";        
222     print $q->start_form(-method=>"GET");
223     print $q->p("Select which set(s) of images you wish to look in:"), "\n";
224     print $q->checkbox_group(-name=>'search_area',
225                              -values=>\@AREAS,
226                              -defaults=>['release'],
227                              -linebreak=>'true',
228                              -labels=>\%area_labels);
229     print $q->p("And a search type: ");
230     print $q->radio_group(-name=>'type',
231                           -values=>['simple', 'exact'],
232                           -default=>'simple',
233                           -linebreak=>'true',
234                           -labels=>\%type_labels);
235     print $q->p("Exact lookups with no globbing will give the fastest results.");
236
237     print $q->textfield(-name=>'query',
238                         -value=>'',
239                         -size=>50,
240                         -maxlength=>100);
241     print $q->submit(-name=>'Search',
242                      value=>'Search');
243     if (length($error)) {
244         print $q->p({-style=>'color: red'}, "ERROR: $error"), "\n";
245     }
246     print $q->end_form;
247     print_footer();
248     print $q->end_html;
249     exit 0;
250 }
251
252 sub list_link ($) {
253     my $link = $cdimage_url . shift;
254     return $link;
255 }
256
257 sub iso_link ($) {
258     my $link = $cdimage_url . shift;
259     $link =~ s/list-/iso-/g;
260     $link =~ s/list\.gz$/iso/g;
261     return $link;
262 }
263
264 sub jigdo_link ($) {
265     my $link = $cdimage_url . shift;
266     $link =~ s/list-/jigdo-/g;
267     $link =~ s/list\.gz$/jigdo/g;
268     return $link;
269 }
270
271 sub pretty_name ($) {
272     my $name = shift;
273     $name =~ s/^.*\///g;
274     $name =~ s/\.list\.gz$//g;
275     return $name;
276 }    
277
278 sub keepalive_thread () {
279     $| = 1;
280     $SIG{'KILL'} = sub { threads->exit(); };
281     while(1) {
282         sleep 10;
283         print "<!-- processing, please wait... -->\n";
284     }
285 }
286
287 set_default_config();
288 read_config();
289 read_files("en");
290 chdir($conf{'dbdir'}) || log_error(500, "Failed to cd to $conf{'dbdir'}: $!\n");
291 opendir(my $dh, ".") || log_error(500, "Failed to open $conf{'dbdir'}: $!\n");
292
293
294 while (defined($_ = readdir($dh))) {
295     if ($conf{'dbtype'} eq "hashdb") {
296         if (m/(.*)\.db$/) {
297             my $mtime = file_mtime("$1.db");
298             if ($mtime > $last_update) {
299                 $last_update = $mtime;
300             }
301             push(@AREAS, "$1");
302         }
303     }
304     else {
305         if (m/(.*)\.db.sqlite$/) {
306             my $mtime = file_mtime("$1.db.sqlite");
307             if ($mtime > $last_update) {
308                 $last_update = $mtime;
309             }
310             push(@AREAS, "$1");
311         }
312     }
313 }
314 closedir($dh);
315
316 @chosen_areas = $q->param('search_area');
317 $query_term = $q->param('query');
318 $query_type = $q->param('type');
319
320 # Check what we've been given, if anything
321 if ( (!@chosen_areas) && 
322      (!defined($query_term) || length($query_term) == 0)) {
323     blank_form("");
324 }
325
326 if (defined($query_term)) {
327     if ($query_term =~ m/[\@\~\[\]\{\}|#\%\<\>\'\";\\\/]/) {
328         $q->param(-name=>'query', -value=>'');
329         $q->param(-name=>'type', -value=>'');
330         $q->param(-name=>'search_area', -value=>());
331         blank_form("Invalid query string");
332     }
333 }
334
335 if (defined($query_type)) {
336     if (!($query_type eq "exact" or $query_type eq "simple")) {
337         $q->param(-name=>'query', -value=>'');
338         $q->param(-name=>'type', -value=>'');
339         $q->param(-name=>'search_area', -value=>());
340         blank_form("Invalid query string");
341     }
342 }
343
344 if (!(@chosen_areas) && defined($query_term)) {
345     blank_form("No search areas chosen");
346 }
347
348 if (@chosen_areas && 
349     (!defined($query_term) || length($query_term) == 0)) {
350     blank_form("No search terms entered");
351 }
352
353 my $count = 0;
354 my $count_images = 0;
355 my $re_search;
356 my $using_glob = "";
357 if ($query_type eq "simple") {
358     $re_search = glob2re('*' . join('*', split(/ /, $query_term)) . '*');
359 } else {
360     $re_search = glob2re($query_term);
361 }
362
363 # If we get here, we have stuff to work with. Yay!
364
365 select STDERR; $| = 1;  # make unbuffered
366 select STDOUT; $| = 1;  # make unbuffered
367
368 my $start_time = time();
369 print_header();
370 print_html_header("$title_base results");
371
372 # Now start the keepalive thread to print something every few seconds
373 my $thr = threads->create(\&keepalive_thread);
374
375 if ($conf{'dbtype'} eq "hashdb") {
376     foreach my $area (@chosen_areas) {
377         my $db_file_name = "$conf{'dbdir'}/$area.db";
378         $l .= "Looking in area $area, file $db_file_name<br>\n";
379         dbmopen(%fileinfo, "$db_file_name", 0000) ||
380             log_error(500, "Failed to open db file: $!\n");
381
382         if ($query_term =~ /[\*\?]/ || $query_type eq "simple") {
383             $using_glob = "(using globs)";
384             # Will need to search through all the keys to allow for glob
385             foreach my $file (keys %fileinfo) {
386                 if ($file =~ $re_search) {
387                     $count++;
388                     $count_images += scalar (split / /, $fileinfo{$file});
389                     $results{$file} = $fileinfo{$file};
390                     if ($count >= $max_count) {
391                         last;
392                     }
393                 }
394             }
395         } else {
396             # We've been given an exact name - do the exact key lookup \o/
397             if (defined($fileinfo{$query_term})) {
398                 $results{$query_term} = $fileinfo{$query_term};
399                 $count_images += scalar (split / /, $fileinfo{$query_term});
400                 $count++;
401             }
402         }
403         if ($count >= $max_count) {
404             last;
405         }
406         dbmclose %fileinfo;
407     }
408 } else {
409     foreach my $area (@chosen_areas) {
410         my $sth;
411         my @db_results;
412         my $db_file_name = "$conf{'dbdir'}/$area.db.sqlite";
413         my $dbh = DBI->connect("dbi:SQLite:dbname=$db_file_name","","", {
414             sqlite_open_flags => DBD::SQLite::OPEN_READONLY,
415                                }) or log_error (500, "Failed to open DB file $db_file_name: $!\n");
416         $dbh->do("PRAGMA synchronous = OFF");
417
418         if ($query_term =~ /[\*\?]/ || $query_type eq "simple") {
419             $using_glob = "(using globs)";
420
421             # Will need to use sql LIKE and SQL wildcards
422             my $sql_term = "*" . $query_term . "*";
423             $sql_term =~ s,\*,\%,g;
424             $sql_term =~ s,\?,\_,g;
425             $sth = $dbh->prepare("SELECT * FROM entries WHERE filename LIKE ? ORDER BY filename ASC, jigdo ASC");
426             $sth->execute($sql_term);
427         } else {
428             # We've been given an exact name - do the exact lookup
429             $sth = $dbh->prepare("SELECT * FROM entries WHERE filename=? ORDER BY filename ASC");
430             $sth->execute($query_term);
431         }
432         while (@db_results = $sth->fetchrow_array) {
433             my $file = $db_results[0];
434             my $image = $db_results[1];
435             if (defined($results{$file})) {
436                 $results{$file} = "$results{$file} $image";
437                 $count_images++;
438             } else {
439                 $results{$file} = "$image";
440                 $count++;
441                 $count_images++;
442             }
443             if ($count >= $max_count) {
444                 last;
445             }
446         }
447         $dbh->disconnect();
448     }
449 }
450
451 # Kill the keepalive thread
452 $thr->kill('KILL')->detach();
453
454 my $end_time = time();
455 my $time_taken = $end_time - $start_time;
456
457 print
458     $q->start_html("$title_base: $count results from $count_images images"),
459     $q->h1($title_base), "\n";
460     print_config_if_debug();
461 if ($conf{'debug'}) {
462     print $q->h2("QUERY DEBUG"), "\n<ul>\n";
463     print $q->li("areas: @chosen_areas");
464     print $q->li("query type: $query_type");
465     print $q->li("query term: \"$query_term\" $using_glob");
466     print $q->li("re_search: \"$re_search\"");
467     print $q->li("time taken: $time_taken sec\n");
468     print "</ul>\n";
469 }
470 print $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
471 if ($count >= $max_count) {
472     print $q->p("More than $max_count results for $query_type search \"$query_term\". Showing the first $count only\n");
473 } else {   
474     print $q->p("$count result(s), $count_images image(s) for \"$query_term\":\n");
475 }
476 if ($count > 0) {
477     print "<ol>\n";
478     foreach my $found (sort (keys %results)) {
479         my @list = split(' ', $results{$found});
480         print "<li> $found appears in:\n";
481         print "<ul>\n";
482         foreach my $image (sort(@list)) {
483             print "<li>" . pretty_name($image);
484             print " (<a href=\"" . list_link($image) . "\">list.gz</a> |";
485             print " <a href=\"" . jigdo_link($image) . "\">jigdo</a> |";
486             print " <a href=\"" . iso_link($image) . "\">iso</a>)\n";
487         }
488         print "</ul>\n";
489     }
490     print "</ol>\n";
491 }
492 print $q->p("<a href=\"" . $q->url . "\">Search again.</a>");
493 print_footer();
494 print $q->end_html;