#!/usr/bin/perl ##--------------------------------------------------------------------------## ## File: ## $Id: mesg.cgi.in.dist,v 1.1 2002/09/03 16:30:47 ehood Exp $ ## Author: ## Earl Hood earl@earlhood.com ## Description: ## POD at end-of-file. ##--------------------------------------------------------------------------## ## Copyright (C) 2002 Earl Hood ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2 of the License, or ## (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ## 02111-1307, USA ##--------------------------------------------------------------------------## package MHArc::mesg_cgi; use lib '@@SW_ROOT@@/lib'; use Fcntl; use CGI::Carp; use MHArc::CGI; use MHArc::Namazu qw( nmz_load_rc nmz_get_field nmz_msg_id_search ); ############################################################################# ## BEGIN: Config Section ############################################################################# ## Full pathname to where html archives are located. my $html_archive_root = '@@HTML_DIR@@'; ############################################################################# ## END: Config Section ############################################################################# $ENV{'PATH'} = '/usr/local/bin:/bin:/usr/bin'; ## Query argument name to contain name of archive my $argname_archive = 'a'; ## Query argument name to contain message-id my $argname_id = 'i'; ## Namazu conf file (should be the same used by namazu.cgi) my $namazurc = '.namazurc'; MAIN: { my $form = MHArc::CGI::parse_input(); my $archive = $form->{$argname_archive} || ""; my $id = $form->{$argname_id} || ""; my $host = $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} || $ENV{'SERVER_ADDR'} || "localhost"; my $port = $ENV{'SERVER_PORT'} || ""; if ($port && $port ne '80') { $port = ":$port"; } else { $port = ""; } my $server_url= "http://$host$port"; my $list_dir = undef; if (($id !~ /.\@./) || ($archive !~ /\S/) || ($archive =~ /\.\./) || (! -d ($list_dir = join('/', $html_archive_root,$archive)))) { warn qq/Invalid arguments: a=$archive, i=$id\n/; MHArc::CGI::print_input_error(); last MAIN; } my $nmzrc = nmz_load_rc($namazurc); if (!defined($nmzrc)) { MHArc::CGI::print_script_error(); last MAIN; } my $pathname = find_id($list_dir, $id); if (!defined($pathname)) { MHArc::CGI::print_not_found_error(); last MAIN; } if (! -e $pathname) { warn qq/"$pathname" does not exist\n/; MHArc::CGI::print_not_found_error(); last MAIN; } # Apply replace string to pathname my $url = $pathname; foreach my $r (@{$nmzrc->{'replace'}}) { my $pos = index($pathname, $r->[0]); if ($pos == 0) { $url = $r->[1] . substr($pathname, length($r->[0])); last; } } # Print out message page local(*MESG); if (!open(MESG, $pathname)) { warn qq/Unable top open "$pathname": $!\n/; MHArc::CGI::print_script_error(); last MAIN; } MHArc::CGI::print_content_type('text/html'); my $did_base = 0; my $str; foreach $str () { print STDOUT $str; next if $did_base; if ($str =~ //i) { print STDOUT '', "\n"; $did_base = 1; } } close(MESG); } ############################################################################# ## Generic subroutines for CGI use ############################################################################# sub find_id { my $list_dir = shift; my $id = shift; my $docid = nmz_msg_id_search($list_dir, $id); if ($docid < 0) { return undef; } return nmz_get_field($list_dir, $docid, 'uri'); } ######################################################################## __END__ =head1 NAME mesg.cgi - mharc CGI program to retrieve a message by message-id =head1 SYNOPSIS http://.../cgi-bin/mesg.cgi?a=&i= =head1 DESCRIPTION This CGI program retrieves a message from a specified archive with a give message-id. The CGI program's main purpose is to provide a persistent URL to archived messages that is immune to archive rebuilds. The CGI program will output the retrieved message to the web client. The message will have a Cbase hrefE> tag added so relative links in the message page will function properly. =head1 CGI OPTIONS =over =item C The name of the archive. Archive names are defined by C. =item C The message-id. =back =head1 VERSION C<$Id: mesg.cgi.in.dist,v 1.1 2002/09/03 16:30:47 ehood Exp $> =head1 AUTHOR Earl Hood, earl@earlhood.com This module is part of the mharc archiving system and comes with ABSOLUTELY NO WARRANTY and may be copied only under the terms of the GNU General Public License, which may be found in the MHArc distribution. =cut