cvs commit: modperl-2.0/ModPerl-Registry/t/conf extra.conf.in
stas2003/02/06 15:57:08 Modified:ModPerl-Registry/t/conf extra.conf.in Log: add ScriptAlias so we can do tests against mod_cgi Revision ChangesPath 1.9 +2 -0 modperl-2.0/ModPerl-Registry/t/conf/extra.conf.in Index: extra.conf.in === RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/conf/extra.conf.in,v retrieving revision 1.8 retrieving revision 1.9 diff -u -r1.8 -r1.9 --- extra.conf.in 24 Dec 2002 01:51:40 - 1.8 +++ extra.conf.in 6 Feb 2003 23:57:08 - 1.9 @@ -35,6 +35,8 @@ Alias /registry_oo_conf/ @ServerRoot@/cgi-bin/ Alias /perlrun/ @ServerRoot@/cgi-bin/ +ScriptAlias /cgi-bin/ @ServerRoot@/cgi-bin/ + PerlModule ModPerl::RegistryBB Location /registry_bb PerlOptions +GlobalRequest
cvs commit: modperl-2.0/ModPerl-Registry Makefile.PL
stas2003/02/06 16:08:34
Modified:ModPerl-Registry Makefile.PL
Log:
enable SMOKE script creation for ModPerl-Registry
Revision ChangesPath
1.7 +4 -0 modperl-2.0/ModPerl-Registry/Makefile.PL
Index: Makefile.PL
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/Makefile.PL,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- Makefile.PL 14 May 2002 15:57:14 - 1.6
+++ Makefile.PL 7 Feb 2003 00:08:34 - 1.7
@@ -5,6 +5,7 @@
use lib map {($_, ../$_) } qw(lib Apache-Test/lib);
use ModPerl::MM ();
+use Apache::TestSmokePerl ();
# enable 'make test|clean'
use Apache::TestMM qw(test clean);
@@ -19,6 +20,9 @@
# accept the configs from comman line
Apache::TestMM::filter_args();
Apache::TestMM::generate_script('t/TEST');
+
+# t/SMOKE
+Apache::TestSmokePerl-generate_script;
ModPerl::MM::WriteMakefile(
NAME = 'ModPerl::Registry',
cvs commit: modperl-2.0/ModPerl-Registry/lib/ModPerl RegistryCooker.pm
stas2003/02/06 16:12:25 Modified:ModPerl-Registry/lib/ModPerl RegistryCooker.pm Log: always return the run's return status if it's not Apache::OK Revision ChangesPath 1.31 +5 -7 modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm Index: RegistryCooker.pm === RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm,v retrieving revision 1.30 retrieving revision 1.31 diff -u -r1.30 -r1.31 --- RegistryCooker.pm 5 Feb 2003 04:06:27 - 1.30 +++ RegistryCooker.pm 7 Feb 2003 00:12:25 - 1.31 @@ -159,15 +159,13 @@ return $rc unless $rc == Apache::OK; } -# handlers shouldn't set $r-status but return it +# handlers shouldn't set $r-status but return it, so we reset the +# status after running it my $old_status = $self-[REQ]-status; my $rc = $self-run; -my $new_status = $self-[REQ]-status; - -# only if the script has changed the status, reset to the old -# status and return the new status -return $old_status != $new_status -? $self-[REQ]-status($old_status) +my $new_status = $self-[REQ]-status($old_status); +return ($rc == Apache::OK $old_status != $new_status) +? $new_status : $rc; }
cvs commit: modperl-2.0/ModPerl-Registry/t/cgi-bin runtime_error_n_status_change.pl runtime_error_plus_body.pl runtime_error.pl
stas2003/02/06 16:15:39
Modified:ModPerl-Registry/t .cvsignore 500.t
ModPerl-Registry/t/cgi-bin runtime_error.pl
Added: ModPerl-Registry/t/cgi-bin runtime_error_n_status_change.pl
runtime_error_plus_body.pl
Log:
add several more tests which explore various situations when runtime
errors happen
Revision ChangesPath
1.3 +1 -0 modperl-2.0/ModPerl-Registry/t/.cvsignore
Index: .cvsignore
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/.cvsignore,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- .cvsignore18 Oct 2001 04:25:12 - 1.2
+++ .cvsignore7 Feb 2003 00:15:39 - 1.3
@@ -1,3 +1,4 @@
logs
htdocs
TEST
+SMOKE
1.3 +44 -4 modperl-2.0/ModPerl-Registry/t/500.t
Index: 500.t
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/500.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- 500.t 23 Jan 2003 01:12:01 - 1.2
+++ 500.t 7 Feb 2003 00:15:39 - 1.3
@@ -5,7 +5,21 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET);
-plan tests = 3;
+plan tests = 6;
+
+{
+# the script changes the status before the run-time error happens,
+# this status change should be ignored
+my $url = /registry/runtime_error_n_status_change.pl;
+my $res = GET($url);
+#t_debug($res-content);
+ok t_cmp(
+500,
+$res-code,
+500 error on runtime error (when the script changes the status),
+ );
+}
+
{
@@ -20,6 +34,21 @@
}
{
+my $url = /registry/missing_headers.pl;
+my $res = GET($url);
+#t_debug($res-content);
+ok t_cmp(
+500,
+$res-code,
+500 error on missing HTTP headers,
+ );
+}
+
+{
+# since we have a runtime error before any body is sent, mod_perl
+# has a chance to communicate the return status of the script to
+# Apache before headers are sent, so we get the code 500 in the
+# HTTP headers
my $url = /registry/runtime_error.pl;
my $res = GET($url);
#t_debug($res-content);
@@ -31,12 +60,23 @@
}
{
-my $url = /registry/missing_headers.pl;
+# even though we have a runtime error here, the scripts succeeds
+# to send some body before the error happens and since by that
+# time Apache has already sent the headers, they will include
+# 200 OK
+my $url = /registry/runtime_error_plus_body.pl;
my $res = GET($url);
#t_debug($res-content);
ok t_cmp(
-500,
+200,
$res-code,
-500 error on missing HTTP headers,
+200, followed by a runtime error,
+ );
+
+# the error message is attached after the body
+ok t_cmp(
+qr/some body.*The server encountered an internal error/ms,
+$res-content,
+200, followed by a runtime error,
);
}
1.2 +3 -0 modperl-2.0/ModPerl-Registry/t/cgi-bin/runtime_error.pl
Index: runtime_error.pl
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/cgi-bin/runtime_error.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- runtime_error.pl 23 Jan 2003 01:12:01 - 1.1
+++ runtime_error.pl 7 Feb 2003 00:15:39 - 1.2
@@ -1,2 +1,5 @@
+# this script sends no body at all, and since the error happens
+# the script will return 500
+
print Content-type: text/plain\n\n;
print no_such_func();
1.1
modperl-2.0/ModPerl-Registry/t/cgi-bin/runtime_error_n_status_change.pl
Index: runtime_error_n_status_change.pl
===
my $r = shift;
$r-status(404);
$r-send_http_header('text/plain');
$r-print(no_such_func());
1.1
modperl-2.0/ModPerl-Registry/t/cgi-bin/runtime_error_plus_body.pl
Index: runtime_error_plus_body.pl
===
# this script sends some body before the error happens,
# so 200 OK is expected, followed by an error
print Content-type: text/plain\n\n;
print some body;
print no_such_func();
cvs commit: modperl-2.0/ModPerl-Registry/t/cgi-bin runtime_error_n_status_change.pl status_change.pl
stas2003/02/06 16:23:31
Modified:ModPerl-Registry/t/cgi-bin runtime_error_n_status_change.pl
status_change.pl
Log:
don't use the 1.x compat api
Revision ChangesPath
1.2 +1 -1
modperl-2.0/ModPerl-Registry/t/cgi-bin/runtime_error_n_status_change.pl
Index: runtime_error_n_status_change.pl
===
RCS file:
/home/cvs/modperl-2.0/ModPerl-Registry/t/cgi-bin/runtime_error_n_status_change.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- runtime_error_n_status_change.pl 7 Feb 2003 00:15:39 - 1.1
+++ runtime_error_n_status_change.pl 7 Feb 2003 00:23:31 - 1.2
@@ -1,4 +1,4 @@
my $r = shift;
$r-status(404);
-$r-send_http_header('text/plain');
+$r-print(Content-type: text/plain\n\n);
$r-print(no_such_func());
1.2 +1 -1 modperl-2.0/ModPerl-Registry/t/cgi-bin/status_change.pl
Index: status_change.pl
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/cgi-bin/status_change.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- status_change.pl 7 Feb 2003 00:13:40 - 1.1
+++ status_change.pl 7 Feb 2003 00:23:31 - 1.2
@@ -1,3 +1,3 @@
my $r = shift;
$r-status(404);
-$r-send_http_header('text/plain');
+$r-print(Content-type: text/plain\n\n);
cvs commit: modperl-2.0/ModPerl-Registry/t closure.t
stas2003/02/06 16:40:32
Modified:ModPerl-Registry/t closure.t
Log:
correct the explanation
Revision ChangesPath
1.6 +3 -2 modperl-2.0/ModPerl-Registry/t/closure.t
Index: closure.t
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/closure.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- closure.t 22 May 2002 05:40:48 - 1.5
+++ closure.t 7 Feb 2003 00:40:32 - 1.6
@@ -118,9 +118,10 @@
sub sleep_and_touch_file {
my $file = shift;
-# need to wait at least 1 whole sec, so -M will notice the
+# need to wait at least 1 whole sec, so utime() will notice the
# difference. select() has better resolution than 1 sec as in
-# sleep()
+# sleep() so we are more likely to have the minimal waiting time,
+# while fullfilling the purpose
select undef, undef, undef, 1.00; # sure 1 sec
my $now = time;
utime $now, $now, $file;
cvs commit: modperl-2.0/ModPerl-Registry/t closure.t
stas2003/02/06 16:51:08 Modified:ModPerl-Registry/t closure.t Log: spel Revision ChangesPath 1.7 +1 -1 modperl-2.0/ModPerl-Registry/t/closure.t Index: closure.t === RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/closure.t,v retrieving revision 1.6 retrieving revision 1.7 diff -u -r1.6 -r1.7 --- closure.t 7 Feb 2003 00:40:32 - 1.6 +++ closure.t 7 Feb 2003 00:51:08 - 1.7 @@ -121,7 +121,7 @@ # need to wait at least 1 whole sec, so utime() will notice the # difference. select() has better resolution than 1 sec as in # sleep() so we are more likely to have the minimal waiting time, -# while fullfilling the purpose +# while fulfilling the purpose select undef, undef, undef, 1.00; # sure 1 sec my $now = time; utime $now, $now, $file;
cvs commit: modperl-2.0/src/modules/perl modperl_filter.c
stas2003/02/06 18:30:53
Modified:src/modules/perl modperl_filter.c
Log:
we have no choice but to truncate wb-outbuf to the size of 'len'. All
kind of weird problems pop-up when the previous request was proper and the
current request has messed up with headers, because
modperl_cgi_header_parse (actually the ap_scan_script_header_err_strs)
will get things messed up because it expects a buffer with real data only.
Revision ChangesPath
1.50 +24 -23modperl-2.0/src/modules/perl/modperl_filter.c
Index: modperl_filter.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.c,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- modperl_filter.c 7 Feb 2003 00:07:42 - 1.49
+++ modperl_filter.c 7 Feb 2003 02:30:52 - 1.50
@@ -8,11 +8,28 @@
apr_bucket_alloc_t *ba = (*wb-filters)-c-bucket_alloc;
apr_bucket_brigade *bb;
apr_bucket *bucket;
-
+const char *work_buf = buf;
+
if (wb-header_parse) {
request_rec *r = wb-r;
const char *bodytext = NULL;
-int status = modperl_cgi_header_parse(r, (char *)buf, bodytext);
+int status;
+/*
+ * since wb-outcnt is persistent between requests, if the
+ * current response is shorter than the size of wb-outcnt
+ * it may include data from the previous request at the
+ * end. When this function receives a pointer to
+ * wb-outbuf as 'buf', modperl_cgi_header_parse may
+ * return that irrelevant data as part of 'bodytext'. So
+ * to avoid this risk, we create a new buffer of size 'len'
+ * XXX: if buf wasn't 'const char *buf' we could simply do
+ * buf[len] = '\0'
+ */
+if (len strlen(buf)) {
+work_buf = (char *)apr_pcalloc(wb-pool, sizeof(char*)*len);
+memcpy((void*)work_buf, buf, len);
+}
+status = modperl_cgi_header_parse(r, (char *)work_buf, bodytext);
wb-header_parse = 0; /* only once per-request */
@@ -26,32 +43,16 @@
/* XXX: bodytext == NULL here */
return status;
}
-
-if (!bodytext) {
+else if (!bodytext) {
return APR_SUCCESS;
}
-else {
-len -= (bodytext - buf);
-buf = bodytext;
-/*
- * since wb-outbuf is persistent between requests, if the
- * current response is shorter than the size of wb-outbuf
- * it may include data from the previous request at the
- * end. When this function receives a pointer to
- * wb-outbuf as 'buf', modperl_cgi_header_parse may
- * return that irrelevant data as part of 'bodytext'. So
- * to avoid this risk, we check whether there is any real
- * data to send and if not return.
- */
-if (!len) {
-return APR_SUCCESS;
-}
-}
-
+
+len -= (bodytext - work_buf);
+work_buf = bodytext;
}
bb = apr_brigade_create(wb-pool, ba);
-bucket = apr_bucket_transient_create(buf, len, ba);
+bucket = apr_bucket_transient_create(work_buf, len, ba);
APR_BRIGADE_INSERT_TAIL(bb, bucket);
MP_TRACE_f(MP_FUNC, buffer length=%d\n, len);
cvs commit: modperl-2.0/ModPerl-Registry/t/cgi-bin content_type.pl
stas2003/02/06 18:49:01
Modified:src/modules/perl modperl_filter.c
ModPerl-Registry/t basic.t
Added: ModPerl-Registry/t/cgi-bin content_type.pl
Log:
if the handler sets the content-type, don't parse the headers because
there most likely there will be none
Revision ChangesPath
1.51 +3 -3 modperl-2.0/src/modules/perl/modperl_filter.c
Index: modperl_filter.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.c,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- modperl_filter.c 7 Feb 2003 02:30:52 - 1.50
+++ modperl_filter.c 7 Feb 2003 02:49:01 - 1.51
@@ -10,13 +10,13 @@
apr_bucket *bucket;
const char *work_buf = buf;
-if (wb-header_parse) {
+if (wb-header_parse !wb-r-content_type) {
request_rec *r = wb-r;
const char *bodytext = NULL;
int status;
/*
- * since wb-outcnt is persistent between requests, if the
- * current response is shorter than the size of wb-outcnt
+ * since wb-outbuf is persistent between requests, if the
+ * current response is shorter than the size of wb-outbuf
* it may include data from the previous request at the
* end. When this function receives a pointer to
* wb-outbuf as 'buf', modperl_cgi_header_parse may
1.9 +53 -42modperl-2.0/ModPerl-Registry/t/basic.t
Index: basic.t
===
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/basic.t,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- basic.t 6 Jan 2003 10:39:43 - 1.8
+++ basic.t 7 Feb 2003 02:49:01 - 1.9
@@ -13,58 +13,69 @@
my @aliases = sort keys %modules;
-plan tests = @aliases * 4 + 1;
+plan tests = 2;
+#plan tests = @aliases * 4 + 2;
-# very basic compilation/response test
-for my $alias (@aliases) {
-my $url = /$alias/basic.pl;
-
-ok t_cmp(
-ok,
-GET_BODY($url),
-$modules{$alias} basic cgi test,
-);
-}
-
-# test non-executable bit
-for my $alias (@aliases) {
-my $url = /$alias/not_executable.pl;
-
-ok t_cmp(
-403 Forbidden,
-HEAD($url)-status_line(),
-$modules{$alias} non-executable file,
-);
-}
-
-# test environment pre-set
-for my $alias (@aliases) {
-my $url = /$alias/env.pl?foo=bar;
+## very basic compilation/response test
+#for my $alias (@aliases) {
+#my $url = /$alias/basic.pl;
+
+#ok t_cmp(
+#ok,
+#GET_BODY($url),
+#$modules{$alias} basic cgi test,
+#);
+#}
+
+## test non-executable bit
+#for my $alias (@aliases) {
+#my $url = /$alias/not_executable.pl;
+
+#ok t_cmp(
+#403 Forbidden,
+#HEAD($url)-status_line(),
+#$modules{$alias} non-executable file,
+#);
+#}
+
+## test environment pre-set
+#for my $alias (@aliases) {
+#my $url = /$alias/env.pl?foo=bar;
+
+#ok t_cmp(
+#foo=bar,
+#GET_BODY($url),
+#$modules{$alias} mod_cgi-like environment pre-set,
+#);
+#}
+
+## require (actually chdir test)
+#for my $alias (@aliases) {
+#my $url = /$alias/require.pl;
+
+#ok t_cmp(
+#it works,
+#GET_BODY($url),
+#$modules{$alias} mod_cgi-like environment pre-set,
+#);
+#}
+# test method handlers
+{
+my $url = /registry_oo_conf/env.pl?foo=bar;
ok t_cmp(
foo=bar,
GET_BODY($url),
-$modules{$alias} mod_cgi-like environment pre-set,
-);
-}
-
-# require (actually chdir test)
-for my $alias (@aliases) {
-my $url = /$alias/require.pl;
-
-ok t_cmp(
-it works,
-GET_BODY($url),
-$modules{$alias} mod_cgi-like environment pre-set,
+ModPerl::Registry-handler mod_cgi-like environment pre-set,
);
}
-# test method handlers
+# test mod_perl api usage
{
-my $url = /registry_oo_conf/env.pl?foo=bar;
+my $url = /registry/content_type.pl;
ok t_cmp(
-foo=bar,
+ok,
GET_BODY($url),
-ModPerl::Registry-handler mod_cgi-like environment pre-set,
+\$r-content_type('text/plain'),
);
}
1.1 modperl-2.0/ModPerl-Registry/t/cgi-bin/content_type.pl
Index: content_type.pl
===
my $r = shift;
$r-content_type('text/plain');
$r-print('ok');
cvs commit: modperl-2.0 Changes
stas2003/02/06 18:58:30 Modified:.Changes Log: log the recent changes Revision ChangesPath 1.123 +5 -0 modperl-2.0/Changes Index: Changes === RCS file: /home/cvs/modperl-2.0/Changes,v retrieving revision 1.122 retrieving revision 1.123 diff -u -r1.122 -r1.123 --- Changes 5 Feb 2003 04:06:27 - 1.122 +++ Changes 7 Feb 2003 02:58:30 - 1.123 @@ -10,6 +10,11 @@ =item 1.99_09-dev +Several issues resolved with parsing headers, including making work +the handlers calling $r-content_type() and not sending raw headers, +when the headers scanning is turned on. Lots of tests added to +exercise different situations. [Stas] + warn on using -T in ModPerl::Registry scripts when mod_perl is not running with -T [Stas]
