cgi-bin/mesg.cgi

   1 #!/usr/bin/perl
   2 ##--------------------------------------------------------------------------##
   3 ##  File:
   4 ##      $Id: mesg.cgi.in.dist,v 1.1 2002/09/03 16:30:47 ehood Exp $
   5 ##  Author:
   6 ##      Earl Hood       earl@earlhood.com
   7 ##  Description:
   8 ##      POD at end-of-file.
   9 ##--------------------------------------------------------------------------##
  10 ##  Copyright (C) 2002  Earl Hood <earl@earlhood.com>
  11 ##
  12 ##  This program is free software; you can redistribute it and/or modify
  13 ##  it under the terms of the GNU General Public License as published by
  14 ##  the Free Software Foundation; either version 2 of the License, or
  15 ##  (at your option) any later version.
  16 ##
  17 ##  This program is distributed in the hope that it will be useful,
  18 ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ##  GNU General Public License for more details.
  21 ##
  22 ##  You should have received a copy of the GNU General Public License
  23 ##  along with this program; if not, write to the Free Software
  24 ##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ##  02111-1307, USA
  26 ##--------------------------------------------------------------------------##
  27
  28 package MHArc::mesg_cgi;
  29
  30 use lib '/home/mharc/lib';
  31
  32 use Fcntl;
  33 use CGI::Carp;
  34 use MHArc::CGI;
  35 use MHArc::Namazu qw(
  36   nmz_load_rc
  37   nmz_get_field
  38   nmz_msg_id_search
  39 );
  40
  41 #############################################################################
  42 ##      BEGIN: Config Section
  43 #############################################################################
  44
  45 ## Full pathname to where html archives are located.
  46 my $html_archive_root = '/home/mharc/html';
  47
  48 #############################################################################
  49 ##      END: Config Section
  50 #############################################################################
  51
  52 $ENV{'PATH'} = '/usr/local/bin:/bin:/usr/bin';
  53
  54 ## Query argument name to contain name of archive
  55 my $argname_archive = 'a';
  56
  57 ## Query argument name to contain message-id
  58 my $argname_id = 'i';
  59
  60 ## Namazu conf file (should be the same used by namazu.cgi)
  61 my $namazurc = '.namazurc';
  62
  63 MAIN: {
  64   my $form      = MHArc::CGI::parse_input();
  65   my $archive   = $form->{$argname_archive} || "";
  66   my $id        = $form->{$argname_id} || "";
  67   my $host      = $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} ||
  68                   $ENV{'SERVER_ADDR'} || "localhost";
  69   my $port      = $ENV{'SERVER_PORT'} || "";
  70   if ($port && $port ne '80') {
  71     $port = ":$port";
  72   } else {
  73     $port = "";
  74   }
  75   my $server_url= "http://$host$port";
  76
  77   my $list_dir  = undef;
  78   if (($id !~ /.\@./) ||
  79       ($archive !~ /\S/) ||
  80       ($archive =~ /\.\./) ||
  81       (! -d ($list_dir = join('/', $html_archive_root,$archive)))) {
  82     warn qq/Invalid arguments: a=$archive, i=$id\n/;
  83     MHArc::CGI::print_input_error();
  84     last MAIN;
  85   }
  86
  87   my $nmzrc = nmz_load_rc($namazurc);
  88   if (!defined($nmzrc)) {
  89     MHArc::CGI::print_script_error();
  90     last MAIN;
  91   }
  92
  93   my $pathname = find_id($list_dir, $id);
  94   if (!defined($pathname)) {
  95     MHArc::CGI::print_not_found_error();
  96     last MAIN;
  97   }
  98   if (! -e $pathname) {
  99     warn qq/"$pathname" does not exist\n/;
 100     MHArc::CGI::print_not_found_error();
 101     last MAIN;
 102   }
 103
 104   # Apply replace string to pathname
 105   my $url = $pathname;
 106   foreach my $r (@{$nmzrc->{'replace'}}) {
 107     my $pos = index($pathname, $r->[0]);
 108     if ($pos == 0) {
 109       $url = $r->[1] . substr($pathname, length($r->[0]));
 110       last;
 111     }
 112   }
 113
 114   # Print out message page
 115   local(*MESG);
 116   if (!open(MESG, $pathname)) {
 117     warn qq/Unable top open "$pathname": $!\n/;
 118     MHArc::CGI::print_script_error();
 119     last MAIN;
 120   }
 121
 122   MHArc::CGI::print_content_type('text/html');
 123   my $did_base = 0;
 124   my $str;
 125   foreach $str (<MESG>) {
 126     print STDOUT $str;
 127     next  if $did_base;
 128     if ($str =~ /<head>/i) {
 129       print STDOUT '<base href="'. $server_url . $url . '">', "\n";
 130       $did_base = 1;
 131     }
 132   }
 133   close(MESG);
 134 }
 135
 136 #############################################################################
 137 ##      Generic subroutines for CGI use
 138 #############################################################################
 139
 140 sub find_id {
 141   my $list_dir  = shift;
 142   my $id        = shift;
 143
 144   my $docid = nmz_msg_id_search($list_dir, $id);
 145   if ($docid < 0) {
 146     return undef;
 147   }
 148   return nmz_get_field($list_dir, $docid, 'uri');
 149 }
 150
 151 ########################################################################
 152 __END__
 153
 154 =head1 NAME
 155
 156 mesg.cgi - mharc CGI program to retrieve a message by message-id
 157
 158 =head1 SYNOPSIS
 159
 160   http://.../cgi-bin/mesg.cgi?a=<archive-name>&i=<message-id>
 161
 162 =head1 DESCRIPTION
 163
 164 This CGI program retrieves a message from a specified archive with
 165 a give message-id.  The CGI program's main purpose is to provide
 166 a persistent URL to archived messages that is immune to archive
 167 rebuilds.
 168
 169 The CGI program will output the retrieved message to the web client.
 170 The message will have a C<E<lt>base hrefE<gt>> tag added so relative
 171 links in the message page will function properly.
 172
 173 =head1 CGI OPTIONS
 174
 175 =over
 176
 177 =item C<a>
 178
 179 The name of the archive.  Archive names are defined by C<lists.def>.
 180
 181 =item C<i>
 182
 183 The message-id.
 184
 185 =back
 186
 187 =head1 VERSION
 188
 189 C<$Id: mesg.cgi.in.dist,v 1.1 2002/09/03 16:30:47 ehood Exp $>
 190
 191 =head1 AUTHOR
 192
 193 Earl Hood, earl@earlhood.com
 194
 195 This module is part of the mharc archiving system and comes with
 196 ABSOLUTELY NO WARRANTY and may be copied only under the terms of
 197 the GNU General Public License, which may be found in the MHArc
 198 distribution.
 199
 200 =cut
 201