#!/usr/bin/perl

use CGI;
use POSIX qw(WEXITSTATUS WIFEXITED WTERMSIG WIFSIGNALED);

BEGIN {
    use CGI::Carp qw(carpout);
    open(LOG, ">> /var/lib/lists-archives/searchlists.log") ||
	die "searchlists.log: $!\n";
    carpout(\*LOG);
}

$home = "/var/lib/lists-archives";
$glimpsedir = "$home/glimpse";
$glimpse = "/usr/bin/glimpse";
$webdir = "/archives";
$webhome = $home . $webdir;
$web = "/Lists-Archives";
$glimpsedata = "lists";
%months = qw(Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06 Jul 07 Aug 08 Sep 09
	     Oct 10 Nov 11 Dec 12);
chdir($home) || die "chdir: $home: $!\n";
$|=1;

$query = new CGI;

print $query->header;
print $query->start_html(-title=>'Debian GNU/Linux: Archive Search Results',
			 -author=>'maor@debian.org',
			 -base=>'true', -xbase=>$query->referer,
			 -BGCOLOR=>'white');

print <<END;
<H1>Archive Search Results</H1>
<hr>
END

if (!$query->param('query')) {
    print "<h2>You have to search for something!</h2>\n";
    $quiet = 1;
    goto SKIPQUERY;
}

@gargs = ($glimpse, '-U', '-y', '-n');
push(@gargs, "-i") unless $query->param('case') eq 'on';
push(@gargs, "-w") unless $query->param('partial') eq 'on';
push(@gargs, "-W") unless $query->param('lineonly') eq 'on';

$err = $query->param('errors');
if ($err eq 'Best match') { push(@gargs, "-B") }
elsif ($err =~ /^[1-8]$/) { push(@gargs, "-$err") }

$pmf = $query->param('maxfiles');
$pml = $query->param('maxlines');
$mf = $pmf =~ /^\d+$/ && $pmf>=1 && $pmf<=100 ? $pmf : 10;
$ml = $pml =~ /^\d+$/ && $pml>=1 && $pml<=100 ? $pml : 10;
if ($pml eq "0") { push(@gargs, "-l", "-L", "1000:$mf") }
else { push(@gargs, "-L", "1000:$mf:$ml") }

($index = $query->param('lists')) =~ s,/,,g;
$index = "announce" if (! $index);
# $index = "debian-$index" if ($index ne 'deity');
if ($query->param('dates')) {
    ($indexm, $indexy) = ($query->param('dates') =~ /^(...) to ... (\d\d)/);
    $indexm =~ s,/,,g; $indexy =~ s,/,,g;
    $indexm = $months{$indexm};
}
else {
    ($indexm, $indexy) = (gmtime)[4,5];
    $indexy = $indexy%100 < 10 ? "0".$indexy%100 : $indexy%100; #y2k fix
    $indexm = int($indexm / 3)*3 + 1;
    $indexm = "0$indexm" if $indexm < 10;
}

$index = "/var/lib/lists-archives/glimpse/$index-" . $indexy . $indexm;
push(@gargs, "-H", $index, "-e", $query->param('query'));

if (! -d $index) {
    print "<h2> No such search archive $index!</h2>";
    $quiet = 1;
    goto SKIPQUERY;
}

pipe(GR,GW) || die "pipe: $!";
pipe(GER,GEW) || die "pipe: $!";
defined($gpid = fork) || die "fork: $!";
if (!$gpid) {
    open(STDOUT, ">&GW") || die "dup2: $!";
    open(STDERR, ">&GEW") || die "dup2: $!";
    close(GR);
    close(GER);
    $ENV{'PATH'} = "$glimpsedir:$ENV{PATH}";
    exec(@gargs);
    die "exec: $!";
}
close(GW);
close(GEW);

$gout = "<ul>";
while (<GR>) {
    push(@gr, quotehtml($_));
#    next if /^using working\-directory/;
    ((($url, $info) = split(' ', $_, 2))==2) || next;
    $info =~ s/\\:/\0/g;
    ($subject, $linen, $line) = split(/:/, $info, 3);
    $subject = quotehtml($subject,1);
    $line = quotehtml($line,1);
    $url =~ s:.*Lists-Archives/::;
    ($list = $url) =~ s:/msg.*::;
    $list =~ s/$webhome/$web/g;
    $url =~ s/$webhome/$web/g;
    $gout .= "<li><a href=\"$url\">$subject</a> ($list)"
	if ($url ne $lasturl);
    $gout .= "<br>$linen: $line\n" if $linen;
    $lasturl = $url;
}
$gout .= "</ul>";
@ge = <GER>;

waitpid($gpid,0) || die "wait: $!";
$gstat = $?;
$gret = WEXITSTATUS($gstat) if WIFEXITED($gstat);
$gsig = WTERMSIG($gstat) if WIFSIGNALED($gstat);

SKIPQUERY:
if ($gret || $gsig) {
    print "<h2>Error:</h2>\n";
    for (@ge) { last if /This is glimpse version/; print; }
    print "<p>Exit code $gret\n" if $gret;
    print "<p>Killed by signal $gsig\n" if $gsig;
}
elsif (@gr) {
    print $gout;
}
elsif (!$quiet) {
    print "<h2>No matches</h2>";
}

print "<hr><h2>Debugging information:</h2>
<h3>I got passed</h3>\n$query
<h3>I called</h3>
<kbd>", quotehtml(join(' ', @gargs)), "</kbd>
<h3>glimpse returned to stdout</h3><pre>@gr</pre>
<h3>and to stderr</h3><pre>@ge</pre>" if 0;

print $query->end_html;


# quotehtml(string, \0 to colon flag)
sub quotehtml () {
    my $h = shift;
    $h =~ s/\0/:/g if ($_[0]);
#    $h =~ s/\&/&amp;/g;
    $h =~ s/</&lt;/g;
    $h =~ s/>/&gt;/g;
    $h;
}
    
    




