1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
##############################################################################
# The Faq-O-Matic is Copyright 1997 by Jon Howell, all rights reserved. #
# #
# 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.#
# #
# Jon Howell can be contacted at: #
# 6211 Sudikoff Lab, Dartmouth College #
# Hanover, NH 03755-3510 #
# jonh@cs.dartmouth.edu #
# #
# An electronic copy of the GPL is available at: #
# http://www.gnu.org/copyleft/gpl.html #
# #
##############################################################################
use strict;
###
### dispatch.pm
###
### This is the dispatch module; it calls one of the command modules. (Each
### command module used to be a separate CGI, but this makes installation
### a lot easer.) A nearly-empty CGI calls this file, which parses the
### parameters to decide which module to load and run.
package FAQ::OMatic::dispatch;
#use FAQ::OMatic;
# --the fewer pieces we statically include, the more likely we can
# dynamically catch any compile errors and display them gracefully
# instead of giving an Infernal Server Error.
use vars qw($meta $cgi); # to avoid mod_perl 'my' problem. But callers
# should access these using the corresponding accessor methods,
# not by accessing them directly.
sub main {
$meta = shift; # The single adjustable parameter in the actual CGI
my $haveMeta=0;
# it's not so important what this path is (though a good selection
# will help the install cmd make better suggestions for the mail and
# RCS commands), but that we set it so it's not tainted.
$ENV{'PATH'} = '/bin:/usr/bin:/usr/sbin:/usr/local/bin';
if (-f "$meta/config") {
# note config file is not subject to 'use strict,' since it is
# inside its own file.
delete $INC{"$meta/config"}; # cause mod_perl to re-read config
# TODO: this doesn't really work. mod_perl doesn't reread.
# TODO: Jon needs to re-read mod_perl's docs.
require "$meta/config";
if ($meta eq ($FAQ::OMatic::Config::metaDir||'')) {
$haveMeta = 1;
} else {
print "Content-type: text/plain\n\n";
print "meta moved. I can't deal with this case automatically.\n";
print "You'll need to manually change your CGI stub to point\n";
print "at the new location of meta, plus fix \$metaDir in\n";
print "meta/config to match.\n";
# This is a pretty uncommon case -- I think we can cope
# with killing off a mod_perl child process if this happens.
# (It beats trying to load FAQ::OMatic::myExit().)
exit 0;
}
} else {
# if unconfigured, the default behavior is to install.
# This could be bad -- it means if meta/config becomes inaccessible,
# the Internet can install a new faqomatic on your machine. Hmmm.
$haveMeta = 0;
}
# The map trick is a way to make a hash act like a "set" -- we use it
# to test membership. This is the set of modules we know (prevents
# the user from making up some other module and getting it into
# our eval()).
my %knownModules = map { $_ => $_ } (
'faq', 'help', 'appearanceForm',
'search', 'searchForm', 'recent',
'recentrdf',
'stats', 'statgraph',
'authenticate', 'changePass', 'submitPass',
'editPart', 'submitPart', 'delPart',
'addItem', 'editItem', 'submitItem',
'editModOptions', 'submitModOptions',
'submitCatToAns', 'submitAnsToCat',
'moveItem', 'submitMove',
'selectBag', 'editBag', 'submitBag',
'install', 'maintenance',
'editGroups', 'submitGroup',
'img', 'mirrorServer', 'displaySlow'
);
# functions that we need to run even if the versions mismatch.
# not sure every maintenance task can be run when there's
# a mismatch, but some need to, since they're accessed from
# the installer. Can add another version check in maintenance.pm
# if I need to later, I guess.
my %versionSafeFunc = map { $_ => $_ } (
'install', 'img',
'authenticate', 'maintenance',
'displaySlow', 'changePass',
'submitPass'
);
use CGI;
$cgi = new CGI;
my $cmd = ($haveMeta)
? ($cgi->param('cmd') || 'faq')
: 'install';
my $problemDesc = '';
my $severity = 'problem';
my $func;
# notice we take the value of the hash lookup, rather than just
# testing it -- that handily untaints $func.
if ($func = $knownModules{$cmd}) {
# Require means we don't load the module until we need it.
# (But mod_perl will accumulate modules, and only load them
# if they haven't been loaded before, of course.)
# This invocation will call the $func module's main()
# from here inside, catch warnings as errors.
local $SIG{'__WARN__'} = sub { die $_[0] };
eval {
require FAQ::OMatic;
FAQ::OMatic::reset(); # reset the locals (for mod_perl)
require "FAQ/OMatic/$func.pm";
# require comes before VERSION test because VERSION test
# depends on having included FAQ::OMatic.
if (($FAQ::OMatic::Config::version || '') ne $FAQ::OMatic::VERSION
and not $versionSafeFunc{$func}) {
FAQ::OMatic::gripe('abort', "The scripts don't match the "
."configured version number. Admin must run "
.FAQ::OMatic::makeAref('-command'=>'install')
."installer</a>. "
."This message has been sent to "
."$FAQ::OMatic::Config::adminEmail.", {'noentify'=>1});
}
$^T = time(); # when running in mod_perl, -M's get stale w/o this
eval "FAQ::OMatic::".$func."::main();";
die $@ if ($@); # pass internal errors out to next eval
};
$problemDesc = $@;
$severity = 'problem';
} else {
# THANKS to Bob Van Cleef <vancleef@microunit.com>
# and <superpetz@hushmail.com> for pointing out a
# cross-site scripting problem with this error report.
# I wonder how many other such helpful debugging features
# hide lurking CSS issues?
#
# Unknown commands seem to come from either broken robots
# or 3L33T H@X0RZ, so let's not bother sending mail to
# the admin about it.
# If you see errors in your log that you wonder about,
# then add the $cmd to the problemDesc to find out
# what's going on.
$problemDesc = 'Unknown command. Are you a confused robot or an 3l33t h@X0r? If neither, check with site admin to debug the problem.';
$severity = 'error';
}
if ($problemDesc ne '') {
# something broken happened. Let the admin know,
# lest it was a script that failed to compile, or a
# 'use strict' message or -w warning.
# try a nice presentation, else fall back on text:
# (unfortunately, text errors don't get mailed to $faqAdmin.)
eval {
$SIG{'__WARN__'} = sub { die "x"; }; # warnings => something's amok
require FAQ::OMatic;
FAQ::OMatic::gripe($severity,
"${severity}: ${problemDesc}");
# don't use 'abort', because in mod_perl that calls
# Apache::exit(), which looks like a die, which makes us
# think this eval failed.
# Squirt out the message:
print FAQ::OMatic::pageHeader();
print FAQ::OMatic::pageFooter();
};
if ($@) {
# can't use FAQ::OMatic::header() here because FAQ::OMatic
# isn't imported here.
print $cgi->header('-type'=>"text/html");
print "<tt>\n$problemDesc\n</tt><br><font color=blue>"
.($@ ne '')."</font>\n";
}
}
}
sub meta {
return $meta;
}
sub cgi {
return $cgi;
}
1;
|
