Stephane, you are correct in your observations that original STDIN and
STDOUT filehandles are not preserved when perlio CGI mode is used.
This is because how Perl works. Consider the following perl program, run
from the command line (not mod_perl!):
#!/usr/bin/perl
use strict;
use warnings;
warn sprintf "%-11s %d\n", "STDIN", fileno(STDIN);
open STDIN_SAVED, "<&STDIN" or die "Can't dup STDIN: $!";
warn sprintf "%-11s %d\n", "STDIN_SAVED", fileno(STDIN_SAVED);
close STDIN;
open DUMMY, ">/dev/null" or die $!;
#open DUMMY, "</dev/random" or die $!;
warn sprintf "%-11s %d\n", "DUMMY", fileno(DUMMY);
open STDIN, "<&STDIN_SAVED" or die "Can't dup STDIN_SAVED: $!";
warn sprintf "%-11s %d\n", "STDIN", fileno(STDIN);
close STDIN_SAVED;
% perl-5.8.8-ithreads /tmp/test1
STDIN 0
STDIN_SAVED 3
Filehandle STDIN reopened as DUMMY only for output at /tmp/xxx line 14.
DUMMY 0
STDIN 4
as you can see DUMMY grabs the available fd 0. (not talking about the
problem that perl handles fd=0 as special, but only warns about it, were
you to use it to open "</dev/random" it'd have been quiet
Now obviously the solution in your case is to grab fd before anybody
else does and release it just before the original STDIN is restored.
Here is the adjusted program:
#!/usr/bin/perl
use strict;
use warnings;
warn sprintf "%-11s %d\n", "STDIN", fileno(STDIN);
# new!
open STDIN_SAVED, "<&STDIN" or die "Can't dup STDIN: $!";
warn sprintf "%-11s %d\n", "STDIN_SAVED", fileno(STDIN_SAVED);
close STDIN;
open SAVE_FD, "</dev/null" or die "Can't dup STDIN: $!";
warn sprintf "%-11s %d\n", "SAVE_FD", fileno(SAVE_FD);
open DUMMY, ">/dev/null" or die $!;
#open DUMMY, "</dev/random" or die $!;
warn sprintf "%-11s %d\n", "DUMMY", fileno(DUMMY);
# new!
close SAVE_FD;
open STDIN, "<&STDIN_SAVED" or die "Can't dup STDIN_SAVED: $!";
warn sprintf "%-11s %d\n", "STDIN", fileno(STDIN);
close STDIN_SAVED;
% perl-5.8.8-ithreads /tmp/test2
STDIN 0
STDIN_SAVED 3
SAVE_FD 0
DUMMY 4
STDIN 0
which is what you want.
But which file to open as a place holder? In this example I use
/dev/null and it works as you wish. AFAIK, windows doesn't have
/dev/null, unless you run on cygwin.
I thought to simply get the fd number and open ala fdopen,
[ open SAVE_FD, "<&=STDIN" ]
as you can see in the following example:
#!/usr/bin/perl
use strict;
use warnings;
warn sprintf "%-11s %d\n", "STDIN", fileno(STDIN);
# opening STDIN's fd directly, no dup!
open SAVE_FD, "<&=STDIN" or die "Can't dup STDIN: $!";
warn sprintf "%-11s %d\n", "SAVE_FD", fileno(SAVE_FD);
open STDIN_SAVED, "<&STDIN" or die "Can't dup STDIN: $!";
warn sprintf "%-11s %d\n", "STDIN_SAVED", fileno(STDIN_SAVED);
close STDIN;
warn sprintf "%-11s %d\n", "SAVE_FD", fileno(SAVE_FD);
open DUMMY, ">/dev/null" or die $!;
#open DUMMY, "</dev/random" or die $!;
warn sprintf "%-11s %d\n", "DUMMY", fileno(DUMMY);
# new!
close SAVE_FD;
open STDIN, "<&STDIN_SAVED" or die "Can't dup STDIN_SAVED: $!";
warn sprintf "%-11s %d\n", "STDIN", fileno(STDIN);
close STDIN_SAVED;
% perl-5.8.8-ithreads /tmp/test3
STDIN 0
SAVE_FD 0
STDIN_SAVED 3
SAVE_FD 0
Filehandle STDIN reopened as DUMMY only for output at /tmp/xxx1 line 18.
DUMMY 4
STDIN 0
as you can see that it works almost well:
+ the fd is restored correctly
- perl is not happy that we open a non "<" fh when STDIN is closed.
[this sounds like a bug in perl, but perlio is a very complicated thing,
so I won't be surprised if that's by design]
You can choose not to use perlio, by re-compiling perl with -Uuseperlio
and then rebuilding perl. I think it should do the trick as well, though
I didn't test it.
Here is a proof of concept patch for modperl_io.c, that does what you
want keeping perlio enabled (with a lot of debug statements). Though it
needs more work to permit re-entrance [hardcoded GENX2|4 symbols], which
will be quite tricky, since it requires internal API change, or some
trickery. [the patch is attached as well, if things get wrapped up]
Index: src/modules/perl/modperl_io.c
===================================================================
--- src/modules/perl/modperl_io.c (revision 524915)
+++ src/modules/perl/modperl_io.c (working copy)
@@ -108,14 +108,20 @@
{
dHANDLE("STDIN");
int status;
- GV *handle_save = (GV*)Nullsv;
+ GV *handle_save = (GV*)Nullsv;
+ GV *handle_save_fd = (GV*)Nullsv;
+
SV *sv = sv_newmortal();
+ fprintf(stderr, "STDIN orig: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle))));
+
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++),
@@ -132,6 +138,21 @@
* have file descriptors, so STDIN must be closed before it can
* be reopened */
do_close(handle, TRUE);
+
+ /* now grab the just released fd, normally 0 */
+ handle_save_fd = gv_fetchpv("GENX2", TRUE, SVt_PVIO);
+
+ /* open my $oldout, "<&=0" or die "Can't save STDIN's fd: $!"; */
+ status = do_open(handle_save_fd, "</dev/null", 10, FALSE,
+ O_RDONLY, 0, Nullfp);
+ if (status == 0) {
+ Perl_croak(aTHX_ "Failed to save STDIN's fd: %" SVf,
+ get_sv("!", TRUE));
+ }
+
+ fprintf(stderr, "saved STDIN fd: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle_save_fd))));
+
}
sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
@@ -142,6 +163,9 @@
}
MP_TRACE_o(MP_FUNC, "end\n");
+
+ fprintf(stderr, "STDIN dupped: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle))));
return handle_save;
}
@@ -152,8 +176,12 @@
dHANDLE("STDOUT");
int status;
GV *handle_save = (GV*)Nullsv;
+ GV *handle_save_fd = (GV*)Nullsv;
SV *sv = sv_newmortal();
+ fprintf(stderr, "STDOUT orig: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle))));
+
MP_TRACE_o(MP_FUNC, "start");
/* if STDOUT is open, dup it, to be restored at the end of response */
@@ -175,6 +203,21 @@
* have file descriptors, so STDOUT must be closed before it can
* be reopened */
do_close(handle, TRUE);
+
+
+ /* now grab the just released fd, normally 0 */
+ handle_save_fd = gv_fetchpv("GENX4", TRUE, SVt_PVIO);
+
+ /* open my $oldout, "<&=0" or die "Can't save STDIN's fd: $!"; */
+ status = do_open(handle_save_fd, ">/dev/null", 10, FALSE,
+ O_RDONLY, 0, Nullfp);
+ if (status == 0) {
+ Perl_croak(aTHX_ "Failed to save STDOUT's fd: %" SVf,
+ get_sv("!", TRUE));
+ }
+
+ fprintf(stderr, "saved STDOUT fd: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle_save_fd))));
}
sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
@@ -190,14 +233,17 @@
* overridden? */
IoFLUSH_off(handle); /* STDOUT's $|=0 */
+ fprintf(stderr, "STDOUT dupped: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle))));
+
return handle_save;
-
}
MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
{
GV *handle_orig = gv_fetchpv("STDIN", FALSE, SVt_PVIO);
-
+ GV *handle_save_fd = gv_fetchpv("GENX2", TRUE, SVt_PVIO);
+
MP_TRACE_o(MP_FUNC, "start");
/* close the overriding filehandle */
@@ -212,6 +258,8 @@
MP_TRACE_o(MP_FUNC, "restoring STDIN");
+ do_close(handle_save_fd, FALSE);
+
if (do_open9(handle_orig, "<&", 2, FALSE,
O_RDONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
err = get_sv("!", TRUE);
@@ -226,13 +274,16 @@
}
}
+ fprintf(stderr, "STDIN restored: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle_orig))));
+
MP_TRACE_o(MP_FUNC, "end\n");
}
MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle)
{
GV *handle_orig = gv_fetchpv("STDOUT", FALSE, SVt_PVIO);
-
+ GV *handle_save_fd = gv_fetchpv("GENX4", TRUE, SVt_PVIO);
MP_TRACE_o(MP_FUNC, "start");
/* since closing unflushed STDOUT may trigger a subrequest
@@ -259,6 +310,8 @@
MP_TRACE_o(MP_FUNC, "restoring STDOUT");
+ do_close(handle_save_fd, FALSE);
+
if (do_open9(handle_orig, ">&", 2, FALSE,
O_WRONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
err = get_sv("!", TRUE);
@@ -273,5 +326,8 @@
}
}
+ fprintf(stderr, "STDOUT restored: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle_orig))));
+
MP_TRACE_o(MP_FUNC, "end\n");
}
--
_____________________________________________________________
Stas Bekman mailto:[EMAIL PROTECTED] http://stason.org/
http://www.linkedin.com/in/stasbekman http://stasosphere.com/
The "Practical mod_perl" book http://modperlbook.org/
http://stason.org/photos/gallery/ http://healingcloud.com
Index: src/modules/perl/modperl_io.c
===================================================================
--- src/modules/perl/modperl_io.c (revision 524915)
+++ src/modules/perl/modperl_io.c (working copy)
@@ -108,14 +108,20 @@
{
dHANDLE("STDIN");
int status;
- GV *handle_save = (GV*)Nullsv;
+ GV *handle_save = (GV*)Nullsv;
+ GV *handle_save_fd = (GV*)Nullsv;
+
SV *sv = sv_newmortal();
+ fprintf(stderr, "STDIN orig: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle))));
+
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++),
@@ -132,6 +138,21 @@
* have file descriptors, so STDIN must be closed before it can
* be reopened */
do_close(handle, TRUE);
+
+ /* now grab the just released fd, normally 0 */
+ handle_save_fd = gv_fetchpv("GENX2", TRUE, SVt_PVIO);
+
+ /* open my $oldout, "<&=0" or die "Can't save STDIN's fd: $!"; */
+ status = do_open(handle_save_fd, "</dev/null", 10, FALSE,
+ O_RDONLY, 0, Nullfp);
+ if (status == 0) {
+ Perl_croak(aTHX_ "Failed to save STDIN's fd: %" SVf,
+ get_sv("!", TRUE));
+ }
+
+ fprintf(stderr, "saved STDIN fd: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle_save_fd))));
+
}
sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
@@ -142,6 +163,9 @@
}
MP_TRACE_o(MP_FUNC, "end\n");
+
+ fprintf(stderr, "STDIN dupped: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle))));
return handle_save;
}
@@ -152,8 +176,12 @@
dHANDLE("STDOUT");
int status;
GV *handle_save = (GV*)Nullsv;
+ GV *handle_save_fd = (GV*)Nullsv;
SV *sv = sv_newmortal();
+ fprintf(stderr, "STDOUT orig: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle))));
+
MP_TRACE_o(MP_FUNC, "start");
/* if STDOUT is open, dup it, to be restored at the end of response */
@@ -175,6 +203,21 @@
* have file descriptors, so STDOUT must be closed before it can
* be reopened */
do_close(handle, TRUE);
+
+
+ /* now grab the just released fd, normally 0 */
+ handle_save_fd = gv_fetchpv("GENX4", TRUE, SVt_PVIO);
+
+ /* open my $oldout, "<&=0" or die "Can't save STDIN's fd: $!"; */
+ status = do_open(handle_save_fd, ">/dev/null", 10, FALSE,
+ O_RDONLY, 0, Nullfp);
+ if (status == 0) {
+ Perl_croak(aTHX_ "Failed to save STDOUT's fd: %" SVf,
+ get_sv("!", TRUE));
+ }
+
+ fprintf(stderr, "saved STDOUT fd: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle_save_fd))));
}
sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
@@ -190,14 +233,17 @@
* overridden? */
IoFLUSH_off(handle); /* STDOUT's $|=0 */
+ fprintf(stderr, "STDOUT dupped: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle))));
+
return handle_save;
-
}
MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
{
GV *handle_orig = gv_fetchpv("STDIN", FALSE, SVt_PVIO);
-
+ GV *handle_save_fd = gv_fetchpv("GENX2", TRUE, SVt_PVIO);
+
MP_TRACE_o(MP_FUNC, "start");
/* close the overriding filehandle */
@@ -212,6 +258,8 @@
MP_TRACE_o(MP_FUNC, "restoring STDIN");
+ do_close(handle_save_fd, FALSE);
+
if (do_open9(handle_orig, "<&", 2, FALSE,
O_RDONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
err = get_sv("!", TRUE);
@@ -226,13 +274,16 @@
}
}
+ fprintf(stderr, "STDIN restored: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle_orig))));
+
MP_TRACE_o(MP_FUNC, "end\n");
}
MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle)
{
GV *handle_orig = gv_fetchpv("STDOUT", FALSE, SVt_PVIO);
-
+ GV *handle_save_fd = gv_fetchpv("GENX4", TRUE, SVt_PVIO);
MP_TRACE_o(MP_FUNC, "start");
/* since closing unflushed STDOUT may trigger a subrequest
@@ -259,6 +310,8 @@
MP_TRACE_o(MP_FUNC, "restoring STDOUT");
+ do_close(handle_save_fd, FALSE);
+
if (do_open9(handle_orig, ">&", 2, FALSE,
O_WRONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
err = get_sv("!", TRUE);
@@ -273,5 +326,8 @@
}
}
+ fprintf(stderr, "STDOUT restored: %d\n",
+ (int)PerlIO_fileno(IoIFP(GvIOn(handle_orig))));
+
MP_TRACE_o(MP_FUNC, "end\n");
}
