Remove js requirement for repeat searches
[mharc.git] / cgi-bin / mesg.cgi.in.dist
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 '@@SW_ROOT@@/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 = '@@HTML_DIR@@';
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