lists.def blocks http mboxes, unused otherwise
[mharc.git] / cgi-bin / extract-mesg.cgi
CommitLineData
01c223d0
BOFG
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
28package MHArc::extract_mesg_cgi;
29
30use lib '/home/mharc/lib';
31
32use CGI::Carp;
33use MHArc::CGI;
34
35#############################################################################
36## BEGIN: Config Section
37#############################################################################
38
39## Full pathname to where raw archives are located.
40my $mbox_archive_root = '/home/mharc/mbox';
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.
46my $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
55my $argname_archive = 'a';
56
57## Query argument name to contain month
58my $argname_month = 'm';
59
60## Query argument name to contain message-id
61my $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.
65my $msgsep = '^From \S+.*\d+:\d+:\d+';
66
67MAIN: {
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
170extract-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
178This CGI program retrieves the raw version of a message from an
179archive archived at a specified period and with a specified message-id.
180
181The 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
189The name of the archive. Archive names are defined by C<lists.def>.
190
191=item C<i>
192
193The message-id.
194
195=item C<m>
196
197The period in YYYY-MM or YYYY format.
198
199=back
200
201=head1 VERSION
202
203C<$Id: extract-mesg.cgi.in.dist,v 1.5 2002/09/20 03:29:28 ehood Exp $>
204
205=head1 AUTHOR
206
207Earl Hood, earl@earlhood.com
208
209This module is part of the mharc archiving system and comes with
210ABSOLUTELY NO WARRANTY and may be copied only under the terms of
211the GNU General Public License, which may be found in the MHArc
212distribution.
213
214=cut
215