git: 9da657b7c4 - main - refactor out mail archive cgi script
Wolfram Schneider <[email protected]>
| Newsgroups | gmane.os.freebsd.devel.cvs.doc |
|---|---|
| Message-ID | <[email protected]> |
The branch main has been updated by wosch: URL: https://cgit.FreeBSD.org/doc/commit/?id=9da657b7c4bca442735c1563a923c8b3993f3181 commit 9da657b7c4bca442735c1563a923c8b3993f3181 Author: Wolfram Schneider <[email protected]> AuthorDate: 2023-02-13 22:16:59 +0000 Commit: Wolfram Schneider <[email protected]> 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 <[email protected]> -# 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 <[email protected]>. 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);