diff --git a/en/cgi/getmsg.cgi b/en/cgi/getmsg.cgi index 926d216371..403e6458f5 100755 --- a/en/cgi/getmsg.cgi +++ b/en/cgi/getmsg.cgi @@ -1,255 +1,254 @@ #!/usr/bin/perl -T # # Given a filename, start offset and end offset of a mail message, # read the message and format it nicely using HTML. # # by John Fieber # February 26, 1998 # -# $FreeBSD: www/en/cgi/getmsg.cgi,v 1.37 2004/04/04 21:49:38 phantom Exp $ +# $FreeBSD: www/en/cgi/getmsg.cgi,v 1.38 2005/03/29 20:43:20 simon Exp $ # require "./cgi-lib.pl"; require "./cgi-style.pl"; use POSIX qw(strftime); # # Files MUST be fully qualified and MUST start with this path. # $messagepath = "/usr/local/www/db/text/"; $messagepathcurrent = "/usr/local/www/mid/archive/"; $ftparchive = 'ftp://ftp.FreeBSD.org/pub/FreeBSD/doc/mailing-lists/archive'; &ReadParse(*formdata); &Fetch($formdata{'fetch'}); exit 0; sub Fetch { my ($docid) = @_; my ($start, $end, $file, $type) = split(/ /, $docid); my ($message, @finfo); # # 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|/+|/|; $file =~ s|^archive/|$messagepath/|; # read the full archive if ($type eq 'archive') { # from the FreeBSD ftp server if ($file =~ s%^$messagepath%%o) { print "Location: $ftparchive/$file.gz\n"; print "Content-type: text/plain\n\n"; exit(0); } # from the local mail archive for current mails elsif ($file =~ m%^current/(cvs|freebsd|p4)-[a-z0-9-]+$% && open(DATA, "$messagepathcurrent$file")) { print "Content-type: text/plain\n\n"; while() { print; } close(DATA); exit(0); } } if (($file =~ /^$messagepath/ && -f $file && open(DATA, $file)) || ($file =~ m%^current/(cvs|freebsd|p4)-[a-z0-9-]+$% && open(DATA, "$messagepathcurrent$file"))) { @finfo = stat DATA; seek DATA, $start, 0; if ($end > $start && $start >= 0) { read DATA, $message, $end - $start; } else { # Unknown length, guess the end of the E-Mail my($newline) = 0; while() { last if ($newline && /^From .* \d{4}/); if (/^$/) { $newline = 1 } else { $newline = 0; } $message .= $_; } } close(DATA); print "last-modified: " . POSIX::strftime("%a, %d %b %Y %T GMT", gmtime($finfo[9])) . "\n"; # print E-Mail as plain ascii text if ($type eq 'raw') { print "Content-type: text/plain\n\n"; print $message; return; } $message = &MessageToHTML($message, $file); } else { $message = "

The specified message cannot be accessed.

\n"; } print &short_html_header("FreeBSD Mail Archives"); print $message; print &html_footer; - print "\n"; } sub EscapeHTML { my ($text) = @_; $text =~ s/&/&/g; $text =~ s//>/g; return $text; } sub MessageToHTML { my ($doc, $file) = @_; my ($header, $body) = split(/\n\n/, $doc, 2); my ($i, %hdr, $field, $data, $message); my ($mid) = 'mid.cgi'; my ($mid_full_url) = 'http://docs.FreeBSD.org/cgi/mid.cgi'; my ($tmid,$tirt,$tref); $body = &AddAnchors(&EscapeHTML($body)); $header = &EscapeHTML($header); $header =~ s/\n[ \t]+/ /g; foreach $i (split(/\n/, $header)) { ($field, $data) = split(/ /, $i, 2); $field =~ y/A-Z/a-z/; $hdr{$field} = $data; } $message = "
\n";
     if (length($hdr{'date:'}) > 0) {
     	$message .= "Date:      $hdr{'date:'}\n";
     }
     if (length($hdr{'from:'}) > 0) {
     	$message .= "From:      $hdr{'from:'}\n";
     }
     if (length($hdr{'to:'}) > 0) {
     	$message .= "To:        $hdr{'to:'}\n";
     }
     if (length($hdr{'cc:'}) > 0) {
     	$message .= "Cc:        $hdr{'cc:'}\n";
     }
 #    if (length($hdr{'sender:'}) > 0) {
 #    	$message .= "Sender:    $hdr{'sender:'}\n";
 #    }
     if (length($hdr{'subject:'}) > 0) {
     	$message .= "Subject:   $hdr{'subject:'}\n";
     }
 
     if ($hdr{'message-id:'}) {
 	$tmid = $hdr{'message-id:'}; 
 	$hdr{'message-id:'} =~ 
-	    s%;([^&]+)&%;$1&%oi;
+	    s%;([^&]+)&%;$1&%oi;
 	$message .= "Message-ID:  $hdr{'message-id:'}\n";
     }
 
     if ($hdr{'resent-message-id:'}) {
 	$hdr{'resent-message-id:'} =~ 
-	    s%;([^&]+)&%;$1&%oi;
+	    s%;([^&]+)&%;$1&%oi;
 	$message .= "Resent-Message-ID: $hdr{'resent-message-id:'}\n";
     }
 
     if ($hdr{'in-reply-to:'}) {
 	$tirt = $hdr{'in-reply-to:'};
 	$hdr{'in-reply-to:'} =~
-	    s%;([^&]+)&%;$1&%oi;
+	    s%;([^&]+)&%;$1&%oi;
 	$message .= "In-Reply-To: $hdr{'in-reply-to:'}\n";
     }
 
     if ($hdr{'references:'}) {
 	$tref = $hdr{'references:'};
 	$hdr{'references:'} =~
-	    s%;([^&\s]+)&%;$1&%goi;
+	    s%;([^&\s]+)&%;$1&%goi;
 	$message .= "References:  $hdr{'references:'}\n";
     }
 
 
     $message .= "
\n"; - $message .= "
\n"; + $message .= "
\n"; if ($tmid =~ m%;([^&]+)&%) { - $message .= qq{Next in thread\n}; + $message .= qq{Next in thread\n}; } if ($tirt =~ m%;([^&]+)&% || $tref =~ m%;([^&]+)&%) { - $message .= qq{| Previous in thread\n}; + $message .= qq{| Previous in thread\n}; } $message .= qq{| Raw E-Mail\n}; my $file2 = $file; if ($file2 =~ s%^$messagepath%archive/%oi || $file2 =~ /^current/) { $message .= qq{| Index\n}; } $message .= qq{| Archive\n}; $message .= qq{| Help\n}; my $tid = $tmid; $tid =~ s/^<//; $tid =~ s/\@.*//; - $message .= "
\n"; - #$message .= qq{
\n}; - $message .= "

\n$body\n
\n"; + $message .= "
\n"; + #$message .= qq{
\n}; + $message .= "
\n$body\n
\n"; #$message .= qq{
\n}; - $message .= qq{
\nWant to link to this message? Use this URL: <}; + $message .= qq{
\n

Want to link to this message? Use this URL: <}; $message .= qq{$mid_full_url} . '?' . $tid . qq{>}; + $message .= qq{">$mid_full_url} . '?' . $tid . qq{>

}; return $message; } sub strip_url { my $url = shift; # strip trailing characters $url =~ s/>?$//; $url =~ s/[.,;>\s]*$//; return $url; } sub AddAnchors { my ($text) = @_; my $cvsweb = 'http://cvsweb.FreeBSD.org/'; $text =~ s/(http|https|ftp|gopher|mailto|news|file)(:[\S]*?\/?)(\W?\s)/sprintf("%s<\/a>$3", &strip_url("$1$2"), &strip_url("$1$2"), $3)/egoi; if ($text =~ /Revision\s+Changes\s+Path/) { # match revsion and file name # 1.10 +2 -2 ports/audio/xmradio/Makefile # -> # cvsweb.cgi/ports/audio/xmradio/Makefile.diff?r1=1.9&r2=r.10 # $text =~ s!([\d.]+\.)(\d+) # revision (\s+[+-]\d+\s+[+-]\d+\s+) # +- stuff ([a-zA-Z\d_:.+/-]+) # filename !"$1$2" eq "1.1" ? sprintf("%s%s%s%s", $1, $2, $3, $4, $4) : sprintf("%s%s%s%s", $1, $2, $3, $4, $1, $2 - 1, $1, $2, $4)!gex; } return $text; } diff --git a/en/cgi/mid.cgi b/en/cgi/mid.cgi index a21d9cab83..e4835af485 100755 --- a/en/cgi/mid.cgi +++ b/en/cgi/mid.cgi @@ -1,157 +1,157 @@ #!/usr/bin/perl -T # # Copyright (c) March 1998-2000 Wolfram Schneider . Berlin. # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Search a mail by Message-ID, References or In-Reply-To field # -# $FreeBSD: www/en/cgi/mid.cgi,v 1.11 2000/12/28 13:16:39 wosch Exp $ +# $FreeBSD: www/en/cgi/mid.cgi,v 1.12 2002/04/22 05:08:41 kuriyama Exp $ $hsty_base = ''; require "./cgi-lib.pl"; require "./cgi-style.pl"; $home = '/usr/local/www/mailindex'; $prefix= "/usr/local/www/db/text"; $lookupdir = "$home/message-id"; # database(s) directory $databaseDefault = 'mid'; # default database $bindir = "$home/bin"; # where search scripts located $script = $ENV{'SCRIPT_NAME'}; $shortid = 1; $lookCommand = "/usr/bin/look"; sub escape($) { $_ = $_[0]; s/&/&/g; s//>/g; $_; } sub get_id { local($query, $db) = @_; open(DB, "-|") || exec("$lookCommand", $query, "$lookupdir/mid-current.$db") || do { print &midheader . - "Cannot connect to Message-ID database.

\n" . &foot; + "

Cannot connect to Message-ID database.

\n" . &foot; exit; }; local(@idlist); while() { push(@idlist, $_); } close DB; #warn "$lookCommand $query, $lookupdir/mid.$db"; open(DB, "-|") || exec("$lookCommand", $query, "$lookupdir/mid.$db") || do { print &midheader . - "Cannot connect to Message-ID database.

\n" . &foot; + "

Cannot connect to Message-ID database.

\n" . &foot; exit; }; while() { push(@idlist, $_); } close DB; if ($#idlist < 0) { # nothing found print &midheader; if ($db eq 'mid') { printf "Message-ID: \"%s\" not found\n", escape($query); } else { printf "No answers found for: \"%s\"\n", escape($query); } print &foot; } elsif ($#idlist == 0) { # one hit local($location) = $ENV{'SCRIPT_NAME'}; local($id, $file, $start) = split($", $idlist[0]); $location =~ s%/[^/]+$%%; local($host) = $ENV{'HTTP_HOST'}; $location = 'http://' . $host . $location; $start =~ s/\s+$//; print "Location: $location/getmsg.cgi?fetch=$start+0+" . ($file =~ /^current/ ? '' : "$prefix/") . "$file\n"; print "Content-type: text/plain\n\n"; exit; } else { # more than one hit local($id, $file, $start, $name); print &midheader; - print "
    \n"; + print "
      \n"; foreach (@idlist) { ($id, $file, $start) = split; $name = $file; $name =~ s%.*/%%; $name =~ s%(....)(..)(..)\.%$1-$2-$3 %; - print qq{
    • $name $start\n}; + qq{$file">$name $start
      • \n}; } - print "
    \n

    \n"; + print "

\n

\n"; print &foot; } } sub midheader { return &short_html_header("FreeBSD Message-ID Mail Archives") . - qq{

Back to the search interface

\n}; + qq{

Back to the search interface

\n}; } -sub foot { return &html_footer . "\n"; } +sub foot { return &html_footer; } ### # Main ### &ReadParse(*input); $messageid = $input{'id'}; $database = $input{'db'}; if (!$messageid) { # for lazy people ;-) # allow the syntax mid.cgi?messageid if ($ENV{'QUERY_STRING'} =~ /\-]+\S+$/) { $messageid = $ENV{'QUERY_STRING'}; $database = $databaseDefault; } # no message-id given else { print &midheader; print "No input given\n"; print &foot; exit; } } $messageid =~ s/^$//; $messageid =~ s/@.*// if $shortid; $database = $databaseDefault if (!($database eq 'mid' || $database eq 'irt')); &get_id($messageid, $database); diff --git a/en/cgi/search.cgi b/en/cgi/search.cgi index a7ab277b3f..782e02640f 100755 --- a/en/cgi/search.cgi +++ b/en/cgi/search.cgi @@ -1,263 +1,263 @@ #!/usr/bin/perl -T # # mail-archive.pl -- a CGI interface to a wais indexed maling list archive. # # Origin: # Tony Sanders , Nov 1993 # # Hacked beyond recognition by: # John Fieber , Nov 1994 # # Format the mail messages a little nicer. # Add code to check database status before searching. # John Fieber , Aug 1996 # # Disclaimer: # This is pretty ugly in places. # -# $FreeBSD: www/en/cgi/search.cgi,v 1.22 2001/10/30 07:26:27 kuriyama Exp $ +# $FreeBSD: www/en/cgi/search.cgi,v 1.23 2002/04/22 05:08:41 kuriyama Exp $ $server_root = '/usr/local/www'; $waisq = "/usr/local/www/bin/waisq"; $sourcepath = "$server_root/db/index"; $hints = "/search/searchhints.html"; $searchpage = '/search/search.html'; $myurl = $ENV{'SCRIPT_NAME'}; require "open2.pl"; require "./cgi-lib.pl"; require "./cgi-style.pl"; @months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); sub escape($) { $_ = $_[0]; s/&/&/g; s//>/g; $_; } sub do_wais { &ReadParse; @FORM_words = split(/ /, escape($in{"words"})); @FORM_source = split(/\0/, escape($in{"source"})); $FORM_max = $in{"max"}; $FORM_docnum = $in{"docnum"}; $FORM_index = $in{"index"}; if ($FORM_index =~ /^re[sc]ent$/) { $sourcepath = "$server_root/db/index-recent"; } if ($#FORM_words < 0) { print &html_header("Mail Archive Search") . "

No search term given."; print "

\nPlease return to the " . "search page and fill out the 'Search for' field!\n"; print &html_footer; exit 0; } @AVAIL_source = &checksource(@FORM_source); if ($#FORM_source != $#AVAIL_source) { $j = 0; $k = 0; foreach $i (0 .. $#FORM_source) { if ($FORM_source[$i] ne $AVAIL_source[$j]) { $badsource[$k] = $FORM_source[$i]; $k++; } else { $j++; } } $badsource = join(", ", @badsource); $badsource =~ s/,([^,]*)$/ and $1/; if ($#FORM_source - $#AVAIL_source > 1) { $availmsg = "

[The $badsource archives are currently unavailable.]

"; } else { $availmsg = "

[The $badsource archive is currently unavailable.]

"; } } if ($#AVAIL_source < 0) { $i = join(", ", @FORM_source); $i =~ s/,([^,]*)$/ and $1/; print &html_header("Mail Archive Search") . "

None of the archives you requested ($i) are " . " available at this time.

\n"; print "

Please try again later, or return to the " . "search page and select a different archive.

\n"; print &html_footer; exit 0; } # Now we formulate the question to ask the server foreach $i (@AVAIL_source) { $w_sources .= "(:source-id\n :filename \"$i.src\"\n ) "; } $w_question = "\n (:question :version 2 :seed-words \"@FORM_words\" :relevant-documents ( ) :sourcepath \"$sourcepath/:\" :sources ( $w_sources ) :maximum-results $FORM_max :result-documents ( ) )\n"; # # First case, no document number so this is a regular search # print &html_header("Search Results"); print $availmsg; if ($#AVAIL_source > 0) { $src = join(", ", @AVAIL_source); $src =~ s/,([^,]*)$/ and $1/; print "

The archives $src contain "; } else { print "The archive @AVAIL_source contains "; } print " the following items relevant to \`@FORM_words\':\n"; - print "

    \n"; + print "
      \n"; &open2(WAISOUT, WAISIN, $waisq, "-g"); print WAISIN $w_question; local(@mylist) = (); local($hits, $score, $headline, $lines, $bytes, $docid, $date, $file); while () { /: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+)"/ && $docid !~ /\.src$/ && ($date = $1, $hits++, push(@mylist, join("\t", $date, $headline, $docid, $bytes, $lines, $file, $score, $hits))); } 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 "
    \n"; + print "
\n"; print "

Didn't get what you expected? "; print "Look here for searching hints.

"; print qq{

Return to the search page

\n}; if ($hits == 0) { print "Nothing found.\n"; } print &html_footer; close(WAISOUT); close(WAISIN); } # Given an array of sources (sans .src extension), this routine # checks to see if they actually exist, and if they do, if they # are currently available (ie, not being updated). It returns # an array of sources that are actually available. sub checksource { local (@sources) = @_; $j = 0; foreach $i (@sources) { if (stat("$sourcepath/$i.src")) { if (!stat("$sourcepath/$i.update.lock")) { $goodsources[$j] = $i; $j++; } } } return(@goodsources); } sub docdone { $file =~ s/\.src$//; if ($headline =~ /Search produced no result/) { print "

The archive $file contains no relevant documents.

" } else { $headline = escape($headline); $headline =~ s/\\"/\"/g; if ($file eq "www" || $file eq 'pkgdescr') { print "
  • $headline\n"; } else { - print "
  • $headline\n"; + print "
  • $headline\n"; } - print "
    "; -# print ""; + print "
    "; +# print ""; print "Score: $score; "; $_ = $date; /(...?)(..)(..)/ && ($yr = $1 + 1900, $mo = $months[$2 - 1], $dy = $3); print "Lines: $lines; "; print "${dy}-${mo}-${yr}; "; print "Archive: $file"; print "

    • \n"; } $score = $headline = $lines = $bytes = $docid = $date = $file = ''; $yr = $mo = $dy = ''; } $| = 1; open (STDERR,"> /dev/null"); #open (STDERR,">> /tmp/search"); eval '&do_wais';