On Wednesday 31 March 2010 17:55:47 Fred Moyer wrote:
Can you repost the latest patch inline so that interested parties can
add comments and understand what is going on in there? I know that
only a few people understand the innards of mod_perl with XS magic,
but just getting it out there will help with that and the more eyes on
the code the better.
Let me explain what the patch does. As mentioned before the previous code did
something like this:
open SAVEFH, '<&STDIN';
close STDIN;
...
open STDIN, '<&SAVEFH';
This code opens SAVEFH on a different file descriptor. Before STDIN is closed
fileno(SAVEFH)!=fileno(STDIN). Later, when STDIN is restored from STDIN it is
still the same file but it is not necessarily bound to file descriptor 0. This
is the heart of the problem.
My first solution replaced the dup() by an fdopen(). Thus, the file descriptor
remains the same.
open SAVEFH, '<&='.fileno(STDIN);
close STDIN;
...
open STDIN, '<&='.fileno(SAVEFH);
But in Perl there is more data related to a file handle save for the file
descriptor. There are flags like $|, integer values like $. or $=, even GVs.
Both of the approaches above destroy that information.
After studying Reini Urban's and Gisle Aas' illguts document:
http://rurban.xarch.at/software/perl/illguts/
http://cpansearch.perl.org/src/GAAS/illguts-0.09/index.html
it occurred to me that just exchanging one pointer would be enough to solve
all the problems.
GvIO(handle) returns an IO* pointer. The first element of this structure, the
SvANY-element, points to a struct xpvio. This structure contains all of the
data related to a file handle except for the reference count.
So, to save a standard handle the code now creates a new GV. Then swaps its
SvANY(GvIO(newhandle)) for SvANY(GvIO(STDIN)). Now STDIN looks like a fresh,
still closed file handle. So it can be opened with the Apache2 perlio layer as
before.
The restoring code then flushes and closes the STD{IN,OUT} handle. After that
any resources bound to an open file handle are destroyed. So, it's safe to
undo the swap-operation. Then the temporary handle is destroyed and the
standard handle looks exactly the same as it has before the whole operation.
I think, this is the safest (and fastest) way to do preserve a file handle.
Now, one could do such stuff:
<Perl>
open STDIN, '<', '/dev/urandom';
{
package My::XXX;
use Apache2::RequestRec ();
use Apache2::Const -compile=>'OK';
sub handler {
my ($r)=...@_;
local $/=\10;
my $str=readline STDIN;
$r->print("$.: ".unpack('H*',$str)."\n");
return Apache2::Const::OK;
}
}
</Perl>
<Location /My__XXX/mp>
SetHandler modperl
PerlResponseHandler My::XXX
</Location>
<Location /My__XXX/ps>
SetHandler perl-script
PerlResponseHandler My::XXX
</Location>
and intermix calls to /My__XXX/mp with calls to /My__XXX/ps on the same apache
instance. And $. will still count upwards.
$ curl http://localhost:8529/My__XXX/mp
1: 645d1c3a880c15a4f889
$ curl http://localhost:8529/My__XXX/ps
0:
$ curl http://localhost:8529/My__XXX/mp
2: 86b0ebdc88936475ef21
$ curl http://localhost:8529/My__XXX/ps
0:
$ curl http://localhost:8529/My__XXX/mp
3: 91de660a45e64a2a6dfb
$ curl http://localhost:8529/My__XXX/ps
0:
$ curl http://localhost:8529/My__XXX/mp
4: f4184c04e20422a67bd9
httpd was started with -D ONE_PROCESS. $. is preserved.
Index: src/modules/perl/modperl_io.c
===================================================================
--- src/modules/perl/modperl_io.c (revision 929182)
+++ src/modules/perl/modperl_io.c (working copy)
@@ -104,137 +104,51 @@
sv_unmagic(TIEHANDLE_SV(handle), PERL_MAGIC_tiedscalar);
}
-MP_INLINE GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r)
+static GV *modperl_io_perlio_override_stdhandle(pTHX_ request_rec *r, int
mode)
{
- dHANDLE("STDIN");
+ dHANDLE(mode == O_RDONLY ? "STDIN" : "STDOUT");
int status;
GV *handle_save = (GV*)Nullsv;
SV *sv = sv_newmortal();
+ IO *srcio, *destio;
+ void *tmp;
- MP_TRACE_o(MP_FUNC, "start");
+ MP_TRACE_o(MP_FUNC, "start STD%s", mode == O_RDONLY ? "IN" : "OUT");
- /* 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) {
+ IoTYPE(srcio=GvIO(handle)) != IoTYPE_CLOSED) {
handle_save = gv_fetchpv(Perl_form(aTHX_
"Apache2::RequestIO::_GEN_%ld",
(long)PL_gensym++),
- TRUE, SVt_PVIO);
+ GV_ADD, 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));
- }
+ destio=GvIO(handle_save);
- /* 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);
+ tmp=SvANY(destio);
+ SvANY(destio)=SvANY(srcio);
+ SvANY(srcio)=tmp;
}
sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
- status = do_open9(handle, "<:Apache2", 9, FALSE, O_RDONLY,
- 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 STDIN: %" 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");
+ MP_TRACE_o(MP_FUNC, "end STD%s", mode==O_RDONLY ? "IN" : "OUT");
return handle_save;
}
-/* XXX: refactor to merge with the previous function */
-MP_INLINE GV *modperl_io_perlio_override_stdout(pTHX_ request_rec *r)
+static void modperl_io_perlio_restore_stdhandle(pTHX_ GV *handle, int mode)
{
- dHANDLE("STDOUT");
- int status;
- GV *handle_save = (GV*)Nullsv;
- SV *sv = sv_newmortal();
+ GV *handle_orig = gv_fetchpv(mode == O_RDONLY ? "STDIN" : "STDOUT",
+ FALSE, SVt_PVIO);
- 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);
- }
-
- sv_setref_pv(sv, "Apache2::RequestRec", (void*)r);
- status = do_open9(handle, ">:Apache2", 9, FALSE, O_WRONLY,
- 0, Nullfp, sv, 1);
- if (status == 0) {
- Perl_croak(aTHX_ "Failed to open STDOUT: %" SVf, 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_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
-{
- GV *handle_orig = gv_fetchpv("STDIN", FALSE, SVt_PVIO);
-
- MP_TRACE_o(MP_FUNC, "start");
-
- /* close the overriding filehandle */
- do_close(handle_orig, FALSE);
-
- /*
- * 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");
-
/* since closing unflushed STDOUT may trigger a subrequest
* (e.g. via mod_include), resulting in potential another response
* handler call, which may try to close STDOUT too. We will
@@ -242,7 +156,8 @@
* 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 +165,43 @@
/* 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;
+ IO *srcio, *destio;
+ void *tmp;
- MP_TRACE_o(MP_FUNC, "restoring STDOUT");
+ MP_TRACE_o(MP_FUNC, "restoring STD%s", mode == O_RDONLY ? "IN" :
"OUT");
- if (do_open9(handle_orig, ">&", 2, FALSE,
- O_WRONLY, 0, Nullfp, (SV*)handle, 1) == 0) {
- err = get_sv("!", TRUE);
- }
+ srcio=GvIO(handle);
+ destio=GvIO(handle_orig);
- do_close(handle, FALSE);
+ tmp=SvANY(destio);
+ SvANY(destio)=SvANY(srcio);
+ SvANY(srcio)=tmp;
+
(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_TRACE_o(MP_FUNC, "end");
+ MP_TRACE_o(MP_FUNC, "end STD%s", mode == O_RDONLY ? "IN" : "OUT");
}
+
+MP_INLINE GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r)
+{
+ return modperl_io_perlio_override_stdhandle(aTHX_ r, O_RDONLY);
+}
+
+MP_INLINE GV *modperl_io_perlio_override_stdout(pTHX_ request_rec *r)
+{
+ return modperl_io_perlio_override_stdhandle(aTHX_ r, O_WRONLY);
+}
+
+MP_INLINE void modperl_io_perlio_restore_stdin(pTHX_ GV *handle)
+{
+ modperl_io_perlio_restore_stdhandle(aTHX_ handle, O_RDONLY);
+}
+
+MP_INLINE void modperl_io_perlio_restore_stdout(pTHX_ GV *handle)
+{
+ modperl_io_perlio_restore_stdhandle(aTHX_ handle, O_WRONLY);
+}
+
Torsten Förtsch
