Author: torsten
Date: Sun Apr 11 12:16:14 2010
New Revision: 932875
URL: http://svn.apache.org/viewvc?rev=932875&view=rev
Log:
Change the file handle preservation method for the perl-script handler from
open SAVEIN, '<&STDIN';
open SAVEOUT, '>&STDOUT';
run_response_handler;
open STDIN, '<&SAVEIN';
open STDOUT, '>&SAVEOUT';
to
{
local *STDIN;
local *STDOUT;
run_response_handler;
}
This way the file descriptor are preserved and issues like
http://www.gossamer-threads.com/lists/modperl/modperl/94921
are fixed.
Added:
perl/modperl/trunk/t/response/TestModperl/stdfd.pm
perl/modperl/trunk/t/response/TestModperl/stdfd2.pm
Modified:
perl/modperl/trunk/Changes
perl/modperl/trunk/src/modules/perl/modperl_io.c
Modified: perl/modperl/trunk/Changes
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/Changes?rev=932875&r1=932874&r2=932875&view=diff
==============================================================================
--- perl/modperl/trunk/Changes (original)
+++ perl/modperl/trunk/Changes Sun Apr 11 12:16:14 2010
@@ -12,6 +12,9 @@ Also refer to the Apache::Test changes l
=item 2.0.5-dev
+Make sure standard file descriptors are preserved by the perl-script
+handler [Torsten Foertsch]
+
Fix the filter init handler attribute check in
modperl_filter_resolve_init_handler() [Torsten Foertsch]
Modified: perl/modperl/trunk/src/modules/perl/modperl_io.c
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/src/modules/perl/modperl_io.c?rev=932875&r1=932874&r2=932875&view=diff
==============================================================================
--- perl/modperl/trunk/src/modules/perl/modperl_io.c (original)
+++ perl/modperl/trunk/src/modules/perl/modperl_io.c Sun Apr 11 12:16:14 2010
@@ -104,136 +104,35 @@ MP_INLINE void modperl_io_handle_untie(p
sv_unmagic(TIEHANDLE_SV(handle), PERL_MAGIC_tiedscalar);
}
-MP_INLINE GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r)
-{
- dHANDLE("STDIN");
- int status;
- GV *handle_save = (GV*)Nullsv;
- SV *sv = sv_newmortal();
-
- MP_TRACE_o(MP_FUNC, "start");
-
- /* if STDIN is open, dup it, to be restored at the end of response */
- if (handle && SvTYPE(handle) == SVt_PVGV &&
- IoTYPE(GvIO(handle)) != IoTYPE_CLOSED) {
- handle_save = gv_fetchpv(Perl_form(aTHX_
- "Apache2::RequestIO::_GEN_%ld",
- (long)PL_gensym++),
- TRUE, SVt_PVIO);
-
- /* open my $oldout, "<&STDIN" or die "Can't dup STDIN: $!"; */
- status = do_open(handle_save, "<&STDIN", 7, FALSE,
- O_RDONLY, 0, Nullfp);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to dup STDIN: %" SVf, get_sv("!", TRUE));
- }
-
- /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
- * have file descriptors, so STDIN must be closed before it can
- * be reopened */
- do_close(handle, TRUE);
- }
-
- sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
- status = do_open9(handle, "<:Apache2", 9, FALSE, O_RDONLY,
- 0, Nullfp, sv, 1);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to open STDIN: %" SVf, get_sv("!", TRUE));
- }
-
- MP_TRACE_o(MP_FUNC, "end");
-
- return handle_save;
-}
-
-/* XXX: refactor to merge with the previous function */
-MP_INLINE GV *modperl_io_perlio_override_stdout(pTHX_ request_rec *r)
+MP_INLINE static void
+modperl_io_perlio_override_stdhandle(pTHX_ request_rec *r, int mode)
{
- dHANDLE("STDOUT");
+ dHANDLE(mode == O_RDONLY ? "STDIN" : "STDOUT");
int status;
- GV *handle_save = (GV*)Nullsv;
SV *sv = sv_newmortal();
- MP_TRACE_o(MP_FUNC, "start");
+ MP_TRACE_o(MP_FUNC, "start STD%s", mode == O_RDONLY ? "IN" : "OUT");
- /* if STDOUT is open, dup it, to be restored at the end of response */
- if (handle && SvTYPE(handle) == SVt_PVGV &&
- IoTYPE(GvIO(handle)) != IoTYPE_CLOSED) {
- handle_save = gv_fetchpv(Perl_form(aTHX_
- "Apache2::RequestIO::_GEN_%ld",
- (long)PL_gensym++),
- TRUE, SVt_PVIO);
-
- /* open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!"; */
- status = do_open(handle_save, ">&STDOUT", 8, FALSE,
- O_WRONLY, 0, Nullfp);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to dup STDOUT: %" SVf, get_sv("!", TRUE));
- }
-
- /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
- * have file descriptors, so STDOUT must be closed before it can
- * be reopened */
- do_close(handle, TRUE);
- }
+ save_gp(handle, 1);
sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
- status = do_open9(handle, ">:Apache2", 9, FALSE, O_WRONLY,
- 0, Nullfp, sv, 1);
+ status = do_open9(handle, mode == O_RDONLY ? "<:Apache2" : ">:Apache2",
+ 9, FALSE, mode, 0, Nullfp, sv, 1);
if (status == 0) {
- Perl_croak(aTHX_ "Failed to open STDOUT: %" SVf, get_sv("!", TRUE));
+ Perl_croak(aTHX_ "Failed to open STD%s: %" SVf,
+ mode == O_RDONLY ? "IN" : "OUT", get_sv("!", TRUE));
}
- MP_TRACE_o(MP_FUNC, "end");
-
- /* XXX: shouldn't we preserve the value STDOUT had before it was
- * overridden? */
- IoFLUSH_off(handle); /* STDOUT's $|=0 */
-
- return handle_save;
-
+ MP_TRACE_o(MP_FUNC, "end STD%s", mode==O_RDONLY ? "IN" : "OUT");
}
-MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
+MP_INLINE static void
+modperl_io_perlio_restore_stdhandle(pTHX_ int mode)
{
- GV *handle_orig = gv_fetchpv("STDIN", FALSE, SVt_PVIO);
-
- MP_TRACE_o(MP_FUNC, "start");
-
- /* close the overriding filehandle */
- do_close(handle_orig, FALSE);
+ GV *handle_orig = gv_fetchpv(mode == O_RDONLY ? "STDIN" : "STDOUT",
+ FALSE, SVt_PVIO);
- /*
- * open STDIN, "<&STDIN_SAVED" or die "Can't dup STDIN_SAVED: $!";
- * close STDIN_SAVED;
- */
- if (handle != (GV*)Nullsv) {
- SV *err = Nullsv;
-
- MP_TRACE_o(MP_FUNC, "restoring STDIN");
-
- if (do_open9(handle_orig, "<&", 2, FALSE,
- O_RDONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
- err = get_sv("!", TRUE);
- }
-
- do_close(handle, FALSE);
- (void)hv_delete(gv_stashpv("Apache2::RequestIO", TRUE),
- GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
-
- if (err != Nullsv) {
- Perl_croak(aTHX_ "Failed to restore STDIN: %" SVf, err);
- }
- }
-
- MP_TRACE_o(MP_FUNC, "end");
-}
-
-MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle)
-{
- GV *handle_orig = gv_fetchpv("STDOUT", FALSE, SVt_PVIO);
-
- MP_TRACE_o(MP_FUNC, "start");
+ MP_TRACE_o(MP_FUNC, "start STD%s", mode == O_RDONLY ? "IN" : "OUT");
/* since closing unflushed STDOUT may trigger a subrequest
* (e.g. via mod_include), resulting in potential another response
@@ -242,7 +141,8 @@ MP_INLINE void modperl_io_perlio_restore
* level STDOUT is attempted to be closed. To prevent this
* situation always explicitly flush STDOUT, before reopening it.
*/
- if (GvIOn(handle_orig) && IoOFP(GvIOn(handle_orig)) &&
+ if (mode != O_RDONLY &&
+ GvIOn(handle_orig) && IoOFP(GvIOn(handle_orig)) &&
(PerlIO_flush(IoOFP(GvIOn(handle_orig))) == -1)) {
Perl_croak(aTHX_ "Failed to flush STDOUT: %" SVf, get_sv("!", TRUE));
}
@@ -250,28 +150,28 @@ MP_INLINE void modperl_io_perlio_restore
/* close the overriding filehandle */
do_close(handle_orig, FALSE);
- /*
- * open STDOUT, ">&STDOUT_SAVED" or die "Can't dup STDOUT_SAVED: $!";
- * close STDOUT_SAVED;
- */
- if (handle != (GV*)Nullsv) {
- SV *err = Nullsv;
+ MP_TRACE_o(MP_FUNC, "end STD%s", mode == O_RDONLY ? "IN" : "OUT");
+}
- MP_TRACE_o(MP_FUNC, "restoring STDOUT");
+MP_INLINE GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r)
+{
+ modperl_io_perlio_override_stdhandle(aTHX_ r, O_RDONLY);
+ return NULL;
+}
- if (do_open9(handle_orig, ">&", 2, FALSE,
- O_WRONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
- err = get_sv("!", TRUE);
- }
-
- do_close(handle, FALSE);
- (void)hv_delete(gv_stashpv("Apache2::RequestIO", TRUE),
- GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
-
- if (err != Nullsv) {
- Perl_croak(aTHX_ "Failed to restore STDOUT: %" SVf, err);
- }
- }
+MP_INLINE GV *modperl_io_perlio_override_stdout(pTHX_ request_rec *r)
+{
+ modperl_io_perlio_override_stdhandle(aTHX_ r, O_WRONLY);
+ return NULL;
+}
+
+MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
+{
+ modperl_io_perlio_restore_stdhandle(aTHX_ O_RDONLY);
+}
- MP_TRACE_o(MP_FUNC, "end");
+MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle)
+{
+ modperl_io_perlio_restore_stdhandle(aTHX_ O_WRONLY);
}
+
Added: perl/modperl/trunk/t/response/TestModperl/stdfd.pm
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/t/response/TestModperl/stdfd.pm?rev=932875&view=auto
==============================================================================
--- perl/modperl/trunk/t/response/TestModperl/stdfd.pm (added)
+++ perl/modperl/trunk/t/response/TestModperl/stdfd.pm Sun Apr 11 12:16:14 2010
@@ -0,0 +1,41 @@
+package TestModperl::stdfd;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::SubRequest ();
+
+use Apache2::Const -compile => 'OK';
+
+sub fixup {
+ my $r = shift;
+
+ $r->handler($r->main ? 'perl-script' : 'modperl');
+ return Apache2::Const::OK;
+}
+
+sub handler {
+ my $r = shift;
+
+ return Apache2::Const::OK if $r->main;
+
+ my @fds=(fileno(STDIN), fileno(STDOUT));
+
+ $r->lookup_uri($r->uri)->run;
+
+ $r->print("1..2\n");
+ $r->print((fileno(STDIN)==$fds[0] ? '' : 'not ').
+ "ok 1 - fileno(STDIN)=".fileno(STDIN)." expected $fds[0]\n");
+ $r->print((fileno(STDOUT)==$fds[1] ? '' : 'not ').
+ "ok 2 - fileno(STDOUT)=".fileno(STDOUT)." expected $fds[1]\n");
+
+ return Apache2::Const::OK;
+}
+
+1;
+__DATA__
+PerlModule TestModperl::stdfd
+PerlFixupHandler TestModperl::stdfd::fixup
+PerlResponseHandler TestModperl::stdfd
Added: perl/modperl/trunk/t/response/TestModperl/stdfd2.pm
URL:
http://svn.apache.org/viewvc/perl/modperl/trunk/t/response/TestModperl/stdfd2.pm?rev=932875&view=auto
==============================================================================
--- perl/modperl/trunk/t/response/TestModperl/stdfd2.pm (added)
+++ perl/modperl/trunk/t/response/TestModperl/stdfd2.pm Sun Apr 11 12:16:14 2010
@@ -0,0 +1,44 @@
+package TestModperl::stdfd2;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::SubRequest ();
+
+use Apache2::Const -compile => 'OK';
+
+sub fixup {
+ my $r = shift;
+
+ $r->handler($r->main ? 'perl-script' : 'modperl');
+ return Apache2::Const::OK;
+}
+
+sub handler {
+ my $r = shift;
+
+ return Apache2::Const::OK if $r->main;
+
+ local *STDIN;
+ open STDIN, '<', $INC{'TestModperl/stdfd2.pm'}
+ or die "Cannot open $INC{'TestModperl/stdfd2.pm'}";
+ scalar readline STDIN for(1..2);
+
+ my $expected=$.;
+
+ $r->lookup_uri($r->uri)->run;
+
+ $r->print("1..1\n");
+ $r->print(($.==$expected ? '' : 'not ').
+ "ok 1 - \$.=$. expected $expected\n");
+
+ return Apache2::Const::OK;
+}
+
+1;
+__DATA__
+PerlModule TestModperl::stdfd2
+PerlFixupHandler TestModperl::stdfd2::fixup
+PerlResponseHandler TestModperl::stdfd2
