cvs commit: modperl/lib/Apache test.pm
dougm 00/09/28 14:16:15
Modified:.Changes ToDo
lib/Apache test.pm
Log:
Apache::test enhancements
Revision ChangesPath
1.539 +3 -0 modperl/Changes
Index: Changes
===
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.538
retrieving revision 1.539
diff -u -r1.538 -r1.539
--- Changes 2000/09/28 21:00:43 1.538
+++ Changes 2000/09/28 21:16:07 1.539
@@ -10,6 +10,9 @@
=item 1.24_01-dev
+Apache::test enhancements
+[Ken Williams <[EMAIL PROTECTED]>]
+
fix Apache::exit() so it does it does not trigger a warning (maybe)
change Apache::PerlRun's Apache class relationship from is-a to has-a
1.262 +0 -2 modperl/ToDo
Index: ToDo
===
RCS file: /home/cvs/modperl/ToDo,v
retrieving revision 1.261
retrieving revision 1.262
diff -u -r1.261 -r1.262
--- ToDo 2000/09/28 19:59:25 1.261
+++ ToDo 2000/09/28 21:16:07 1.262
@@ -40,8 +40,6 @@
- replace Apache::StatINC with Apache::ModuleReload?
-- ken w's Apache::test patch
-
- CHECK blocks? [Michael J Schout <[EMAIL PROTECTED]>]
- see if possible to have the dso libperl.so be named something else,
1.17 +304 -17 modperl/lib/Apache/test.pm
Index: test.pm
===
RCS file: /home/cvs/modperl/lib/Apache/test.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- test.pm 2000/03/06 20:38:22 1.16
+++ test.pm 2000/09/28 21:16:13 1.17
@@ -44,6 +44,156 @@
*Apache::Constants::bootstrap = sub {};
}
+sub write_httpd_conf {
+my $pkg = shift;
+my %args = (conf_file => 't/httpd.conf', @_);
+my $DIR = `pwd`; chomp $DIR;
+
+local *CONF;
+open CONF, ">$args{conf_file}" or die "Can't create $args{conf_file}: $!";
+print CONF <);
+ $response ||= $default;
+} until (!$mustfind || (-e $response || !print("$response not found\n")));
+
+return $response;
+}
+
+sub get_test_params {
+my $pkg = shift;
+
+print("\nFor testing purposes, please give the full path to an httpd\n",
+ "with mod_perl enabled. The path defaults to \$ENV{APACHE}, if present.");
+
+my %conf;
+
+my $httpd = $ENV{'APACHE'} || which('apache') || which('httpd') ||
'/usr/lib/httpd/httpd';
+
+$httpd = _ask("\n", $httpd, 1);
+system "$Config{lns} $httpd t/httpd";
+
+if (lc _ask("Search existing config file for dynamic module dependencies?",
'n') eq 'y') {
+ my %compiled;
+ for (`t/httpd -V`) {
+ if (/([\w]+)="(.*)"/) {
+ $compiled{$1} = $2;
+ }
+ }
+ $compiled{SERVER_CONFIG_FILE} =~ s,^,$compiled{HTTPD_ROOT}/,
+ unless $compiled{SERVER_CONFIG_FILE} =~ m,^/,;
+
+ my $file = _ask(" Config file", $compiled{SERVER_CONFIG_FILE}, 1);
+ $conf{modules} = $pkg->_read_existing_conf($file);
+}
+
+# Get default user (apache doesn't like to run as root, special-case it)
+my $defuser = ($< && getpwuid $<) || 'nobody';
+$conf{user} = _ask("User to run tests under", $defuser);
+
+my $defgroup = ($defuser eq 'nobody' ? 'nobody' : getgrgid((getpwnam
$conf{user})[3]));
+$conf{group} = _ask("Group to run tests under", $defgroup);
+
+$conf{port} = _ask("Port to run tests under", 8228);
+
+return %conf;
+}
+
+sub _read_existing_conf {
+# Returns some config text
+shift;
+my ($server_conf) = @_;
+
+
+open SERVER_CONF, $server_conf or die "Couldn't open $server_conf: $!";
+my @lines = grep {!m/^\s*#/} ;
+close SERVER_CONF;
+
+my @modules = grep /^\s*(Add|Load)Module/, @lines;
+my ($server_root) = (map /^\s*ServerRoot\s*(\S+)/, @lines);
+
+# Rewrite all modules to load from an absolute path.
+foreach (@modules) {
+ s!(\s)([^/\s]\S+/)!$1$server_root/$2!;
+}
+
+# Directories where apache DSOs live.
+my (@module_dirs) = map {m,(/\S*/),} @modules;
+
+# Have to make sure that dir, autoindex and perl are loaded.
+my @required = qw(dir autoindex perl);
+
+my @l = `t/httpd -l`;
+my @compiled_in = map /^\s*(\S+)/, @l[1..@l-2];
+
+my @load;
+foreach my $module (@required) {
+ if (!grep /$module/i, @compiled_in, @modules) {
+ push @load, $module;
+ }
+}
+
+# Finally compute the directives to load modules that need to be loaded.
+ MODULE:
+foreach my $module (@load) {
+ foreach my $module_dir (@module_dirs) {
+ if (-e "$module_dir/mod_$module.so") {
+ push @modules, "
cvs commit: modperl/src/modules/perl perl_util.c
dougm 00/09/28 14:00:49
Modified:.Changes
src/modules/perl perl_util.c
Log:
fix Apache::exit() so it does it does not trigger a warning (maybe)
Revision ChangesPath
1.538 +2 -0 modperl/Changes
Index: Changes
===
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.537
retrieving revision 1.538
diff -u -r1.537 -r1.538
--- Changes 2000/09/28 19:59:23 1.537
+++ Changes 2000/09/28 21:00:43 1.538
@@ -10,6 +10,8 @@
=item 1.24_01-dev
+fix Apache::exit() so it does it does not trigger a warning (maybe)
+
change Apache::PerlRun's Apache class relationship from is-a to has-a
[Ken Williams <[EMAIL PROTECTED]>]
1.42 +1 -1 modperl/src/modules/perl/perl_util.c
Index: perl_util.c
===
RCS file: /home/cvs/modperl/src/modules/perl/perl_util.c,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- perl_util.c 2000/08/15 19:36:34 1.41
+++ perl_util.c 2000/09/28 21:00:47 1.42
@@ -424,7 +424,7 @@
static I32
errgv_empty_set(IV ix, SV* sv)
{
-sv_setpv(sv, "");
+sv_setsv(sv, &sv_no);
return TRUE;
}
cvs commit: modperl/lib/Apache PerlRun.pm RegistryBB.pm RegistryNG.pm
dougm 00/09/28 12:59:47
Modified:.Changes ToDo
lib/Apache PerlRun.pm RegistryBB.pm RegistryNG.pm
Log:
change Apache::PerlRun's Apache class relationship from is-a to has-a
Revision ChangesPath
1.537 +3 -0 modperl/Changes
Index: Changes
===
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.536
retrieving revision 1.537
diff -u -r1.536 -r1.537
--- Changes 2000/09/28 19:28:27 1.536
+++ Changes 2000/09/28 19:59:23 1.537
@@ -10,6 +10,9 @@
=item 1.24_01-dev
+change Apache::PerlRun's Apache class relationship from is-a to has-a
+[Ken Williams <[EMAIL PROTECTED]>]
+
Apache::SubRequest->run(1) allows ap_send_http_headers() to output for
subrequests
1.261 +3 -3 modperl/ToDo
Index: ToDo
===
RCS file: /home/cvs/modperl/ToDo,v
retrieving revision 1.260
retrieving revision 1.261
diff -u -r1.260 -r1.261
--- ToDo 2000/09/28 19:28:28 1.260
+++ ToDo 2000/09/28 19:59:25 1.261
@@ -40,9 +40,6 @@
- replace Apache::StatINC with Apache::ModuleReload?
-- ken w's Apache::PerlRun patch to change Apache class relationship
- from is-a to has-a
-
- ken w's Apache::test patch
- CHECK blocks? [Michael J Schout <[EMAIL PROTECTED]>]
@@ -118,6 +115,9 @@
---
MISC BUGS
---
+
+- Apache->request($r) digs the request_rec out of $r regardless of the
+ type/class, e.g. Apache->request(bless {r => $r}, 'My::Apache')
- $r->finfo problem with HTML::Mason::ApacheHandler
[Shane Adams <[EMAIL PROTECTED]>]
1.31 +30 -37modperl/lib/Apache/PerlRun.pm
Index: PerlRun.pm
===
RCS file: /home/cvs/modperl/lib/Apache/PerlRun.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- PerlRun.pm2000/09/28 16:35:52 1.30
+++ PerlRun.pm2000/09/28 19:59:36 1.31
@@ -19,32 +19,22 @@
$Debug ||= 0;
my $Is_Win32 = $^O eq "MSWin32";
-@Apache::PerlRun::ISA = qw(Apache);
-
sub new {
my($class, $r) = @_;
-return $r unless ref($r) eq "Apache";
-if(ref $r) {
- $r->request($r);
-}
-else {
- $r = Apache->request;
-}
my $filename = $r->filename;
$r->warn("Apache::PerlRun->new for $filename in process $$")
if $Debug && $Debug & 4;
-bless {
- '_r' => $r,
-}, $class;
+return bless {r=>$r}, $class;
}
sub can_compile {
my($pr) = @_;
-my $filename = $pr->filename;
-if (-r $filename && -s _) {
- if (!($pr->allow_options & OPT_EXECCGI)) {
- $pr->log_reason("Options ExecCGI is off in this directory",
+my $r = $pr->{r};
+my $filename = $r->filename;
+if (-r $r->finfo && -s _) {
+ if (!($r->allow_options & OPT_EXECCGI)) {
+ $r->log_reason("Options ExecCGI is off in this directory",
$filename);
return FORBIDDEN;
}
@@ -52,7 +42,7 @@
return DECLINED;
}
unless (-x _ or $Is_Win32) {
- $pr->log_reason("file permissions deny server execution",
+ $r->log_reason("file permissions deny server execution",
$filename);
return FORBIDDEN;
}
@@ -65,8 +55,7 @@
}
sub mark_line {
-my($pr) = @_;
-my $filename = $pr->filename;
+my $filename = shift->{r}->filename;
return $Apache::Registry::MarkLine ?
"\n#line 1 $filename\n" : "";
}
@@ -115,26 +104,28 @@
sub compile {
my($pr, $eval) = @_;
$eval ||= $pr->{'sub'};
-$pr->clear_rgy_endav;
-$pr->log_error("Apache::PerlRun->compile") if $Debug && $Debug & 4;
+my $r = $pr->{r};
+$r->clear_rgy_endav;
+$r->log_error("Apache::PerlRun->compile") if $Debug && $Debug & 4;
Apache->untaint($$eval);
{
no strict; #so eval'd code doesn't inherit our bits
eval $$eval;
}
-$pr->stash_rgy_endav;
+$r->stash_rgy_endav;
return $pr->error_check;
}
sub run {
my $pr = shift;
my $package = $pr->{'namespace'};
+my $r = $pr->{r};
my $rc = OK;
my $cv = \&{"$package\::handler"};
my $oldwarn = $^W;
-eval { $rc = &{$cv}($pr, @_) } if $pr->seqno;
+eval { $rc = &{$cv}($r, @_) } if $r->seqno;
$pr->{status} = $rc;
$^W = $oldwarn;
@@ -142,11 +133,11 @@
if($@) {
$errsv = $@;
$@ = ''; #XXX fix me, if we don't do this Apache::exit() breaks
- $@{$pr
cvs commit: modperl/src/modules/perl Apache.xs
dougm 00/09/28 12:28:39
Modified:.Changes ToDo
src/modules/perl Apache.xs
Log:
Apache::SubRequest->run(1) allows ap_send_http_headers() to output for
subrequests
Revision ChangesPath
1.536 +3 -0 modperl/Changes
Index: Changes
===
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.535
retrieving revision 1.536
diff -u -r1.535 -r1.536
--- Changes 2000/09/28 17:46:58 1.535
+++ Changes 2000/09/28 19:28:27 1.536
@@ -10,6 +10,9 @@
=item 1.24_01-dev
+Apache::SubRequest->run(1) allows ap_send_http_headers() to output for
+subrequests
+
Apache::{Registry,PerlRun} will now log an error if $filename is NOT_FOUND
thanks to Martin Wood for the spot
1.260 +1 -4 modperl/ToDo
Index: ToDo
===
RCS file: /home/cvs/modperl/ToDo,v
retrieving revision 1.259
retrieving revision 1.260
diff -u -r1.259 -r1.260
--- ToDo 2000/09/28 15:18:59 1.259
+++ ToDo 2000/09/28 19:28:28 1.260
@@ -27,12 +27,9 @@
- add Filter::Call support to Apache::RegistryNG (or subclass of)
-- Perl{Eval,Do} directives [Salvador Ortiz Garcia <[EMAIL PROTECTED]>]
+- PerlEval directive [Salvador Ortiz Garcia <[EMAIL PROTECTED]>]
- add srand stuff ?
-
-- Apache::SubRequest->run(1) allows ap_send_http_headers() to output
- for subrequests
- allow $r->server->uid($new_uid) ?
[Rob Giseburt <[EMAIL PROTECTED]>]
1.114 +6 -1 modperl/src/modules/perl/Apache.xs
Index: Apache.xs
===
RCS file: /home/cvs/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -r1.113 -r1.114
--- Apache.xs 2000/09/28 17:46:59 1.113
+++ Apache.xs 2000/09/28 19:28:33 1.114
@@ -2027,10 +2027,15 @@
"Apache::SubRequest::DESTROY(0x%lx)\n", (unsigned long)r));
int
-run(r)
+run(r, allow_send_header=0)
Apache::SubRequest r
+int allow_send_header
CODE:
+if (allow_send_header) {
+r->assbackwards = 0;
+}
+
RETVAL = run_sub_req(r);
OUTPUT:
cvs commit: modperl/src/modules/perl Apache.xs
dougm 00/09/28 10:46:59
Modified:.Changes
src/modules/perl Apache.xs
Log:
default AuthType to Basic for note_basic_auth_failure
Revision ChangesPath
1.535 +2 -2 modperl/Changes
Index: Changes
===
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.534
retrieving revision 1.535
diff -u -r1.534 -r1.535
--- Changes 2000/09/28 16:35:50 1.534
+++ Changes 2000/09/28 17:46:58 1.535
@@ -22,8 +22,8 @@
fix %Apache::ReadConfig:: processing for PerlRequire'd files
[Salvador Ortiz Garcia <[EMAIL PROTECTED]>]
-$r->get_basic_auth_pw will default $r->auth_type to "Basic" if not
-already set
+$r->get_basic_auth_pw and $r->note_basic_auth_failure will default
+$r->auth_type to "Basic" if not already set
$r->auth_type is now writeable, e.g. $r->auth_type("Basic")
1.113 +10 -3 modperl/src/modules/perl/Apache.xs
Index: Apache.xs
===
RCS file: /home/cvs/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -r1.112 -r1.113
--- Apache.xs 2000/09/28 16:19:56 1.112
+++ Apache.xs 2000/09/28 17:46:59 1.113
@@ -359,6 +359,11 @@
r->connection->client->flags & B_EOUT);
}
+#define check_auth_type(r) \
+if (!auth_type(r)) { \
+(void)mod_perl_auth_type(r, "Basic"); \
+}
+
MODULE = Apache PACKAGE = Apache PREFIX = mod_perl_
PROTOTYPES: DISABLE
@@ -879,6 +884,10 @@
note_basic_auth_failure(r)
Apache r
+CODE:
+check_auth_type(r);
+note_basic_auth_failure(r);
+
void
get_basic_auth_pw(r)
Apache r
@@ -888,9 +897,7 @@
int ret;
PPCODE:
-if (!auth_type(r)) {
-(void)mod_perl_auth_type(r, "Basic");
-}
+check_auth_type(r);
ret = get_basic_auth_pw(r, &sent_pw);
XPUSHs(sv_2mortal((SV*)newSViv(ret)));
if(ret == OK)
cvs commit: modperl/lib/Apache PerlRun.pm Registry.pm
dougm 00/09/28 09:35:54
Modified:.Changes
lib/Apache PerlRun.pm Registry.pm
Log:
Apache::{Registry,PerlRun} will now log an error if $filename is NOT_FOUND
Revision ChangesPath
1.534 +3 -0 modperl/Changes
Index: Changes
===
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.533
retrieving revision 1.534
diff -u -r1.533 -r1.534
--- Changes 2000/09/28 16:19:52 1.533
+++ Changes 2000/09/28 16:35:50 1.534
@@ -10,6 +10,9 @@
=item 1.24_01-dev
+Apache::{Registry,PerlRun} will now log an error if $filename is NOT_FOUND
+thanks to Martin Wood for the spot
+
fix bug where Apache::send_http_header was resetting r->status = 200
thanks to brian d foy for the spot
1.30 +1 -0 modperl/lib/Apache/PerlRun.pm
Index: PerlRun.pm
===
RCS file: /home/cvs/modperl/lib/Apache/PerlRun.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- PerlRun.pm2000/06/01 21:07:56 1.29
+++ PerlRun.pm2000/09/28 16:35:52 1.30
@@ -60,6 +60,7 @@
$pr->{'mtime'} = -M _;
return wantarray ? (OK, $pr->{'mtime'}) : OK;
}
+$pr->log_error("$filename not found or unable to stat");
return NOT_FOUND;
}
1.33 +1 -0 modperl/lib/Apache/Registry.pm
Index: Registry.pm
===
RCS file: /home/cvs/modperl/lib/Apache/Registry.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- Registry.pm 2000/08/02 15:53:15 1.32
+++ Registry.pm 2000/09/28 16:35:53 1.33
@@ -165,6 +165,7 @@
#}
return $r->status($old_status);
} else {
+$r->log_error("$filename not found or unable to stat");
return NOT_FOUND unless $Debug && $Debug & 2;
return Apache::Debug::dump($r, NOT_FOUND);
}
cvs commit: modperl/Apache Apache.pm
dougm 00/09/28 09:19:59
Modified:.Changes
src/modules/perl Apache.xs
Apache Apache.pm
Log:
fix bug where Apache::send_http_header was resetting r->status = 200
Revision ChangesPath
1.533 +3 -0 modperl/Changes
Index: Changes
===
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.532
retrieving revision 1.533
diff -u -r1.532 -r1.533
--- Changes 2000/09/28 15:18:58 1.532
+++ Changes 2000/09/28 16:19:52 1.533
@@ -10,6 +10,9 @@
=item 1.24_01-dev
+fix bug where Apache::send_http_header was resetting r->status = 200
+thanks to brian d foy for the spot
+
make extra sure Apache::Constants::AUTOLOAD does not recurse looking
for sub __AUTOLOAD [Jim Winstead <[EMAIL PROTECTED]>]
1.112 +0 -1 modperl/src/modules/perl/Apache.xs
Index: Apache.xs
===
RCS file: /home/cvs/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.111
retrieving revision 1.112
diff -u -r1.111 -r1.112
--- Apache.xs 2000/09/27 23:51:33 1.111
+++ Apache.xs 2000/09/28 16:19:56 1.112
@@ -929,7 +929,6 @@
r->content_type = pstrdup(r->pool, type);
send_http_header(r);
mod_perl_sent_header(r, 1);
-r->status = 200; /* XXX, why??? */
#ifndef PERL_OBJECT
1.54 +2 -1 modperl/Apache/Apache.pm
Index: Apache.pm
===
RCS file: /home/cvs/modperl/Apache/Apache.pm,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -r1.53 -r1.54
--- Apache.pm 2000/08/31 05:49:05 1.53
+++ Apache.pm 2000/09/28 16:19:56 1.54
@@ -180,7 +180,8 @@
else {
$not_sent = 1;
}
- $r->send_http_header if $not_sent;
+ $r->send_http_header if
+ $not_sent and $r->status == 200;
$r->print($headers); #send rest of buffer, without stripping newlines!!!
last;
}
cvs commit: modperl Changes ToDo
dougm 00/09/28 08:19:02
Modified:Constants Constants.pm
.Changes ToDo
Log:
make extra sure Apache::Constants::AUTOLOAD does not recurse looking
for sub __AUTOLOAD
Revision ChangesPath
1.21 +10 -3 modperl/Constants/Constants.pm
Index: Constants.pm
===
RCS file: /home/cvs/modperl/Constants/Constants.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- Constants.pm 2000/03/03 20:42:01 1.20
+++ Constants.pm 2000/09/28 15:18:54 1.21
@@ -17,9 +17,16 @@
if ($ENV{MOD_PERL}) {
#outside of mod_perl this will recurse looking for __AUTOLOAD, grr
*AUTOLOAD = sub {
- #why must we stringify first???
- __AUTOLOAD() if "$Apache::Constants::AUTOLOAD";
- goto &$Apache::Constants::AUTOLOAD;
+if (defined &__AUTOLOAD) { #make extra sure we don't recurse
+#why must we stringify first???
+__AUTOLOAD() if "$Apache::Constants::AUTOLOAD";
+goto &$Apache::Constants::AUTOLOAD;
+}
+else {
+require Carp;
+Carp::confess("__AUTOLOAD is undefined, ",
+ "trying to AUTOLOAD $Apache::Constants::AUTOLOAD");
+}
};
}
1.532 +3 -0 modperl/Changes
Index: Changes
===
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.531
retrieving revision 1.532
diff -u -r1.531 -r1.532
--- Changes 2000/09/28 03:30:20 1.531
+++ Changes 2000/09/28 15:18:58 1.532
@@ -10,6 +10,9 @@
=item 1.24_01-dev
+make extra sure Apache::Constants::AUTOLOAD does not recurse looking
+for sub __AUTOLOAD [Jim Winstead <[EMAIL PROTECTED]>]
+
fix %Apache::ReadConfig:: processing for PerlRequire'd files
[Salvador Ortiz Garcia <[EMAIL PROTECTED]>]
1.259 +0 -5 modperl/ToDo
Index: ToDo
===
RCS file: /home/cvs/modperl/ToDo,v
retrieving revision 1.258
retrieving revision 1.259
diff -u -r1.258 -r1.259
--- ToDo 2000/09/27 23:51:29 1.258
+++ ToDo 2000/09/28 15:18:59 1.259
@@ -9,16 +9,11 @@
- changes for libapreq+win32 [Jiho Hahm <[EMAIL PROTECTED]>]
-- Perl{Module,Require} is allowed in .htaccess, but also adds to
- cls->Perl{Module,Require} arrays, which it should not
-
- segfaults with DBI->connect (mysql), reported that downgrade to
1.21_03 cures
- Apache::read() does not clear $_[1] before appending data, bug or feature?
[Cyrus Rahman <[EMAIL PROTECTED]>]
-
-- Apache::Constants::AUTOLOAD recursion [Jim Winstead <[EMAIL PROTECTED]>]
- {get,set}_handlers troubles [Geoffrey Young <[EMAIL PROTECTED]>]
see also: http://perl.apache.org/~dougm/set_handlers.pat
