stas 2004/02/16 17:22:42
Modified: src/modules/perl modperl_io.c
. Changes
Added: t/response/TestModperl io_nested_with_closed_stds.pm
io_with_closed_stds.pm
Log:
Fix the STDIN/OUT overriding process to handle gracefully cases, when
either or both are closed/bogus (the problem was only with useperlio
enabled perl) + tests
Revision Changes Path
1.23 +93 -47 modperl-2.0/src/modules/perl/modperl_io.c
Index: modperl_io.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_io.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -u -r1.22 -r1.23
--- modperl_io.c 22 Nov 2003 20:38:54 -0000 1.22
+++ modperl_io.c 17 Feb 2004 01:22:41 -0000 1.23
@@ -92,25 +92,34 @@
{
dHANDLE("STDIN");
int status;
- GV *handle_save = gv_fetchpv(Perl_form(aTHX_ "Apache::RequestIO::_GEN_%ld",
- (long)PL_gensym++),
- TRUE, SVt_PVIO);
+ GV *handle_save = (GV*)Nullsv;
SV *sv = sv_newmortal();
- sv_setref_pv(sv, "Apache::RequestRec", (void*)r);
MP_TRACE_o(MP_FUNC, "start");
- /* open my $oldout, "<&STDIN" or die "Can't dup STDIN: $!"; */
- status = Perl_do_open(aTHX_ handle_save, "<&STDIN", 7, FALSE, O_RDONLY,
- 0, Nullfp);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to dup STDIN: %_", get_sv("!", TRUE));
+ sv_setref_pv(sv, "Apache::RequestRec", (void*)r);
+
+ /* STDIN could be closed or invalid */
+ if (handle && SvTYPE(handle) == SVt_PVGV &&
+ IoTYPE(GvIO(handle)) != IoTYPE_CLOSED) {
+ handle_save = gv_fetchpv(Perl_form(aTHX_
+ "Apache::RequestIO::_GEN_%ld",
+ (long)PL_gensym++),
+ TRUE, SVt_PVIO);
+
+ /* open my $oldout, "<&STDIN" or die "Can't dup STDIN: $!"; */
+ status = Perl_do_open(aTHX_ handle_save, "<&STDIN", 7, FALSE,
+ O_RDONLY, 0, Nullfp);
+ if (status == 0) {
+ Perl_croak(aTHX_ "Failed to dup STDIN: %_", 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 */
+ Perl_do_close(aTHX_ handle, TRUE);
}
- /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
- * have file descriptors, so STDIN must be closed before it can
- * be reopened */
- Perl_do_close(aTHX_ handle, TRUE);
status = Perl_do_open9(aTHX_ handle, "<:Apache", 8, FALSE, O_RDONLY,
0, Nullfp, sv, 1);
if (status == 0) {
@@ -127,26 +136,34 @@
{
dHANDLE("STDOUT");
int status;
- GV *handle_save = gv_fetchpv(Perl_form(aTHX_ "Apache::RequestIO::_GEN_%ld",
- (long)PL_gensym++),
- TRUE, SVt_PVIO);
+ GV *handle_save = (GV*)Nullsv;
SV *sv = sv_newmortal();
MP_TRACE_o(MP_FUNC, "start");
sv_setref_pv(sv, "Apache::RequestRec", (void*)r);
- /* open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!"; */
- status = Perl_do_open(aTHX_ handle_save, ">&STDOUT", 8, FALSE, O_WRONLY,
- 0, Nullfp);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to dup STDOUT: %_", get_sv("!", TRUE));
+ /* STDOUT could be closed or invalid */
+ if (handle && SvTYPE(handle) == SVt_PVGV &&
+ IoTYPE(GvIO(handle)) != IoTYPE_CLOSED) {
+ handle_save = gv_fetchpv(Perl_form(aTHX_
+ "Apache::RequestIO::_GEN_%ld",
+ (long)PL_gensym++),
+ TRUE, SVt_PVIO);
+
+ /* open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!"; */
+ status = Perl_do_open(aTHX_ handle_save, ">&STDOUT", 8, FALSE,
+ O_WRONLY, 0, Nullfp);
+ if (status == 0) {
+ Perl_croak(aTHX_ "Failed to dup STDOUT: %_", 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 */
+ Perl_do_close(aTHX_ handle, TRUE);
}
- /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
- * have file descriptors, so STDOUT must be closed before it can
- * be reopened */
- Perl_do_close(aTHX_ handle, TRUE);
status = Perl_do_open9(aTHX_ handle, ">:Apache", 8, FALSE, O_WRONLY,
0, Nullfp, sv, 1);
if (status == 0) {
@@ -166,20 +183,33 @@
MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
{
GV *handle_orig = gv_fetchpv("STDIN", FALSE, SVt_PVIO);
- int status;
MP_TRACE_o(MP_FUNC, "start");
- /* Perl_do_close(aTHX_ handle_orig, FALSE); */
+ /* close the overriding filehandle */
+ Perl_do_close(aTHX_ handle_orig, FALSE);
- /* open STDIN, "<&STDIN_SAVED" or die "Can't dup STDIN_SAVED: $!"; */
- status = Perl_do_open9(aTHX_ handle_orig, "<&", 2, FALSE, O_RDONLY,
- 0, Nullfp, (SV*)handle, 1);
- Perl_do_close(aTHX_ handle, FALSE);
- (void)hv_delete(gv_stashpv("Apache::RequestIO", TRUE),
- GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to restore STDIN: %_", get_sv("!", TRUE));
+ /*
+ * 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 (Perl_do_open9(aTHX_ handle_orig, "<&", 2, FALSE,
+ O_RDONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
+ err = get_sv("!", TRUE);
+ }
+
+ Perl_do_close(aTHX_ handle, FALSE);
+ (void)hv_delete(gv_stashpv("Apache::RequestIO", TRUE),
+ GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
+
+ if (err != Nullsv) {
+ Perl_croak(aTHX_ "Failed to restore STDIN: %_", err);
+ }
}
MP_TRACE_o(MP_FUNC, "end\n");
@@ -188,7 +218,6 @@
MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle)
{
GV *handle_orig = gv_fetchpv("STDOUT", FALSE, SVt_PVIO);
- int status;
MP_TRACE_o(MP_FUNC, "start");
@@ -199,18 +228,35 @@
* 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))) {
- PerlIO_flush(IoOFP(GvIOn(handle_orig)));
+ if (GvIOn(handle_orig) && IoOFP(GvIOn(handle_orig)) &&
+ (PerlIO_flush(IoOFP(GvIOn(handle_orig))) == -1)) {
+ Perl_croak(aTHX_ "Failed to flush STDOUT: %_", get_sv("!", TRUE));
}
- /* open STDOUT, ">&STDOUT_SAVED" or die "Can't dup STDOUT_SAVED: $!"; */
- /* open first closes STDOUT */
- status = Perl_do_open9(aTHX_ handle_orig, ">&", 2, FALSE, O_WRONLY,
- 0, Nullfp, (SV*)handle, 1);
- Perl_do_close(aTHX_ handle, FALSE);
- (void)hv_delete(gv_stashpv("Apache::RequestIO", TRUE),
- GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to restore STDOUT: %_", get_sv("!", TRUE));
+
+ /* close the overriding filehandle */
+ Perl_do_close(aTHX_ 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, "restoring STDOUT");
+
+ if (Perl_do_open9(aTHX_ handle_orig, ">&", 2, FALSE,
+ O_WRONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
+ err = get_sv("!", TRUE);
+ }
+
+ Perl_do_close(aTHX_ handle, FALSE);
+ (void)hv_delete(gv_stashpv("Apache::RequestIO", TRUE),
+ GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
+
+ if (err != Nullsv) {
+ Perl_croak(aTHX_ "Failed to restore STDOUT: %_", err);
+ }
}
MP_TRACE_o(MP_FUNC, "end\n");
1.1 modperl-2.0/t/response/TestModperl/io_nested_with_closed_stds.pm
Index: io_nested_with_closed_stds.pm
===================================================================
package TestModperl::io_nested_with_closed_stds;
# test that we can successfully override STD(IN|OUT) for
# 'perl-script', even if they are closed. Here we use
# internal_redirect(), which causes a nested override of already
# overriden STD streams
use strict;
use warnings FATAL => 'all';
use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::SubRequest ();
use Apache::Test;
use Apache::Const -compile => 'OK';
sub handler {
my $r = shift;
my $args = $r->args || '';
if ($args eq 'redirect') {
# sub-req
$r->content_type('text/plain');
# do not use plan() here, since it messes up with STDOUT,
# which affects this test.
print "1..1\nok 1\n";
}
else {
# main-req
my $redirect_uri = $r->uri . "?redirect";
# we must close STDIN as well, due to a perl bug (5.8.0 - 5.8.3
# w/useperlio), which emits a warning if dup is called with
# one of the STD streams is closed.
# but we must restore the STD streams so not to affect other
# tests.
open my $oldin, "<&STDIN" or die "Can't dup STDIN: $!";
open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
close STDIN;
close STDOUT;
$r->internal_redirect($redirect_uri);
open STDIN, "<&", $oldin or die "Can't dup \$oldin: $!";
open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
close $oldin;
close $oldout;
}
Apache::OK;
}
1;
__DATA__
SetHandler perl-script
1.1 modperl-2.0/t/response/TestModperl/io_with_closed_stds.pm
Index: io_with_closed_stds.pm
===================================================================
package TestModperl::io_with_closed_stds;
# test that we can successfully override STD(IN|OUT) for
# 'perl-script', even if they are closed.
use strict;
use warnings FATAL => 'all';
use Apache::RequestRec ();
use Apache::RequestUtil ();
use Apache::RequestIO ();
use Apache::SubRequest ();
use Apache::Test;
use Apache::Const -compile => 'OK';
sub fixup {
my $r = shift;
# we must close STDIN as well, due to a perl bug (5.8.0 - 5.8.3
# w/useperlio), which emits a warning if dup is called with
# one of the STD streams is closed.
open my $oldin, "<&STDIN" or die "Can't dup STDIN: $!";
open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
close STDIN;
close STDOUT;
$r->pnotes(oldin => $oldin);
$r->pnotes(oldout => $oldout);
Apache::OK;
}
sub handler {
my $r = shift;
plan $r, tests => 1;
ok 1;
Apache::OK;
}
sub cleanup {
my $r = shift;
# restore the STD(IN|OUT) streams so not to affect other tests.
my $oldin = $r->pnotes('oldin');
my $oldout = $r->pnotes('oldout');
open STDIN, "<&", $oldin or die "Can't dup \$oldin: $!";
open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
close $oldin;
close $oldout;
Apache::OK;
}
1;
__DATA__
PerlModule TestModperl::io_with_closed_stds
SetHandler perl-script
PerlFixupHandler TestModperl::io_with_closed_stds::fixup
PerlResponseHandler TestModperl::io_with_closed_stds
PerlCleanupHandler TestModperl::io_with_closed_stds::cleanup
1.332 +4 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.331
retrieving revision 1.332
diff -u -u -r1.331 -r1.332
--- Changes 16 Feb 2004 19:58:18 -0000 1.331
+++ Changes 17 Feb 2004 01:22:42 -0000 1.332
@@ -12,6 +12,10 @@
=item 1.99_13-dev
+Fix the STDIN/OUT overriding process to handle gracefully cases, when
+either or both are closed/bogus (the problem was only with useperlio
+enabled perl) [Stas]
+
copy apr_table_compress logic from later httpd versions in case mod_perl
is built against 2.0.46, as mod_perl now requires it internally. users
should be aware that 2.0.47 may become the oldest supported httpd version
