dougm 01/05/08 14:08:55
Modified: lib/ModPerl Code.pm
src/modules/perl mod_perl.c modperl_config.c
modperl_filter.c modperl_types.h
t/modules cgi.t
t/response/TestModules cgi.pm
xs/Apache/Response Apache__Response.h
Added: t/apache scanhdrs.t
t/response/TestApache scanhdrs.pm
Log:
implement "PerlOptions +ParseHeaders" and add tests
Revision Changes Path
1.65 +1 -1 modperl-2.0/lib/ModPerl/Code.pm
Index: Code.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- Code.pm 2001/05/08 18:55:34 1.64
+++ Code.pm 2001/05/08 21:08:18 1.65
@@ -93,7 +93,7 @@
my %flags = (
Srv => ['NONE', @ithread_opts, qw(ENABLED AUTOLOAD MERGE_HANDLERS),
@hook_flags, 'UNSET'],
- Dir => [qw(NONE SEND_HEADER SETUP_ENV MERGE_HANDLERS GLOBAL_REQUEST UNSET)],
+ Dir => [qw(NONE PARSE_HEADERS SETUP_ENV MERGE_HANDLERS GLOBAL_REQUEST UNSET)],
Req => [qw(NONE SET_GLOBAL_REQUEST)],
Interp => [qw(NONE IN_USE PUTBACK CLONED BASE)],
Handler => [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD DYNAMIC)],
1.56 +6 -0 modperl-2.0/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- mod_perl.c 2001/05/08 04:25:49 1.55
+++ mod_perl.c 2001/05/08 21:08:24 1.56
@@ -390,6 +390,8 @@
int modperl_response_handler_cgi(request_rec *r)
{
+ MP_dDCFG;
+ MP_dRCFG;
GV *h_stdin, *h_stdout;
int retval;
#ifdef USE_ITHREADS
@@ -405,6 +407,10 @@
interp = modperl_interp_select(r, r->connection, r->server);
aTHX = interp->perl;
#endif
+
+ if (MpDirPARSE_HEADERS(dcfg)) {
+ rcfg->wbucket.header_parse = 1;
+ }
h_stdout = modperl_io_tie_stdout(aTHX_ r);
h_stdin = modperl_io_tie_stdin(aTHX_ r);
1.32 +2 -0 modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- modperl_config.c 2001/04/06 02:18:15 1.31
+++ modperl_config.c 2001/05/08 21:08:26 1.32
@@ -55,6 +55,8 @@
modperl_config_req_t *rcfg =
(modperl_config_req_t *)apr_pcalloc(r->pool, sizeof(*rcfg));
+ rcfg->wbucket.r = r;
+
MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)rcfg);
return rcfg;
1.20 +26 -2 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.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- modperl_filter.c 2001/05/07 02:05:00 1.19
+++ modperl_filter.c 2001/05/08 21:08:27 1.20
@@ -5,9 +5,33 @@
MP_INLINE apr_status_t modperl_wbucket_pass(modperl_wbucket_t *wb,
const char *buf, apr_ssize_t len)
{
- apr_bucket_brigade *bb = apr_brigade_create(wb->pool);
- apr_bucket *bucket = apr_bucket_transient_create(buf, len);
+ apr_bucket_brigade *bb;
+ apr_bucket *bucket;
+
+ if (wb->header_parse) {
+ request_rec *r = wb->r;
+ const char *bodytext = NULL;
+ int status = modperl_cgi_header_parse(r, (char *)buf, &bodytext);
+
+ if (status != OK) {
+ ap_log_error(APLOG_MARK, APLOG_WARNING|APLOG_NOERRNO,
+ 0, r->server, "%s did not send an HTTP header",
+ r->uri);
+ }
+ else if (!bodytext) {
+ return APR_SUCCESS;
+ }
+
+ if (bodytext) {
+ len -= (bodytext - buf);
+ buf = bodytext;
+ }
+ }
+
+ bb = apr_brigade_create(wb->pool);
+ bucket = apr_bucket_transient_create(buf, len);
APR_BRIGADE_INSERT_TAIL(bb, bucket);
+
return ap_pass_brigade(wb->filters, bb);
}
1.40 +2 -0 modperl-2.0/src/modules/perl/modperl_types.h
Index: modperl_types.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- modperl_types.h 2001/04/30 04:38:35 1.39
+++ modperl_types.h 2001/05/08 21:08:30 1.40
@@ -169,6 +169,8 @@
char outbuf[MP_IOBUFSIZE];
apr_pool_t *pool;
ap_filter_t *filters;
+ int header_parse;
+ request_rec *r;
} modperl_wbucket_t;
typedef enum {
1.1 modperl-2.0/t/apache/scanhdrs.t
Index: scanhdrs.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestRequest;
plan tests => 4, \&have_lwp;
my $module = 'TestApache::scanhdrs';
my $location = "/$module";
my $res = GET $location;
ok $res->content eq "1..1\nok 1\n";
ok $res->header('Content-type') eq 'text/test-output';
ok $res->header('X-Perl-Module') eq $module;
ok $res->message =~ /beer/;
1.3 +11 -3 modperl-2.0/t/modules/cgi.t
Index: cgi.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/modules/cgi.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- cgi.t 2001/05/08 05:08:52 1.2
+++ cgi.t 2001/05/08 21:08:42 1.3
@@ -4,13 +4,15 @@
use Apache::Test;
use Apache::TestRequest;
-plan tests => 4, \&have_lwp;
+plan tests => 6, \&have_lwp;
-my $location = "/TestModules::cgi";
+my $module = 'TestModules::cgi';
+my $location = "/$module";
ok 1;
-my $str = GET_BODY "$location?PARAM=2";
+my $res = GET "$location?PARAM=2";
+my $str = $res->content;
print $str;
$str = POST_BODY $location, content => 'PARAM=%33';
@@ -18,3 +20,9 @@
$str = UPLOAD_BODY $location, content => 4;
print $str;
+
+$Test::ntest += 3;
+
+ok $res->header('Content-type') =~ m:^text/test-output:;
+
+ok $res->header('X-Perl-Module') eq $module;
1.1 modperl-2.0/t/response/TestApache/scanhdrs.pm
Index: scanhdrs.pm
===================================================================
package TestApache::scanhdrs;
use strict;
use warnings FATAL => 'all';
use Apache::compat ();
use Apache::Test;
sub handler {
my $r = shift;
print "Status: 200 Bottles of beer on the wall\n";
print 'X-Perl-Module', ': ', __PACKAGE__;
print "\r\n";
print "Content-type: text/test-";
print "output\n";
print "\n";
plan $r, tests => 1;
print "ok 1\n";
Apache::OK;
}
1;
__END__
SetHandler perl-script
PerlOptions +ParseHeaders
1.4 +2 -2 modperl-2.0/t/response/TestModules/cgi.pm
Index: cgi.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestModules/cgi.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- cgi.pm 2001/05/08 20:15:54 1.3
+++ cgi.pm 2001/05/08 21:08:49 1.4
@@ -14,8 +14,8 @@
my $param = $cgi->param('PARAM');
my $httpupload = $cgi->param('HTTPUPLOAD');
- print $cgi->header('-type' => 'text/plain',
- '-X-Perl-Script' => 'cgi.pm');
+ print $cgi->header('-type' => 'text/test-output',
+ '-X-Perl-Module' => __PACKAGE__);
print "ok $param\n" if $param;
1.3 +2 -0 modperl-2.0/xs/Apache/Response/Apache__Response.h
Index: Apache__Response.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/Response/Apache__Response.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Apache__Response.h 2001/05/08 20:15:13 1.2
+++ Apache__Response.h 2001/05/08 21:08:53 1.3
@@ -6,7 +6,9 @@
*/
#define mpxs_Apache__RequestRec_send_cgi_header(r, sv) \
{ \
+ MP_dRCFG; \
STRLEN len; \
const char *bodytext; \
modperl_cgi_header_parse(r, SvPV(sv,len), &bodytext); \
+ rcfg->wbucket.header_parse = 0; \
}
