Some change how messages are retrieved after a search is done.
1. Retrievals should be much faster and put much less load on hub, particularly for complex searches. 2. URLs for messages are no longer query dependent, so when a message you have already looked at pops up in a different search, you your browser history mechanism can recognize it and color the link appropriately. 3. Messages are potentially cachable; I may have to tweak the HTTP header to make it really work though.
This commit is contained in:
John Fieber
parent
567b4cdc54
commit
bb0d79615f
Notes:
svn2git
2020-12-08 03:00:23 +00:00
svn path=/www/; revision=2485
6 changed files with 400 additions and 356 deletions
|
|
@ -1,10 +1,10 @@
|
||||||
# $Id: Makefile,v 1.9 1997-10-11 15:58:11 wosch Exp $
|
# $Id: Makefile,v 1.10 1998-02-26 23:49:47 jfieber Exp $
|
||||||
|
|
||||||
DATA= ftp.mirrors
|
DATA= ftp.mirrors
|
||||||
CGI= ftp.cgi gallery.cgi mirror.cgi cgi-lib.pl cgi-style.pl
|
CGI= ftp.cgi gallery.cgi mirror.cgi cgi-lib.pl cgi-style.pl
|
||||||
CGI+= search.cgi cvsweb.cgi query-pr.cgi query-pr-summary.cgi
|
CGI+= search.cgi cvsweb.cgi query-pr.cgi query-pr-summary.cgi
|
||||||
CGI+= dosendpr.cgi freebsd.def html.pl reg.cgi missing_handler.cgi
|
CGI+= dosendpr.cgi freebsd.def html.pl reg.cgi missing_handler.cgi
|
||||||
CGI+= ports.cgi pds.cgi man.cgi url.cgi
|
CGI+= ports.cgi pds.cgi man.cgi url.cgi getmsg.cgi
|
||||||
|
|
||||||
.SUFFIXES: .C .cgi
|
.SUFFIXES: .C .cgi
|
||||||
|
|
||||||
|
|
|
||||||
92
data/cgi/getmsg.cgi
Executable file
92
data/cgi/getmsg.cgi
Executable file
|
|
@ -0,0 +1,92 @@
|
||||||
|
#!/usr/local/bin/perl -T
|
||||||
|
# $Id: getmsg.cgi,v 1.1 1998-02-26 23:49:52 jfieber Exp $
|
||||||
|
|
||||||
|
require "./cgi-lib.pl";
|
||||||
|
require "./cgi-style.pl";
|
||||||
|
|
||||||
|
my $messageroot = "/usr/local/www/db/text/";
|
||||||
|
&ReadParse(*formdata);
|
||||||
|
&Fetch($formdata{'fetch'});
|
||||||
|
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub Fetch
|
||||||
|
{
|
||||||
|
local ($docid) = @_;
|
||||||
|
local ($start, $end, $file) = split(/ /, $docid);
|
||||||
|
print &short_html_header("FreeBSD Mail Archives");
|
||||||
|
|
||||||
|
#
|
||||||
|
# Check to ensure that (a) the specified file starts
|
||||||
|
# with an approved pathname and (b) that it contains no
|
||||||
|
# relative components (eg ..). This is so that arbitrary
|
||||||
|
# files cannot be accessed.
|
||||||
|
#
|
||||||
|
|
||||||
|
$file =~ s/\.\.//g;
|
||||||
|
$file =~ s|/+|/|;
|
||||||
|
|
||||||
|
if ($file =~ /^$messageroot/ && open(DATA, $file)) {
|
||||||
|
seek DATA, $start, 0;
|
||||||
|
read DATA, $message, $end - $start;
|
||||||
|
close(DATA);
|
||||||
|
print &MessageToHTML($message);
|
||||||
|
} else {
|
||||||
|
print "<p>The specified message cannot be accessed.</p>\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
print &html_footer;
|
||||||
|
print "</BODY></HTML>\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub EscapeHTML
|
||||||
|
{
|
||||||
|
local ($_) = @_;
|
||||||
|
s/&/&/g;
|
||||||
|
s/</</g;
|
||||||
|
s/>/>/g;
|
||||||
|
return $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub MessageToHTML
|
||||||
|
{
|
||||||
|
my ($doc) = @_;
|
||||||
|
my ($i, %hdr);
|
||||||
|
my ($header, $body) = split(/\n\n/, $doc, 2);
|
||||||
|
|
||||||
|
$body = &EscapeHTML($body);
|
||||||
|
|
||||||
|
$header = &EscapeHTML($header);
|
||||||
|
$header =~ s/\n */ /g;
|
||||||
|
|
||||||
|
foreach $i (split(/\n/, $header)) {
|
||||||
|
($field, $data) = split(/ /, $i, 2);
|
||||||
|
$hdr{$field} = $data;
|
||||||
|
}
|
||||||
|
|
||||||
|
$message = "<pre>\n";
|
||||||
|
if (length($hdr{'Date:'}) > 0) {
|
||||||
|
$message .= "<strong>Date: </strong> $hdr{'Date:'}\n";
|
||||||
|
}
|
||||||
|
if (length($hdr{'From:'}) > 0) {
|
||||||
|
$message .= "<strong>From: </strong> $hdr{'From:'}\n";
|
||||||
|
}
|
||||||
|
if (length($hdr{'To:'}) > 0) {
|
||||||
|
$message .= "<strong>To: </strong> $hdr{'To:'}\n";
|
||||||
|
}
|
||||||
|
if (length($hdr{'Cc:'}) > 0) {
|
||||||
|
$message .= "<strong>Cc: </strong> $hdr{'Cc:'}\n";
|
||||||
|
}
|
||||||
|
# if (length($hdr{'Sender:'}) > 0) {
|
||||||
|
# $message .= "<strong>Sender: </strong> $hdr{'Sender:'}\n";
|
||||||
|
# }
|
||||||
|
if (length($hdr{'Subject:'}) > 0) {
|
||||||
|
$message .= "<strong>Subject: </strong> $hdr{'Subject:'}\n";
|
||||||
|
}
|
||||||
|
$message .= "</pre>\n";
|
||||||
|
|
||||||
|
$message .= "<pre>\n$body\n</pre>\n";
|
||||||
|
|
||||||
|
return $message;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
#!/usr/bin/perl
|
#!/usr/local/bin/perl
|
||||||
#
|
#
|
||||||
# mail-archive.pl -- a CGI interface to a wais indexed maling list archive.
|
# mail-archive.pl -- a CGI interface to a wais indexed maling list archive.
|
||||||
#
|
#
|
||||||
|
|
@ -60,8 +60,8 @@ sub do_wais {
|
||||||
$i = join("</em>, <em>", @FORM_source);
|
$i = join("</em>, <em>", @FORM_source);
|
||||||
$i =~ s/,([^,]*)$/ and $1/;
|
$i =~ s/,([^,]*)$/ and $1/;
|
||||||
print &html_header("Mail Archive Search") .
|
print &html_header("Mail Archive Search") .
|
||||||
"<p>None of the archives you requested (<em>$i</em>) are available at " .
|
"<p>None of the archives you requested (<em>$i</em>) are " .
|
||||||
"this time.</p>\n";
|
" available at this time.</p>\n";
|
||||||
print "<p>Please try again later, or return to the " .
|
print "<p>Please try again later, or return to the " .
|
||||||
"search page and select a different archive.</p>\n";
|
"search page and select a different archive.</p>\n";
|
||||||
print &html_footer;
|
print &html_footer;
|
||||||
|
|
@ -89,132 +89,105 @@ sub do_wais {
|
||||||
#
|
#
|
||||||
# First case, no document number so this is a regular search
|
# First case, no document number so this is a regular search
|
||||||
#
|
#
|
||||||
if (length($FORM_docnum) == 0) {
|
print &html_header("Search Results");
|
||||||
print &html_header("Search Results");
|
print $availmsg;
|
||||||
print $availmsg;
|
if ($#AVAIL_source > 0) {
|
||||||
if ($#AVAIL_source > 0) {
|
$src = join("</em>, <em>", @AVAIL_source);
|
||||||
$src = join("</em>, <em>", @AVAIL_source);
|
$src =~ s/,([^,]*)$/ and $1/;
|
||||||
$src =~ s/,([^,]*)$/ and $1/;
|
print "<p>The archives <em>$src</em> contain ";
|
||||||
print "<p>The archives <em>$src</em> contain ";
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
print "The archive <em>@AVAIL_source</em> contains ";
|
|
||||||
}
|
|
||||||
print " the following items relevant to \`@FORM_words\':\n";
|
|
||||||
print "<OL>\n";
|
|
||||||
|
|
||||||
&open2(WAISOUT, WAISIN, $waisq, "-g");
|
|
||||||
print WAISIN $w_question;
|
|
||||||
|
|
||||||
local(@mylist) = ();
|
|
||||||
local($hits, $score, $headline, $lines, $bytes, $type, $date, $file);
|
|
||||||
while (<WAISOUT>) {
|
|
||||||
/:score\s+(\d+)/ && ($score = $1);
|
|
||||||
/:filename "(.*)"/ && ($file = $1);
|
|
||||||
/:number-of-lines\s+(\d+)/ && ($lines = $1);
|
|
||||||
/:number-of-bytes\s+(\d+)/ && ($bytes = $1);
|
|
||||||
/:type "(.*)"/ && ($type = $1);
|
|
||||||
/:headline "(.*)"/ && ($headline = $1,
|
|
||||||
$headline =~ s/Re:\sRe:\s/Re: /); # XXX
|
|
||||||
/:date "(\d+)"/ && ($date = $1, $hits++,
|
|
||||||
push(@mylist, join("\t", $date, $headline, $type,
|
|
||||||
$bytes, $lines, $file, $score, $hits)));
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($in{'sort'} eq "date") {
|
|
||||||
foreach (reverse sort {$a <=> $b} @mylist) {
|
|
||||||
($date, $headline, $type, $bytes, $lines,
|
|
||||||
$file, $score, $hits) = split("\t");
|
|
||||||
&docdone;
|
|
||||||
}
|
|
||||||
} elsif ($in{'sort'} eq "subject") {
|
|
||||||
local(@a, @c, $b, $d);
|
|
||||||
foreach (@mylist) {
|
|
||||||
@a = split("\t");
|
|
||||||
$b = $a[0];
|
|
||||||
# swap date and subject
|
|
||||||
if ($a[1] =~ /(^[^:]+)(Re:.*)/) {
|
|
||||||
$a[0] = "$2\t$1";
|
|
||||||
} else {
|
|
||||||
$a[0] = "$a[1]\t.";
|
|
||||||
}
|
|
||||||
$a[1] = $b;
|
|
||||||
push(@c, join("\t", @a));
|
|
||||||
}
|
|
||||||
local($subject, $author);
|
|
||||||
foreach (sort {$a cmp $b} @c) {
|
|
||||||
($subject, $author, $date, $type, $bytes,
|
|
||||||
$lines, $file, $score, $hits) = split("\t");
|
|
||||||
$headline = $author . $subject;
|
|
||||||
&docdone;
|
|
||||||
}
|
|
||||||
|
|
||||||
} elsif ($in{'sort'} eq "author") {
|
|
||||||
local(@a, @c, $b);
|
|
||||||
foreach (@mylist) {
|
|
||||||
@a = split("\t");
|
|
||||||
# swap date and subject
|
|
||||||
$b = $a[0]; $a[0] = $a[1]; $a[1] = $b;
|
|
||||||
push(@c, join("\t", @a));
|
|
||||||
}
|
|
||||||
foreach (sort {$a cmp $b} @c) {
|
|
||||||
($headline, $date, $type, $bytes,
|
|
||||||
$lines, $file, $score, $hits) = split("\t");
|
|
||||||
&docdone;
|
|
||||||
}
|
|
||||||
|
|
||||||
} else {
|
|
||||||
foreach (@mylist) {
|
|
||||||
($date, $headline, $type, $bytes,
|
|
||||||
$lines, $file, $score, $hits) = split("\t");
|
|
||||||
&docdone;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#print qq[in: $in{'sort'}\n];
|
|
||||||
|
|
||||||
print "</OL>\n";
|
|
||||||
|
|
||||||
print "<p>Didn't get what you expected? ";
|
|
||||||
print "<a href=\"$hints\">Look here for searching hints</a>.</p>";
|
|
||||||
|
|
||||||
if ($hits == 0) {
|
|
||||||
print "Nothing found.\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
print &html_footer;
|
|
||||||
close(WAISOUT);
|
|
||||||
close(WAISIN);
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#
|
|
||||||
# Second Case, a document number was supplied
|
|
||||||
#
|
|
||||||
|
|
||||||
else {
|
else {
|
||||||
print &short_html_header("Search Results");
|
print "The archive <em>@AVAIL_source</em> contains ";
|
||||||
&open2(WAISOUT, WAISIN, $waisq, "-g");
|
|
||||||
print WAISIN $w_question;
|
|
||||||
|
|
||||||
while (<WAISOUT>) {
|
|
||||||
s/search_word: boolean \`and\' scored//g;
|
|
||||||
$w_result .= $_;
|
|
||||||
}
|
|
||||||
close(WAISOUT);
|
|
||||||
close(WAISIN);
|
|
||||||
|
|
||||||
&open2(WAISOUT, WAISIN, $waisq, "-m", $FORM_max, "-v", $FORM_docnum);
|
|
||||||
print WAISIN $w_result;
|
|
||||||
|
|
||||||
while (<WAISOUT>) {
|
|
||||||
$foo .= $_;
|
|
||||||
}
|
|
||||||
&printdoc($foo);
|
|
||||||
|
|
||||||
print &html_footer;
|
|
||||||
close(WAISOUT);
|
|
||||||
close(WAISIN);
|
|
||||||
}
|
}
|
||||||
|
print " the following items relevant to \`@FORM_words\':\n";
|
||||||
|
print "<OL>\n";
|
||||||
|
|
||||||
|
&open2(WAISOUT, WAISIN, $waisq, "-g");
|
||||||
|
print WAISIN $w_question;
|
||||||
|
|
||||||
|
local(@mylist) = ();
|
||||||
|
local($hits, $score, $headline, $lines, $bytes, $docid, $date, $file);
|
||||||
|
print "<pre>";
|
||||||
|
while (<WAISOUT>) {
|
||||||
|
/:original-local-id.*#\(\s+([^\)]*)/ &&
|
||||||
|
($docid = pack("C*", split(/\s+/, $1)),
|
||||||
|
$docid =~ s/\s+/+/g);
|
||||||
|
/:score\s+(\d+)/ && ($score = $1);
|
||||||
|
/:filename "(.*)"/ && ($file = $1);
|
||||||
|
/:number-of-lines\s+(\d+)/ && ($lines = $1);
|
||||||
|
/:number-of-bytes\s+(\d+)/ && ($bytes = $1);
|
||||||
|
/:headline "(.*)"/ && ($headline = $1,
|
||||||
|
$headline =~ s/[Rr]e://); # XXX
|
||||||
|
/:date "(\d+)"/ && ($date = $1, $hits++,
|
||||||
|
push(@mylist, join("\t", $date, $headline, $docid,
|
||||||
|
$bytes, $lines, $file, $score, $hits)));
|
||||||
|
}
|
||||||
|
print "</pre>";
|
||||||
|
|
||||||
|
if ($in{'sort'} eq "date") {
|
||||||
|
foreach (reverse sort {$a <=> $b} @mylist) {
|
||||||
|
($date, $headline, $docid, $bytes, $lines,
|
||||||
|
$file, $score, $hits) = split("\t");
|
||||||
|
&docdone;
|
||||||
|
}
|
||||||
|
} elsif ($in{'sort'} eq "subject") {
|
||||||
|
local(@a, @c, $b, $d);
|
||||||
|
foreach (@mylist) {
|
||||||
|
@a = split("\t");
|
||||||
|
$b = $a[0];
|
||||||
|
# swap date and subject
|
||||||
|
if ($a[1] =~ /(^[^:]+)(Re:.*)/) {
|
||||||
|
$a[0] = "$2\t$1";
|
||||||
|
} else {
|
||||||
|
$a[0] = "$a[1]\t.";
|
||||||
|
}
|
||||||
|
$a[1] = $b;
|
||||||
|
push(@c, join("\t", @a));
|
||||||
|
}
|
||||||
|
local($subject, $author);
|
||||||
|
foreach (sort {$a cmp $b} @c) {
|
||||||
|
($subject, $author, $date, $docid, $bytes,
|
||||||
|
$lines, $file, $score, $hits) = split("\t");
|
||||||
|
$headline = $author . $subject;
|
||||||
|
&docdone;
|
||||||
|
}
|
||||||
|
|
||||||
|
} elsif ($in{'sort'} eq "author") {
|
||||||
|
local(@a, @c, $b);
|
||||||
|
foreach (@mylist) {
|
||||||
|
@a = split("\t");
|
||||||
|
# swap date and subject
|
||||||
|
$b = $a[0]; $a[0] = $a[1]; $a[1] = $b;
|
||||||
|
push(@c, join("\t", @a));
|
||||||
|
}
|
||||||
|
foreach (sort {$a cmp $b} @c) {
|
||||||
|
($headline, $date, $docid, $bytes,
|
||||||
|
$lines, $file, $score, $hits) = split("\t");
|
||||||
|
&docdone;
|
||||||
|
}
|
||||||
|
|
||||||
|
} else {
|
||||||
|
foreach (@mylist) {
|
||||||
|
($date, $headline, $docid, $bytes,
|
||||||
|
$lines, $file, $score, $hits) = split("\t");
|
||||||
|
&docdone;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#print qq[in: $in{'sort'}\n];
|
||||||
|
|
||||||
|
print "</OL>\n";
|
||||||
|
|
||||||
|
print "<p>Didn't get what you expected? ";
|
||||||
|
print "<a href=\"$hints\">Look here for searching hints</a>.</p>";
|
||||||
|
|
||||||
|
if ($hits == 0) {
|
||||||
|
print "Nothing found.\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
print &html_footer;
|
||||||
|
close(WAISOUT);
|
||||||
|
close(WAISIN);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# Given an array of sources (sans .src extension), this routine
|
# Given an array of sources (sans .src extension), this routine
|
||||||
|
|
@ -237,49 +210,6 @@ sub checksource {
|
||||||
return(@goodsources);
|
return(@goodsources);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
# Print a mail message in HTML form
|
|
||||||
|
|
||||||
sub printdoc {
|
|
||||||
local ($doc) = @_;
|
|
||||||
|
|
||||||
($header, $body) = split(/\n\n/, $doc, 2);
|
|
||||||
|
|
||||||
$body = &htmlescape($body);
|
|
||||||
|
|
||||||
$header = &htmlescape($header);
|
|
||||||
$header =~ s/\n */ /g;
|
|
||||||
|
|
||||||
foreach $i (split(/\n/, $header)) {
|
|
||||||
($field, $data) = split(/ /, $i, 2);
|
|
||||||
$field =~ y/A-Z/a-z/;
|
|
||||||
$hdr{$field} = $data;
|
|
||||||
}
|
|
||||||
|
|
||||||
print "<BODY>\n<pre>\n";
|
|
||||||
if (length($hdr{'date:'}) > 0) {
|
|
||||||
print "<strong>Date: </strong> $hdr{'date:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'from:'}) > 0) {
|
|
||||||
print "<strong>From: </strong> $hdr{'from:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'to:'}) > 0) {
|
|
||||||
print "<strong>To: </strong> $hdr{'to:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'cc:'}) > 0) {
|
|
||||||
print "<strong>Cc: </strong> $hdr{'cc:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'sender:'}) > 0) {
|
|
||||||
print "<strong>Sender: </strong> $hdr{'sender:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'subject:'}) > 0) {
|
|
||||||
print "<strong>Subject: </strong> $hdr{'subject:'}\n";
|
|
||||||
}
|
|
||||||
print "</pre>\n";
|
|
||||||
|
|
||||||
print "<pre>\n$body\n</pre>\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
sub htmlescape {
|
sub htmlescape {
|
||||||
local ($data) = @_;
|
local ($data) = @_;
|
||||||
$data =~ s/&/&/g;
|
$data =~ s/&/&/g;
|
||||||
|
|
@ -297,7 +227,7 @@ sub docdone {
|
||||||
if ($file eq "www") {
|
if ($file eq "www") {
|
||||||
print "<li><a href=\"$headline\">$headline</a>\n";
|
print "<li><a href=\"$headline\">$headline</a>\n";
|
||||||
} else {
|
} else {
|
||||||
print "<li><A HREF=\"${myurl}?$ENV{'QUERY_STRING'}&docnum=$hits\">$headline</A>\n";
|
print "<li><A HREF=\"getmsg.cgi?fetch=${docid}\">$headline</A>\n";
|
||||||
}
|
}
|
||||||
print "<br>";
|
print "<br>";
|
||||||
# print "<input type=\"checkbox\" name=\"rf\" value=\"$docnum\">";
|
# print "<input type=\"checkbox\" name=\"rf\" value=\"$docnum\">";
|
||||||
|
|
@ -309,7 +239,7 @@ sub docdone {
|
||||||
print "Archive: <em>$file</em>";
|
print "Archive: <em>$file</em>";
|
||||||
print "<p></p></li>\n";
|
print "<p></p></li>\n";
|
||||||
}
|
}
|
||||||
$score = $headline = $lines = $bytes = $type = $date = $file = '';
|
# $score = $headline = $lines = $bytes = $docid = $date = $file = '';
|
||||||
}
|
}
|
||||||
|
|
||||||
$| = 1;
|
$| = 1;
|
||||||
|
|
|
||||||
|
|
@ -1,10 +1,10 @@
|
||||||
# $Id: Makefile,v 1.9 1997-10-11 15:58:11 wosch Exp $
|
# $Id: Makefile,v 1.10 1998-02-26 23:49:47 jfieber Exp $
|
||||||
|
|
||||||
DATA= ftp.mirrors
|
DATA= ftp.mirrors
|
||||||
CGI= ftp.cgi gallery.cgi mirror.cgi cgi-lib.pl cgi-style.pl
|
CGI= ftp.cgi gallery.cgi mirror.cgi cgi-lib.pl cgi-style.pl
|
||||||
CGI+= search.cgi cvsweb.cgi query-pr.cgi query-pr-summary.cgi
|
CGI+= search.cgi cvsweb.cgi query-pr.cgi query-pr-summary.cgi
|
||||||
CGI+= dosendpr.cgi freebsd.def html.pl reg.cgi missing_handler.cgi
|
CGI+= dosendpr.cgi freebsd.def html.pl reg.cgi missing_handler.cgi
|
||||||
CGI+= ports.cgi pds.cgi man.cgi url.cgi
|
CGI+= ports.cgi pds.cgi man.cgi url.cgi getmsg.cgi
|
||||||
|
|
||||||
.SUFFIXES: .C .cgi
|
.SUFFIXES: .C .cgi
|
||||||
|
|
||||||
|
|
|
||||||
92
en/cgi/getmsg.cgi
Executable file
92
en/cgi/getmsg.cgi
Executable file
|
|
@ -0,0 +1,92 @@
|
||||||
|
#!/usr/local/bin/perl -T
|
||||||
|
# $Id: getmsg.cgi,v 1.1 1998-02-26 23:49:52 jfieber Exp $
|
||||||
|
|
||||||
|
require "./cgi-lib.pl";
|
||||||
|
require "./cgi-style.pl";
|
||||||
|
|
||||||
|
my $messageroot = "/usr/local/www/db/text/";
|
||||||
|
&ReadParse(*formdata);
|
||||||
|
&Fetch($formdata{'fetch'});
|
||||||
|
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub Fetch
|
||||||
|
{
|
||||||
|
local ($docid) = @_;
|
||||||
|
local ($start, $end, $file) = split(/ /, $docid);
|
||||||
|
print &short_html_header("FreeBSD Mail Archives");
|
||||||
|
|
||||||
|
#
|
||||||
|
# Check to ensure that (a) the specified file starts
|
||||||
|
# with an approved pathname and (b) that it contains no
|
||||||
|
# relative components (eg ..). This is so that arbitrary
|
||||||
|
# files cannot be accessed.
|
||||||
|
#
|
||||||
|
|
||||||
|
$file =~ s/\.\.//g;
|
||||||
|
$file =~ s|/+|/|;
|
||||||
|
|
||||||
|
if ($file =~ /^$messageroot/ && open(DATA, $file)) {
|
||||||
|
seek DATA, $start, 0;
|
||||||
|
read DATA, $message, $end - $start;
|
||||||
|
close(DATA);
|
||||||
|
print &MessageToHTML($message);
|
||||||
|
} else {
|
||||||
|
print "<p>The specified message cannot be accessed.</p>\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
print &html_footer;
|
||||||
|
print "</BODY></HTML>\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub EscapeHTML
|
||||||
|
{
|
||||||
|
local ($_) = @_;
|
||||||
|
s/&/&/g;
|
||||||
|
s/</</g;
|
||||||
|
s/>/>/g;
|
||||||
|
return $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub MessageToHTML
|
||||||
|
{
|
||||||
|
my ($doc) = @_;
|
||||||
|
my ($i, %hdr);
|
||||||
|
my ($header, $body) = split(/\n\n/, $doc, 2);
|
||||||
|
|
||||||
|
$body = &EscapeHTML($body);
|
||||||
|
|
||||||
|
$header = &EscapeHTML($header);
|
||||||
|
$header =~ s/\n */ /g;
|
||||||
|
|
||||||
|
foreach $i (split(/\n/, $header)) {
|
||||||
|
($field, $data) = split(/ /, $i, 2);
|
||||||
|
$hdr{$field} = $data;
|
||||||
|
}
|
||||||
|
|
||||||
|
$message = "<pre>\n";
|
||||||
|
if (length($hdr{'Date:'}) > 0) {
|
||||||
|
$message .= "<strong>Date: </strong> $hdr{'Date:'}\n";
|
||||||
|
}
|
||||||
|
if (length($hdr{'From:'}) > 0) {
|
||||||
|
$message .= "<strong>From: </strong> $hdr{'From:'}\n";
|
||||||
|
}
|
||||||
|
if (length($hdr{'To:'}) > 0) {
|
||||||
|
$message .= "<strong>To: </strong> $hdr{'To:'}\n";
|
||||||
|
}
|
||||||
|
if (length($hdr{'Cc:'}) > 0) {
|
||||||
|
$message .= "<strong>Cc: </strong> $hdr{'Cc:'}\n";
|
||||||
|
}
|
||||||
|
# if (length($hdr{'Sender:'}) > 0) {
|
||||||
|
# $message .= "<strong>Sender: </strong> $hdr{'Sender:'}\n";
|
||||||
|
# }
|
||||||
|
if (length($hdr{'Subject:'}) > 0) {
|
||||||
|
$message .= "<strong>Subject: </strong> $hdr{'Subject:'}\n";
|
||||||
|
}
|
||||||
|
$message .= "</pre>\n";
|
||||||
|
|
||||||
|
$message .= "<pre>\n$body\n</pre>\n";
|
||||||
|
|
||||||
|
return $message;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
#!/usr/bin/perl
|
#!/usr/local/bin/perl
|
||||||
#
|
#
|
||||||
# mail-archive.pl -- a CGI interface to a wais indexed maling list archive.
|
# mail-archive.pl -- a CGI interface to a wais indexed maling list archive.
|
||||||
#
|
#
|
||||||
|
|
@ -60,8 +60,8 @@ sub do_wais {
|
||||||
$i = join("</em>, <em>", @FORM_source);
|
$i = join("</em>, <em>", @FORM_source);
|
||||||
$i =~ s/,([^,]*)$/ and $1/;
|
$i =~ s/,([^,]*)$/ and $1/;
|
||||||
print &html_header("Mail Archive Search") .
|
print &html_header("Mail Archive Search") .
|
||||||
"<p>None of the archives you requested (<em>$i</em>) are available at " .
|
"<p>None of the archives you requested (<em>$i</em>) are " .
|
||||||
"this time.</p>\n";
|
" available at this time.</p>\n";
|
||||||
print "<p>Please try again later, or return to the " .
|
print "<p>Please try again later, or return to the " .
|
||||||
"search page and select a different archive.</p>\n";
|
"search page and select a different archive.</p>\n";
|
||||||
print &html_footer;
|
print &html_footer;
|
||||||
|
|
@ -89,132 +89,105 @@ sub do_wais {
|
||||||
#
|
#
|
||||||
# First case, no document number so this is a regular search
|
# First case, no document number so this is a regular search
|
||||||
#
|
#
|
||||||
if (length($FORM_docnum) == 0) {
|
print &html_header("Search Results");
|
||||||
print &html_header("Search Results");
|
print $availmsg;
|
||||||
print $availmsg;
|
if ($#AVAIL_source > 0) {
|
||||||
if ($#AVAIL_source > 0) {
|
$src = join("</em>, <em>", @AVAIL_source);
|
||||||
$src = join("</em>, <em>", @AVAIL_source);
|
$src =~ s/,([^,]*)$/ and $1/;
|
||||||
$src =~ s/,([^,]*)$/ and $1/;
|
print "<p>The archives <em>$src</em> contain ";
|
||||||
print "<p>The archives <em>$src</em> contain ";
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
print "The archive <em>@AVAIL_source</em> contains ";
|
|
||||||
}
|
|
||||||
print " the following items relevant to \`@FORM_words\':\n";
|
|
||||||
print "<OL>\n";
|
|
||||||
|
|
||||||
&open2(WAISOUT, WAISIN, $waisq, "-g");
|
|
||||||
print WAISIN $w_question;
|
|
||||||
|
|
||||||
local(@mylist) = ();
|
|
||||||
local($hits, $score, $headline, $lines, $bytes, $type, $date, $file);
|
|
||||||
while (<WAISOUT>) {
|
|
||||||
/:score\s+(\d+)/ && ($score = $1);
|
|
||||||
/:filename "(.*)"/ && ($file = $1);
|
|
||||||
/:number-of-lines\s+(\d+)/ && ($lines = $1);
|
|
||||||
/:number-of-bytes\s+(\d+)/ && ($bytes = $1);
|
|
||||||
/:type "(.*)"/ && ($type = $1);
|
|
||||||
/:headline "(.*)"/ && ($headline = $1,
|
|
||||||
$headline =~ s/Re:\sRe:\s/Re: /); # XXX
|
|
||||||
/:date "(\d+)"/ && ($date = $1, $hits++,
|
|
||||||
push(@mylist, join("\t", $date, $headline, $type,
|
|
||||||
$bytes, $lines, $file, $score, $hits)));
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($in{'sort'} eq "date") {
|
|
||||||
foreach (reverse sort {$a <=> $b} @mylist) {
|
|
||||||
($date, $headline, $type, $bytes, $lines,
|
|
||||||
$file, $score, $hits) = split("\t");
|
|
||||||
&docdone;
|
|
||||||
}
|
|
||||||
} elsif ($in{'sort'} eq "subject") {
|
|
||||||
local(@a, @c, $b, $d);
|
|
||||||
foreach (@mylist) {
|
|
||||||
@a = split("\t");
|
|
||||||
$b = $a[0];
|
|
||||||
# swap date and subject
|
|
||||||
if ($a[1] =~ /(^[^:]+)(Re:.*)/) {
|
|
||||||
$a[0] = "$2\t$1";
|
|
||||||
} else {
|
|
||||||
$a[0] = "$a[1]\t.";
|
|
||||||
}
|
|
||||||
$a[1] = $b;
|
|
||||||
push(@c, join("\t", @a));
|
|
||||||
}
|
|
||||||
local($subject, $author);
|
|
||||||
foreach (sort {$a cmp $b} @c) {
|
|
||||||
($subject, $author, $date, $type, $bytes,
|
|
||||||
$lines, $file, $score, $hits) = split("\t");
|
|
||||||
$headline = $author . $subject;
|
|
||||||
&docdone;
|
|
||||||
}
|
|
||||||
|
|
||||||
} elsif ($in{'sort'} eq "author") {
|
|
||||||
local(@a, @c, $b);
|
|
||||||
foreach (@mylist) {
|
|
||||||
@a = split("\t");
|
|
||||||
# swap date and subject
|
|
||||||
$b = $a[0]; $a[0] = $a[1]; $a[1] = $b;
|
|
||||||
push(@c, join("\t", @a));
|
|
||||||
}
|
|
||||||
foreach (sort {$a cmp $b} @c) {
|
|
||||||
($headline, $date, $type, $bytes,
|
|
||||||
$lines, $file, $score, $hits) = split("\t");
|
|
||||||
&docdone;
|
|
||||||
}
|
|
||||||
|
|
||||||
} else {
|
|
||||||
foreach (@mylist) {
|
|
||||||
($date, $headline, $type, $bytes,
|
|
||||||
$lines, $file, $score, $hits) = split("\t");
|
|
||||||
&docdone;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#print qq[in: $in{'sort'}\n];
|
|
||||||
|
|
||||||
print "</OL>\n";
|
|
||||||
|
|
||||||
print "<p>Didn't get what you expected? ";
|
|
||||||
print "<a href=\"$hints\">Look here for searching hints</a>.</p>";
|
|
||||||
|
|
||||||
if ($hits == 0) {
|
|
||||||
print "Nothing found.\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
print &html_footer;
|
|
||||||
close(WAISOUT);
|
|
||||||
close(WAISIN);
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#
|
|
||||||
# Second Case, a document number was supplied
|
|
||||||
#
|
|
||||||
|
|
||||||
else {
|
else {
|
||||||
print &short_html_header("Search Results");
|
print "The archive <em>@AVAIL_source</em> contains ";
|
||||||
&open2(WAISOUT, WAISIN, $waisq, "-g");
|
|
||||||
print WAISIN $w_question;
|
|
||||||
|
|
||||||
while (<WAISOUT>) {
|
|
||||||
s/search_word: boolean \`and\' scored//g;
|
|
||||||
$w_result .= $_;
|
|
||||||
}
|
|
||||||
close(WAISOUT);
|
|
||||||
close(WAISIN);
|
|
||||||
|
|
||||||
&open2(WAISOUT, WAISIN, $waisq, "-m", $FORM_max, "-v", $FORM_docnum);
|
|
||||||
print WAISIN $w_result;
|
|
||||||
|
|
||||||
while (<WAISOUT>) {
|
|
||||||
$foo .= $_;
|
|
||||||
}
|
|
||||||
&printdoc($foo);
|
|
||||||
|
|
||||||
print &html_footer;
|
|
||||||
close(WAISOUT);
|
|
||||||
close(WAISIN);
|
|
||||||
}
|
}
|
||||||
|
print " the following items relevant to \`@FORM_words\':\n";
|
||||||
|
print "<OL>\n";
|
||||||
|
|
||||||
|
&open2(WAISOUT, WAISIN, $waisq, "-g");
|
||||||
|
print WAISIN $w_question;
|
||||||
|
|
||||||
|
local(@mylist) = ();
|
||||||
|
local($hits, $score, $headline, $lines, $bytes, $docid, $date, $file);
|
||||||
|
print "<pre>";
|
||||||
|
while (<WAISOUT>) {
|
||||||
|
/:original-local-id.*#\(\s+([^\)]*)/ &&
|
||||||
|
($docid = pack("C*", split(/\s+/, $1)),
|
||||||
|
$docid =~ s/\s+/+/g);
|
||||||
|
/:score\s+(\d+)/ && ($score = $1);
|
||||||
|
/:filename "(.*)"/ && ($file = $1);
|
||||||
|
/:number-of-lines\s+(\d+)/ && ($lines = $1);
|
||||||
|
/:number-of-bytes\s+(\d+)/ && ($bytes = $1);
|
||||||
|
/:headline "(.*)"/ && ($headline = $1,
|
||||||
|
$headline =~ s/[Rr]e://); # XXX
|
||||||
|
/:date "(\d+)"/ && ($date = $1, $hits++,
|
||||||
|
push(@mylist, join("\t", $date, $headline, $docid,
|
||||||
|
$bytes, $lines, $file, $score, $hits)));
|
||||||
|
}
|
||||||
|
print "</pre>";
|
||||||
|
|
||||||
|
if ($in{'sort'} eq "date") {
|
||||||
|
foreach (reverse sort {$a <=> $b} @mylist) {
|
||||||
|
($date, $headline, $docid, $bytes, $lines,
|
||||||
|
$file, $score, $hits) = split("\t");
|
||||||
|
&docdone;
|
||||||
|
}
|
||||||
|
} elsif ($in{'sort'} eq "subject") {
|
||||||
|
local(@a, @c, $b, $d);
|
||||||
|
foreach (@mylist) {
|
||||||
|
@a = split("\t");
|
||||||
|
$b = $a[0];
|
||||||
|
# swap date and subject
|
||||||
|
if ($a[1] =~ /(^[^:]+)(Re:.*)/) {
|
||||||
|
$a[0] = "$2\t$1";
|
||||||
|
} else {
|
||||||
|
$a[0] = "$a[1]\t.";
|
||||||
|
}
|
||||||
|
$a[1] = $b;
|
||||||
|
push(@c, join("\t", @a));
|
||||||
|
}
|
||||||
|
local($subject, $author);
|
||||||
|
foreach (sort {$a cmp $b} @c) {
|
||||||
|
($subject, $author, $date, $docid, $bytes,
|
||||||
|
$lines, $file, $score, $hits) = split("\t");
|
||||||
|
$headline = $author . $subject;
|
||||||
|
&docdone;
|
||||||
|
}
|
||||||
|
|
||||||
|
} elsif ($in{'sort'} eq "author") {
|
||||||
|
local(@a, @c, $b);
|
||||||
|
foreach (@mylist) {
|
||||||
|
@a = split("\t");
|
||||||
|
# swap date and subject
|
||||||
|
$b = $a[0]; $a[0] = $a[1]; $a[1] = $b;
|
||||||
|
push(@c, join("\t", @a));
|
||||||
|
}
|
||||||
|
foreach (sort {$a cmp $b} @c) {
|
||||||
|
($headline, $date, $docid, $bytes,
|
||||||
|
$lines, $file, $score, $hits) = split("\t");
|
||||||
|
&docdone;
|
||||||
|
}
|
||||||
|
|
||||||
|
} else {
|
||||||
|
foreach (@mylist) {
|
||||||
|
($date, $headline, $docid, $bytes,
|
||||||
|
$lines, $file, $score, $hits) = split("\t");
|
||||||
|
&docdone;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#print qq[in: $in{'sort'}\n];
|
||||||
|
|
||||||
|
print "</OL>\n";
|
||||||
|
|
||||||
|
print "<p>Didn't get what you expected? ";
|
||||||
|
print "<a href=\"$hints\">Look here for searching hints</a>.</p>";
|
||||||
|
|
||||||
|
if ($hits == 0) {
|
||||||
|
print "Nothing found.\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
print &html_footer;
|
||||||
|
close(WAISOUT);
|
||||||
|
close(WAISIN);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# Given an array of sources (sans .src extension), this routine
|
# Given an array of sources (sans .src extension), this routine
|
||||||
|
|
@ -237,49 +210,6 @@ sub checksource {
|
||||||
return(@goodsources);
|
return(@goodsources);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
# Print a mail message in HTML form
|
|
||||||
|
|
||||||
sub printdoc {
|
|
||||||
local ($doc) = @_;
|
|
||||||
|
|
||||||
($header, $body) = split(/\n\n/, $doc, 2);
|
|
||||||
|
|
||||||
$body = &htmlescape($body);
|
|
||||||
|
|
||||||
$header = &htmlescape($header);
|
|
||||||
$header =~ s/\n */ /g;
|
|
||||||
|
|
||||||
foreach $i (split(/\n/, $header)) {
|
|
||||||
($field, $data) = split(/ /, $i, 2);
|
|
||||||
$field =~ y/A-Z/a-z/;
|
|
||||||
$hdr{$field} = $data;
|
|
||||||
}
|
|
||||||
|
|
||||||
print "<BODY>\n<pre>\n";
|
|
||||||
if (length($hdr{'date:'}) > 0) {
|
|
||||||
print "<strong>Date: </strong> $hdr{'date:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'from:'}) > 0) {
|
|
||||||
print "<strong>From: </strong> $hdr{'from:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'to:'}) > 0) {
|
|
||||||
print "<strong>To: </strong> $hdr{'to:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'cc:'}) > 0) {
|
|
||||||
print "<strong>Cc: </strong> $hdr{'cc:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'sender:'}) > 0) {
|
|
||||||
print "<strong>Sender: </strong> $hdr{'sender:'}\n";
|
|
||||||
}
|
|
||||||
if (length($hdr{'subject:'}) > 0) {
|
|
||||||
print "<strong>Subject: </strong> $hdr{'subject:'}\n";
|
|
||||||
}
|
|
||||||
print "</pre>\n";
|
|
||||||
|
|
||||||
print "<pre>\n$body\n</pre>\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
sub htmlescape {
|
sub htmlescape {
|
||||||
local ($data) = @_;
|
local ($data) = @_;
|
||||||
$data =~ s/&/&/g;
|
$data =~ s/&/&/g;
|
||||||
|
|
@ -297,7 +227,7 @@ sub docdone {
|
||||||
if ($file eq "www") {
|
if ($file eq "www") {
|
||||||
print "<li><a href=\"$headline\">$headline</a>\n";
|
print "<li><a href=\"$headline\">$headline</a>\n";
|
||||||
} else {
|
} else {
|
||||||
print "<li><A HREF=\"${myurl}?$ENV{'QUERY_STRING'}&docnum=$hits\">$headline</A>\n";
|
print "<li><A HREF=\"getmsg.cgi?fetch=${docid}\">$headline</A>\n";
|
||||||
}
|
}
|
||||||
print "<br>";
|
print "<br>";
|
||||||
# print "<input type=\"checkbox\" name=\"rf\" value=\"$docnum\">";
|
# print "<input type=\"checkbox\" name=\"rf\" value=\"$docnum\">";
|
||||||
|
|
@ -309,7 +239,7 @@ sub docdone {
|
||||||
print "Archive: <em>$file</em>";
|
print "Archive: <em>$file</em>";
|
||||||
print "<p></p></li>\n";
|
print "<p></p></li>\n";
|
||||||
}
|
}
|
||||||
$score = $headline = $lines = $bytes = $type = $date = $file = '';
|
# $score = $headline = $lines = $bytes = $docid = $date = $file = '';
|
||||||
}
|
}
|
||||||
|
|
||||||
$| = 1;
|
$| = 1;
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue