git: 9da657b7c4 - main - refactor out mail archive cgi script
- Go to: [ bottom of page ] [ top of archives ] [ this month ]
Date: Mon, 13 Feb 2023 22:17:49 UTC
The branch main has been updated by wosch:
URL: https://cgit.FreeBSD.org/doc/commit/?id=9da657b7c4bca442735c1563a923c8b3993f3181
commit 9da657b7c4bca442735c1563a923c8b3993f3181
Author: Wolfram Schneider <wosch@FreeBSD.org>
AuthorDate: 2023-02-13 22:16:59 +0000
Commit: Wolfram Schneider <wosch@FreeBSD.org>
CommitDate: 2023-02-13 22:16:59 +0000
refactor out mail archive cgi script
The cgi scripts are moved to the mail archive repo along with the
current/weekly mail archive maintenance scripts. This makes it much easier
to keep them in sync and up to date.
---
website/content/en/cgi/getmsg.cgi | 248 -----------------------------------
website/content/en/cgi/mailindex.cgi | 111 ----------------
website/content/en/cgi/mid.cgi | 161 -----------------------
3 files changed, 520 deletions(-)
diff --git a/website/content/en/cgi/getmsg.cgi b/website/content/en/cgi/getmsg.cgi
deleted file mode 100755
index 272ad44309..0000000000
--- a/website/content/en/cgi/getmsg.cgi
+++ /dev/null
@@ -1,248 +0,0 @@
-#!/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$
-#
-
-require "./cgi-lib.pl";
-require "./cgi-style.pl";
-use POSIX qw(strftime);
-#
-# Site design includes setting a:visited to the same as a:link,
-# which isn't good in archived messages, e.g., you want to follow
-# links in commit messages and know which links you've visited.
-# Override it inside the <pre> that is the message.
-$t_style = qq`<style type="text/css">
-pre a:visited { color: #220000; }
-</style>
-`;
-
-
-#
-# Files MUST be fully qualified and MUST start with this path.
-#
-$messagepath = "/usr/local/www/mailindex/archive/";
-$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/|;
-
- my $valid_list_name = '^current/(aic7xxx|archbsd|ctm|cvs|dev|freebsd|netperf|oi|p4|soc|svn|trustedbsd|vendors)(-[a-z0-9-]+)?$';
-
- # 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 =~ /$valid_list_name/ &&
- open(DATA, "$messagepathcurrent$file")) {
- print "Content-type: text/plain\n\n";
- while(<DATA>) {
- print;
- }
- close(DATA);
- exit(0);
- }
- }
-
- if (($file =~ /^$messagepath/ && -f $file && open(DATA, $file)) ||
- ($file =~ /$valid_list_name/ &&
- 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(<DATA>) {
- 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 = "<p>The specified message cannot be accessed.</p>\n";
- warn "$0: error open '$file' $!\n";
- }
-
- print &short_html_header("FreeBSD Mail Archives");
- print $message;
- print &html_footer;
-}
-
-sub EscapeHTML
-{
- my ($text) = @_;
- $text =~ s/&/&/g;
- $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) = 'https://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 = "<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";
- }
-
- if ($hdr{'message-id:'}) {
- $tmid = $hdr{'message-id:'};
- $hdr{'message-id:'} =~
- s%;([^&]+)&%;<a href="$mid?db=irt&id=$1">$1</a>&%oi;
- $message .= "<strong>Message-ID: </strong> $hdr{'message-id:'}\n";
- }
-
- if ($hdr{'resent-message-id:'}) {
- $hdr{'resent-message-id:'} =~
- s%;([^&]+)&%;<a href="$mid?db=irt&id=$1">$1</a>&%oi;
- $message .= "<strong>Resent-Message-ID: </strong>$hdr{'resent-message-id:'}\n";
- }
-
- if ($hdr{'in-reply-to:'}) {
- $tirt = $hdr{'in-reply-to:'};
- $hdr{'in-reply-to:'} =~
- s%;([^&]+)&%;<a href="$mid?db=mid&id=$1">$1</a>&%oi;
- $message .= "<strong>In-Reply-To: </strong>$hdr{'in-reply-to:'}\n";
- }
-
- if ($hdr{'references:'}) {
- $tref = $hdr{'references:'};
- $hdr{'references:'} =~
- s%;([^&\s]+)&%;<a href="$mid?db=mid&id=$1">$1</a>&%goi;
- $message .= "<strong>References: </strong> $hdr{'references:'}\n";
- }
-
-
- $message .= "</pre>\n";
- $message .= "<hr noshade=\"noshade\"/>\n";
-
- if ($tmid =~ m%;([^&]+)&%) {
- $message .= qq{<a href="$mid?db=irt&id=$1">Next in thread</a>\n};
- }
-
- if ($tirt =~ m%;([^&]+)&% ||
- $tref =~ m%;([^&]+)&%) {
- $message .= qq{| <a href="$mid?db=mid&id=$1">Previous in thread</a>\n};
- }
- $message .= qq{| <a href="$ENV{'REQUEST_URI'}+raw">Raw E-Mail</a>\n};
- my $file2 = $file;
- if ($file2 =~ s%^$messagepath%archive/%oi ||
- $file2 =~ /^current/) {
- $message .= qq{| <a href="/mail/$file2.html">Index</a>\n};
- }
- $message .= qq{| <a href="$ENV{'REQUEST_URI'}+archive">Archive</a>\n};
- $message .= qq{| <a href="../search/searchhints.html">Help</a>\n};
-
- my $tid = $tmid;
- $tid =~ s/^<//;
- $tid =~ s/\@.*//;
-
- $message .= "<hr noshade=\"noshade\"/>\n";
- #$message .= qq{<div onclick="document.location='$mid_full_url?db=irt&id=$tid'">\n};
- $message .= "<pre>\n$body\n</pre>\n";
- #$message .= qq{</div>\n};
-
- $message .= qq{<hr/>\n<p>Want to link to this message? Use this URL: <};
- $message .= qq{<a href="} . $mid_full_url . '?' . $tid;
- $message .= qq{">$mid_full_url} . '?' . $tid . qq{</a>></p>};
-
- return $message;
-}
-
-sub strip_url
-{
- my $url = shift;
-
- # strip trailing characters
- $url =~ s/>?$//;
- $url =~ s/[.,;>\s\)]*$//;
-
- return $url;
-}
-
-sub AddAnchors
-{
- my ($text) = @_;
-
- $text =~ s/(http|https|ftp)(:[\S]*?\/?)(\W?\s)/sprintf("<a href=\"%s\">%s<\/a>$3", &strip_url("$1$2"), "$1$2", $3)/egoi;
-
- return $text;
-}
diff --git a/website/content/en/cgi/mailindex.cgi b/website/content/en/cgi/mailindex.cgi
deleted file mode 100755
index 249da5f041..0000000000
--- a/website/content/en/cgi/mailindex.cgi
+++ /dev/null
@@ -1,111 +0,0 @@
-#!/usr/bin/perl -T
-#
-# Copyright (c) Jan 1999-2011 Wolfram Schneider <wosch@FreeBSD.org>
-# 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.
-#
-# $FreeBSD$
-
-
-use CGI;
-use CGI::Carp;
-
-require "./cgi-lib.pl";
-require "./cgi-style.pl";
-
-$ENV{PATH} = "/bin:/usr/bin:/usr/local/bin";
-
-# no sort
-my $sortopt = '';
-my $up = 0;
-
-$| = 1;
-
-# mail archive location
-$maildir = '/home/mail/archive';
-
-# mailindex program
-$mailindex = '/usr/local/www/mailindex/bin/mailindex';
-
-
-$query = new CGI();
-
-print "Content-type: text/html\n\n";
-
-my $reverse;
-$sortopt = '--sort-by-subject' if ($query->param('sort') eq 'subject');
-$sortopt = '--sort-by-author' if ($query->param('sort') eq 'author');
-$sortopt = '' if ($query->param('sort') eq 'date');
-
-$reverse = '--reverse' if ($query->param('reverse'));
-
-my $file = $query->param('file');
-if (!$file) {
- print "No file name given\n";
- exit;
-}
-
-# forbid link to parent directories
-$file =~ s%\.\./%%g;
-if ($file =~ m,^([0-9a-z/-]+|[0-9a-z/-]+\.[0-9a-z-]+)$,) {
- $file = $1;
-} else {
- print "Unknown file name given\n";
- exit;
-}
-
-
-sub file_not_exists {
- my $file = shift;
- print "File does not exist: $file\n";
- exit;
-}
-
-if ($file =~ s%^archive/%%) {
- $maildir = '/usr/local/www/mailindex/archive';
- &file_not_exists("$maildir/$file") if (! -f "$maildir/$file");
-} elsif ($file =~ s%^current/%% && $file =~ /^(freebsd|cvs|svn|ctm|trustedbsd)-/) {
- &file_not_exists("$file") if (! -f "$maildir/$file");
- $up = 0;
-} else {
- &file_not_exists("$file");
-}
-
-chdir($maildir) or die "chdir $maildir: $!\n";
-
-my @options;
-push(@options, ("--up=$up", '--outdir=stdout', '--cgilink=1'));
-push(@options, $sortopt) if $sortopt;
-push(@options, $reverse) if $reverse;
-
-open(M, "-|") || exec "$mailindex", @options, $file || do {
- print "Cannot open $mailindex: $!\n";
- exit;
-};
-
-#print "cd $maildir; $mailindex @options $file\n";
-while(<M>) {
- print;
-}
-
-exit;
diff --git a/website/content/en/cgi/mid.cgi b/website/content/en/cgi/mid.cgi
deleted file mode 100755
index 12c9f255f3..0000000000
--- a/website/content/en/cgi/mid.cgi
+++ /dev/null
@@ -1,161 +0,0 @@
-#!/usr/bin/perl -T
-#
-# Copyright (c) March 1998-2021 Wolfram Schneider <wosch@FreeBSD.org>. 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$
-
-require "./cgi-lib.pl";
-require "./cgi-style.pl";
-
-$home = '/usr/local/www/mailindex';
-$prefix= "/usr/local/www/mailindex/archive";
-$lookupdir = "$home/message-id"; # database(s) directory
-$databaseDefault = 'mid'; # default database
-$script = $ENV{'SCRIPT_NAME'};
-$shortid = 1;
-$lookCommand = "/usr/bin/look";
-$ENV{PATH} = '/bin:/usr/bin';
-
-$main::t_style .= qq{\n<link rel="search" type="application/opensearchdescription+xml" href="https://www.freebsd.org/opensearch/message-id.xml" title="FreeBSD M-ID" />\n};
-
-sub escape($) { $_ = $_[0]; s/&/&/g; s/</</g; s/>/>/g; $_; }
-
-sub get_id {
- local($query, $db) = @_;
-
- open(DB, "-|") ||
- exec("$lookCommand", $query, "$lookupdir/mid-current.$db") ||
- do {
- print &midheader .
- "<p>Cannot connect to Message-ID database.</p>\n" . &foot;
- exit;
- };
-
- local(@idlist);
- while(<DB>) {
- push(@idlist, $_);
- }
- close DB;
- #warn "$lookCommand $query, $lookupdir/mid.$db";
- open(DB, "-|") ||
- exec("$lookCommand", $query, "$lookupdir/mid.$db") ||
- do {
- print &midheader .
- "<p>Cannot connect to Message-ID database.</p>\n" . &foot;
- exit;
- };
-
- while(<DB>) {
- 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 = '//' . $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 "<ul>\n";
- foreach (@idlist) {
- ($id, $file, $start) = split;
- $name = $file;
- $name =~ s%.*/%%;
- $name =~ s%(....)(..)(..)\.%$1-$2-$3 %;
- print qq{<li><a href="getmsg.cgi?fetch=$start+0+} .
- ($file =~ /^current/ ? '' : "$prefix/") .
- qq{$file">$name $start</a></li>\n};
- }
- print "</ul>\n<p></p>\n";
- print &foot;
- }
-}
-
-sub midheader {
- return &short_html_header("FreeBSD Message-ID Mail Archives") .
- qq{<p><a href="$hsty_base/search/">Back to the search interface</a></p>\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'} =~ /<?[a-z0-9._>\-]+\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/>$//;
-$messageid =~ s/@.*// if $shortid;
-($messageid) = $messageid =~ m|^(\S+)$|; # XXX: can be more strict...
-
-if ($database =~ m/^(mid|irt)$/) {
- $database = $1;
-} else {
- $database = $databaseDefault;
-}
-
-&get_id($messageid, $database);