-
Notifications
You must be signed in to change notification settings - Fork 8
/
Apache.pm
452 lines (379 loc) · 13.1 KB
/
Apache.pm
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
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2003 by Open Source Development Network. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id$
package Slash::Apache;
use strict;
use Apache;
use Apache::SIG ();
use Apache::ModuleConfig;
use Apache::Constants qw(:common);
use Slash::DB;
use Slash::Display;
use Slash::Utility;
use URI;
require DynaLoader;
require AutoLoader;
use vars qw($REVISION $VERSION @ISA $USER_MATCH);
@ISA = qw(DynaLoader);
$VERSION = '2.003000'; # v2.3.0
($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
$USER_MATCH = qr{ \buser=(?! # must have user, but NOT ...
(?: nobody | %[20]0 )? # nobody or space or null or nothing ...
(?: \s | ; | $ ) # followed by whitespace, ;, or EOS
)}x;
bootstrap Slash::Apache $VERSION;
# BENDER: There's nothing wrong with murder, just as long
# as you let Bender whet his beak.
sub SlashVirtualUser ($$$) {
my($cfg, $params, $user) = @_;
# In case someone calls SlashSetVar before we have done the big mojo -Brian
my $overrides = $cfg->{constants};
createCurrentVirtualUser($cfg->{VirtualUser} = $user);
createCurrentDB ($cfg->{slashdb} = Slash::DB->new($user));
createCurrentStatic ($cfg->{constants} = $cfg->{slashdb}->getSlashConf());
$cfg->{constants}{section} = 'index'; # This is in here till I finish up some work -Brian
# placeholders ... store extra placeholders in DB? :)
for (qw[user form themes template cookie objects cache site_constants]) {
$cfg->{$_} = '';
}
$cfg->{constants}{form_override} ||= {};
# This has to be a hash
$cfg->{site_constants} = {};
if ($overrides) {
@{$cfg->{constants}}{keys %$overrides} = values %$overrides;
}
my $anonymous_coward = $cfg->{slashdb}->getUser(
$cfg->{constants}{anonymous_coward_uid}
);
# Let's just do this once
setUserDate($anonymous_coward);
createCurrentAnonymousCoward($cfg->{anonymous_coward} = $anonymous_coward);
createCurrentUser($anonymous_coward);
$cfg->{menus} = $cfg->{slashdb}->getMenus();
my $sections = $cfg->{slashdb}->getSections();
for (values %$sections) {
if ($_->{hostname} && $_->{url}) {
my $new_cfg;
for (keys %{$cfg->{constants}}) {
$new_cfg->{$_} = $cfg->{constants}{$_}
unless $_ eq 'form_override';
}
# Must not just copy the form_override info
$new_cfg->{form_override} = {};
$new_cfg->{absolutedir} = $_->{url};
$new_cfg->{rootdir} = set_rootdir($_->{url}, $cfg->{constants}{rootdir});
$new_cfg->{cookiedomain} = $_->{cookiedomain} if $_->{cookiedomain};
$new_cfg->{defaultsubsection} = $_->{defaultsubsection} if $_->{defaultsubsection};
$new_cfg->{defaulttopic} = $_->{defaulttopic} if $_->{defaulttopic};
$new_cfg->{defaultdisplaystatus} = $_->{defaultdisplaystatus} if $_->{defaultdisplaystatus};
$new_cfg->{defaultcommentstatus} = $_->{defaultcommentstatus} if $_->{defaultcommentstatus};
$new_cfg->{defaultsection} = $_->{defaultsection} || $_->{section};
$new_cfg->{section} = $_->{section};
$new_cfg->{basedomain} = $_->{hostname};
$new_cfg->{static_section} = $_->{section};
$new_cfg->{index_handler} = $_->{index_handler};
# Should no longer be needed -Brian
#$new_cfg->{form_override}{section} = $_->{section};
$cfg->{site_constants}{$_->{hostname}} = $new_cfg;
}
}
# If this is not here this will go poorly.
$cfg->{slashdb}->{_dbh}->disconnect;
}
sub SlashSetVar ($$$$) {
my($cfg, $params, $key, $value) = @_;
unless ($cfg->{constants}) {
print STDERR "SlashSetVar must be called after call SlashVirtualUser \n";
exit(1);
}
$cfg->{constants}{$key} = $value;
}
sub SlashSetForm ($$$$) {
my($cfg, $params, $key, $value) = @_;
unless ($cfg->{constants}) {
print STDERR "SlashSetForm must be called after call SlashVirtualUser \n";
exit(1);
}
$cfg->{constants}{form_override}{$key} = $value;
}
sub SlashSetVarHost ($$$$$) {
my($cfg, $params, $key, $value, $hostname) = @_;
unless ($cfg->{constants}) {
print STDERR "SlashSetVarHost must be called after call SlashVirtualUser \n";
exit(1);
}
my $new_cfg;
for (keys %{$cfg->{constants}}) {
$new_cfg->{$_} = $cfg->{constants}{$_}
unless $_ eq 'form_override';
}
$new_cfg->{$key} = $value;
$cfg->{site_constants}{$hostname} = $new_cfg;
}
sub SlashSetFormHost ($$$$$) {
my($cfg, $params, $key, $value, $hostname) = @_;
unless ($cfg->{constants}) {
print STDERR "SlashSetFormHost must be called after call SlashVirtualUser \n";
exit(1);
}
my $new_cfg;
for (keys %{$cfg->{constants}}) {
$new_cfg->{$_} = $cfg->{constants}{$_}
unless $_ eq 'form_override';
}
$new_cfg->{form_override}{$key} = $value;
$cfg->{site_constants}{$hostname} = $new_cfg;
}
sub SlashSectionHost ($$$$) {
my($cfg, $params, $section, $url) = @_;
my $hostname = $url;
$hostname =~ s/.*\/\///;
unless ($cfg->{constants}) {
print STDERR "SlashSectionHost must be called after call SlashVirtualUser \n";
exit(1);
}
# Yes, this looks slower then the other method but I was getting different results.
# Bad results, and it's Friday. Bad results on Friday is a bad thing.
# -Brian
my $new_cfg;
for (keys %{$cfg->{constants}}) {
$new_cfg->{$_} = $cfg->{constants}{$_}
unless $_ eq 'form_override';
}
# Must not just copy the form_override info
$new_cfg->{form_override} = {};
$new_cfg->{absolutedir} = $url;
$new_cfg->{rootdir} = set_rootdir($url, $cfg->{constants}{rootdir});
$new_cfg->{basedomain} = $hostname;
$new_cfg->{defaultsection} = $section;
$new_cfg->{static_section} = $section;
# Should no longer be needed -Brian
#$new_cfg->{form_override}{section} = $section;
$cfg->{site_constants}{$hostname} = $new_cfg;
}
sub SlashCompileTemplates ($$$) {
my($cfg, $params, $flag) = @_;
return unless $flag;
# set up defaults
my $slashdb = $cfg->{slashdb};
my $constants = $cfg->{constants};
# caching must be on, along with unlimited cache size
return unless $constants->{cache_enabled}
&& !$constants->{template_cache_size};
print STDERR "$cfg->{VirtualUser} ($$): Compiling All Templates Begin\n";
my $templates = $slashdb->getTemplateNameCache();
# temporarily turn off warnings and errors, see errorLog()
# This is normally considered a big no no inside of Apache
# since how will its own signal handlers be put back in place?
# -Brian
# what do you mean, put back in place? when the function
# finishes, they are all automatically reverted, because
# of local() -- pudge
local $Slash::Utility::NO_ERROR_LOG = 1;
local $SIG{__WARN__} = 'IGNORE';
local $slashdb->{_dbh}{PrintError};
# this will call every template in turn, and it will
# then be compiled; now, we will get errors in
# the error log for templates that don't check
# the input values; that can't easily be helped
for my $t (keys %$templates) {
my($name, $page, $section) = split /$;/, $t;
slashDisplay($name, 0, {
Page => $page,
Section => $section,
Return => 1,
Nocomm => 1
});
}
print STDERR "$cfg->{VirtualUser} ($$): Compiling All Templates Done\n";
$cfg->{template} = Slash::Display::get_template(0, 0, 1);
# let's make sure
$slashdb->{_dbh}->disconnect;
}
# This can be used in conjunction with mod_proxy_add_forward or somesuch,
# if you use a frontend/backend Apache setup, where all requests come
# from 127.0.0.1 or some other predictable IP number(s). For speed, we
# use a closure to store the regex that matches incoming IP number.
{
my $trusted_ip_regex = undef;
sub ProxyRemoteAddr ($) {
my($r) = @_;
if (!defined($trusted_ip_regex)) {
$trusted_ip_regex = getCurrentStatic("x_forwarded_for_trust_regex");
if ($trusted_ip_regex) {
# Avoid a little processing each time by doing
# the regex parsing just once.
$trusted_ip_regex = qr{$trusted_ip_regex};
} elsif (!defined($trusted_ip_regex)) {
# If not defined, use localhost.
$trusted_ip_regex = qr{^127\.0\.0\.1$};
} else {
# If defined but false, disable.
$trusted_ip_regex = '0';
}
}
return OK if $trusted_ip_regex eq '0';
# Since any client can forge X-Forwarded-For, we ignore it...
return OK unless $r->connection->remote_ip =~ $trusted_ip_regex;
# ...unless the connection comes from a trusted source.
if (my($ip) = $r->header_in('X-Forwarded-For') =~ /([^,\s]+)$/) {
$r->connection->remote_ip($ip);
}
return OK;
}
}
sub ConnectionIsSSL {
# If the connection is made over an SSL connection, it's secure.
# %ENV won't contain all its fields this early in mod_perl but
# it's quick to check just in case.
return 1 if $ENV{SSL_SESSION_ID};
# That probably didn't work so let's get that data the hard way.
my $r = Apache->request;
my $subr = $r->lookup_uri($r->uri);
my $https_on = ($subr && $subr->subprocess_env('HTTPS') eq 'on')
? 1 : 0;
return 1 if $https_on;
return 1
if $r->header_in('X-SSL-On') eq 'yes';
# Nope, it's not SSL. We're out of ideas, if the above didn't
# work we must not be on SSL.
return 0;
}
sub ConnectionIsSecure {
return 1 if ConnectionIsSSL;
# If the connection comes from a local IP or a network deemed
# secure by the admin, it's secure. (The too-clever-by-half
# way of doing this would be to check this machine's routing
# tables. Instead we have the admins set a regex in a var.)
my $r = Apache->request;
my $ip = $r->connection->remote_ip;
my $constants = getCurrentStatic();
my $secure_ip_regex = $constants->{admin_secure_ip_regex};
# Check the IP against the regex. Assume we don't need to wrap
# this in an "eval" -- it might break, but whoever set it should
# know what they're doing. Since this isn't s/// there's no
# chance of evaluating it, so this is not exploitable to gain
# security or damage the site (beyond causing errors for every
# click) even if it were compromised.
return 1 if $secure_ip_regex && $ip =~ /$secure_ip_regex/;
# Non-SSL connection, from a network not known to be secure.
# Call it insecure.
return 0;
}
sub IndexHandler {
my($r) = @_;
return DECLINED unless $r->is_main;
my $constants = getCurrentStatic();
my $uri = $r->uri;
if ($constants->{rootdir}) {
my $path = URI->new($constants->{rootdir})->path;
$uri =~ s/^\Q$path//;
}
# Comment this in if you want to try having this do the right
# thing dynamically
# my $slashdb = getCurrentDB();
# my $dbon = $slashdb->sqlConnect();
my $dbon = ! -e "$constants->{datadir}/dboff";
if ($uri eq '/') {
my $basedir = $constants->{basedir};
# $USER_MATCH defined above
if ($dbon && $r->header_in('Cookie') =~ $USER_MATCH) {
$r->uri("/$constants->{index_handler}");
$r->filename("$basedir/$constants->{index_handler}");
return OK;
} else {
# consider using File::Basename::basename() here
# for more robustness, if it ever matters -- pudge
my($base) = split(/\./, $constants->{index_handler});
$base = $constants->{index_handler_noanon}
if $constants->{index_noanon};
if ($constants->{static_section}) {
$r->filename("$basedir/$constants->{static_section}/$base.shtml");
$r->uri("/$constants->{static_section}/$base.shtml");
} else {
$r->filename("$basedir/$base.shtml");
$r->uri("/$base.shtml");
}
writeLog('shtml');
return OK;
}
}
# match /section/ or /section
if ($uri =~ m|^/(\w+)/?$|) {
my $key = $1;
my $slashdb = getCurrentDB();
my $section = $slashdb->getSection($key);
my $index_handler = $section->{index_handler}
|| $constants->{index_handler};
if ($section && $section->{id} && $index_handler ne 'IGNORE') {
my $basedir = $constants->{basedir};
# $USER_MATCH defined above
if ($dbon && $r->header_in('Cookie') =~ $USER_MATCH) {
$r->args("section=$key");
$r->uri("/$index_handler");
$r->filename("$basedir/$index_handler");
return OK;
} else {
# consider using File::Basename::basename() here
# for more robustness, if it ever matters -- pudge
my($base) = split(/\./, $index_handler);
$r->uri("/$key/$base.shtml");
$r->filename("$basedir/$key/$base.shtml");
writeLog('shtml');
return OK;
}
}
}
if ($uri eq '/authors.pl') {
my $filename = $r->filename;
my $basedir = $constants->{basedir};
if (!$dbon || $r->header_in('Cookie') !~ $USER_MATCH) {
$r->uri('/authors.shtml');
$r->filename("$basedir/authors.shtml");
writeLog('shtml');
return OK;
}
}
if ($uri eq '/hof.pl') {
my $basedir = $constants->{basedir};
$r->uri('/hof.shtml');
$r->filename("$basedir/hof.shtml");
writeLog('shtml');
return OK;
}
# The vote is still out on whether I will do this or not -Brian
# if ($uri =~ /^\/\d\d\/\d\d\/\d\d\/\d*\.shtml/) {
# my $basedir = $constants->{basedir};
# my ($realfile) = split /\?/, $uri;
# my $section = $constants->{defaultsection};
# print STDERR "DEFAULT $section\n";
#
# $r->uri("/$section/$realfile");
# $r->filename("$basedir/$section/$realfile");
# writeLog('shtml');
# return OK;
# }
if (!$dbon && $uri !~ /\.shtml/) {
my $basedir = $constants->{basedir};
$r->uri('/index.shtml');
$r->filename("$basedir/index.shtml");
writeLog('shtml');
$r->notes('SLASH_FAILURE' => "db"); # You should be able to find this in other processes
return OK;
}
return DECLINED;
}
sub DESTROY { }
1;
__END__
=head1 NAME
Slash::Apache - Apache Specific handler for Slash
=head1 SYNOPSIS
use Slash::Apache;
=head1 DESCRIPTION
This is what creates the SlashVirtualUser command for us
in the httpd.conf file.
=head1 SEE ALSO
Slash(3).
=cut