dougm 2002/06/29 13:38:33 Modified: src/modules/perl mod_perl.c modperl_cgi.c modperl_filter.c modperl_types.h Log: add support for redirects with PerlOptions +ParseHeaders Revision Changes Path 1.130 +7 -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.129 retrieving revision 1.130 diff -u -r1.129 -r1.130 --- mod_perl.c 28 Jun 2002 19:15:51 -0000 1.129 +++ mod_perl.c 29 Jun 2002 20:38:33 -0000 1.130 @@ -709,6 +709,13 @@ /* flush output buffer after interpreter is putback */ modperl_response_finish(r); + switch (rcfg->status) { + case HTTP_MOVED_TEMPORARILY: + /* set by modperl_cgi_header_parse */ + retval = HTTP_MOVED_TEMPORARILY; + break; + } + return retval; } 1.2 +33 -0 modperl-2.0/src/modules/perl/modperl_cgi.c Index: modperl_cgi.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cgi.c,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- modperl_cgi.c 8 May 2001 18:04:36 -0000 1.1 +++ modperl_cgi.c 29 Jun 2002 20:38:33 -0000 1.2 @@ -5,6 +5,7 @@ { int status; int termarg; + const char *location; if (!buffer) { return DECLINED; @@ -12,6 +13,38 @@ status = ap_scan_script_header_err_strs(r, NULL, bodytext, &termarg, buffer, NULL); + + /* code below from mod_cgi.c */ + location = apr_table_get(r->headers_out, "Location"); + + if (location && (location[0] == '/') && (r->status == 200)) { + r->method = apr_pstrdup(r->pool, "GET"); + r->method_number = M_GET; + + /* We already read the message body (if any), so don't allow + * the redirected request to think it has one. We can ignore + * Transfer-Encoding, since we used REQUEST_CHUNKED_ERROR. + */ + apr_table_unset(r->headers_in, "Content-Length"); + + ap_internal_redirect_handler(location, r); + + return OK; + } + else if (location && (r->status == 200)) { + MP_dRCFG; + + /* Note that if a script wants to produce its own Redirect + * body, it now has to explicitly *say* "Status: 302" + */ + + /* XXX: this is a hack. + * filter return value doesn't seem to impact anything. + */ + rcfg->status = HTTP_MOVED_TEMPORARILY; + + return HTTP_MOVED_TEMPORARILY; + } return status; } 1.36 +4 -1 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.35 retrieving revision 1.36 diff -u -r1.35 -r1.36 --- modperl_filter.c 30 May 2002 02:33:48 -0000 1.35 +++ modperl_filter.c 29 Jun 2002 20:38:33 -0000 1.36 @@ -14,7 +14,10 @@ const char *bodytext = NULL; int status = modperl_cgi_header_parse(r, (char *)buf, &bodytext); - if (status != OK) { + if (status == HTTP_MOVED_TEMPORARILY) { + return APR_SUCCESS; /* XXX: HTTP_MOVED_TEMPORARILY ? */ + } + else if (status != OK) { ap_log_error(APLOG_MARK, APLOG_WARNING|APLOG_NOERRNO, 0, r->server, "%s did not send an HTTP header", r->uri); 1.60 +1 -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.59 retrieving revision 1.60 diff -u -r1.59 -r1.60 --- modperl_types.h 21 Jun 2002 03:02:54 -0000 1.59 +++ modperl_types.h 29 Jun 2002 20:38:33 -0000 1.60 @@ -205,6 +205,7 @@ HV *pnotes; SV *global_request_obj; U8 flags; + int status; modperl_wbucket_t *wbucket; MpAV *handlers_per_dir[MP_HANDLER_NUM_PER_DIR]; MpAV *handlers_per_srv[MP_HANDLER_NUM_PER_SRV];