Remove js requirement for repeat searches
[mharc.git] / cgi-bin / extract-mesg.cgi.in
1 #!/usr/bin/perl
2 ##--------------------------------------------------------------------------##
3 ##  File:
4 ##      $Id: extract-mesg.cgi.in.dist,v 1.5 2002/09/20 03:29:28 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::extract_mesg_cgi;
29
30 use lib '@@SW_ROOT@@/lib';
31
32 use CGI::Carp;
33 use MHArc::CGI;
34
35 #############################################################################
36 ##      BEGIN: Config Section
37 #############################################################################
38
39 ## Full pathname to where raw archives are located.
40 my $mbox_archive_root = '@@MBOX_DIR@@';
41
42 ## Message media-type: This is the media-type this script will return
43 ## to the client when serving up the raw mail message.  Note, some
44 ## browsers actually support message/rfc822, but this could potentially
45 ## cause XSS HTML email attacks, so use with caution.
46 my $message_media_type = 'text/plain';
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 month
58 my $argname_month = 'm';
59
60 ## Query argument name to contain message-id
61 my $argname_id = 'i';
62
63 ## Mbox message separator: Try to be more strict than '^From ', but
64 ## not too strict to deal with possible variations.
65 my $msgsep = '^From \S+.*\d+:\d+:\d+';
66
67 MAIN: {
68   my $form      = MHArc::CGI::parse_input();
69   my $archive   = $form->{$argname_archive} || "";
70   my $month     = $form->{$argname_month} || "";
71   my $id        = $form->{$argname_id} || "";
72
73   my $list_dir;
74   if (($month !~ /^\d{4}(?:-\d{2})?$/) ||
75       ($id !~ /.\@./) ||
76       ($archive !~ /\S/) ||
77       ($archive =~ /\.\./) ||
78       (! -d ($list_dir = join('/', $mbox_archive_root,$archive)))) {
79     warn qq/Invalid arguments: a=$archive, m=$month, i=$id\n/;
80     MHArc::CGI::print_input_error();
81     last MAIN;
82   }
83
84   # Check if list has raw archive access disabled.
85   if (-e join('/', $list_dir, '.noraw')) {
86     MHArc::CGI::print_forbidden();
87     last MAIN;
88   }
89
90   my $gzipped = 0;
91   my $mbox_file = join('/', $list_dir, $month);
92   if (! -e $mbox_file) {
93     $mbox_file .= '.gz';
94     $gzipped = 1;
95   }
96   if (! -e $mbox_file) {
97     warn qq/"$mbox_file" does not exist\n/;
98     MHArc::CGI::print_input_error();
99     last MAIN;
100   }
101
102   local(*MBOX);
103   if ($gzipped) {
104     if (!open(MBOX, "gzip -dc '$mbox_file' |")) {
105       warn qq/Unable to exec "gzip -dc '$mbox_file'": $!\n/;
106       MHArc::CGI::print_error();
107       last MAIN;
108     }
109   } else {
110     if (!open(MBOX, $mbox_file)) {
111       warn qq/Unable to open "$mbox_file": $!\n/;
112       MHArc::CGI::print_error();
113       last MAIN;
114     }
115   }
116
117   local $_;
118   my $cache     = '';
119   my $in_header = 1;
120   my $msg_id    = '';
121   my $found     = 0;
122
123   SCAN: while (<MBOX>) {
124     if (/$msgsep/o) {
125       $cache = '';
126       $in_header = 1;
127       next SCAN;
128     }
129     next SCAN  unless $in_header;
130
131     if (/^\r?$/) {
132       $cache = '';
133       $in_header = 0;
134       next SCAN;
135     }
136
137     $cache .= $_;
138     if (s/^message-id:\s*//i) {
139       s/\s+\Z//;
140       s/[<>]//g;
141       if ($_ eq $id) {
142         $found = 1;
143         last SCAN;
144       }
145       $cache = '';
146       $in_header = 0;
147     }
148   }
149
150   if (!$found) {
151     MHArc::CGI::print_not_found_error();
152     close(MBOX);
153     last MAIN;
154   }
155
156   MHArc::CGI::print_content_type($message_media_type);
157   print STDOUT $cache;
158   while (<MBOX>) {
159     last  if /$msgsep/o;
160     print STDOUT $_;
161   }
162   close(MBOX);
163 }
164
165 ########################################################################
166 __END__
167
168 =head1 NAME
169
170 extract-mesg.cgi - mharc CGI program to retrieve raw version of a message
171
172 =head1 SYNOPSIS
173
174   http://.../cgi-bin/extract-mesg.cgi?a=<archive-name>&m=<period>&i=<message-id>
175
176 =head1 DESCRIPTION
177
178 This CGI program retrieves the raw version of a message from an
179 archive archived at a specified period and with a specified message-id.
180
181 The CGI program will output the retrieved message to the web client.
182
183 =head1 CGI OPTIONS
184
185 =over
186
187 =item C<a>
188
189 The name of the archive.  Archive names are defined by C<lists.def>.
190
191 =item C<i>
192
193 The message-id.
194
195 =item C<m>
196
197 The period in YYYY-MM or YYYY format.
198
199 =back
200
201 =head1 VERSION
202
203 C<$Id: extract-mesg.cgi.in.dist,v 1.5 2002/09/20 03:29:28 ehood Exp $>
204
205 =head1 AUTHOR
206
207 Earl Hood, earl@earlhood.com
208
209 This module is part of the mharc archiving system and comes with
210 ABSOLUTELY NO WARRANTY and may be copied only under the terms of
211 the GNU General Public License, which may be found in the MHArc
212 distribution.
213
214 =cut
215