Torsten can you post a breakdown of each part in the patch so those of
us who can't grok all of it (I'm one of them!) can get a handle (no
pun intended) on what each part does?

2010/3/30 Fred Moyer <f...@redhotpenguin.com>:
> 2010/3/30 Torsten Förtsch <torsten.foert...@gmx.net>:
>> Hi,
>>
>> the patch below is a raw fix for the "mod_perl closes apache's stdin and/or
>> stdout"-bug, see also
>>
>>  http://www.gossamer-threads.com/lists/modperl/modperl/94921
>
> Posting a copy of the patch inline for the archives.  Thanks for
> putting this together Torsten.
>
> Index: src/modules/perl/modperl_io.c
> ===================================================================
> --- src/modules/perl/modperl_io.c       (revision 929182)
> +++ src/modules/perl/modperl_io.c       (working copy)
> @@ -104,28 +104,39 @@
>     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");
> -    int status;
> +    dHANDLE(mode == O_RDONLY ? "STDIN" : "STDOUT");
> +    int status, fileno;
>     GV *handle_save = (GV*)Nullsv;
>     SV *sv = sv_newmortal();
> +    SV *gsv;
> +    IO *io;
>
> -    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(io=GvIO(handle)) != IoTYPE_CLOSED &&
> +       (fileno=PerlIO_fileno(IoIFP(io))) >= 0) {
>         handle_save = gv_fetchpv(Perl_form(aTHX_
>                                            "Apache2::RequestIO::_GEN_%ld",
>                                            (long)PL_gensym++),
> -                                 TRUE, SVt_PVIO);
> +                                 GV_ADD, SVt_PVIO);
> +       if (!GvSV(handle_save)) GvSV(handle_save) = newSV(0);
> +       gsv=GvSV(handle_save);
>
> -        /* open my $oldout, "<&STDIN" or die "Can't dup STDIN: $!"; */
> -        status = do_open(handle_save, "<&STDIN", 7, FALSE,
> -                         O_RDONLY, 0, Nullfp);
> +        /* open my $oldout, "<&=".fileno(STDIN) or die "Can't dup
> STDIN: $!"; */
> +       SvUPGRADE(gsv, SVt_PV);
> +       SvGROW(gsv, 20);
> +       sv_setpvf(gsv, mode == O_RDONLY ? "<&=%d" : ">&=%d", fileno);
> +
> +        status = do_open(handle_save, SvPVX(GvSV(handle_save)),
> +                        SvCUR(GvSV(handle_save)), FALSE, mode, 0, Nullfp);
> +
>         if (status == 0) {
> -            Perl_croak(aTHX_ "Failed to dup STDIN: %" SVf, get_sv("!", 
> TRUE));
> +           Perl_croak(aTHX_ "Failed to dup STD%s: %" SVf,
> +                      mode == O_RDONLY ? "IN" : "OUT", get_sv("!", TRUE));
>         }
>
>         /* similar to PerlIO::scalar, the PerlIO::Apache layer doesn't
> @@ -135,105 +146,41 @@
>     }
>
>     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");
> -
> -    return handle_save;
> -}
> -
> -/* XXX: refactor to merge with the previous function */
> -MP_INLINE GV *modperl_io_perlio_override_stdout(pTHX_ request_rec *r)
> -{
> -    dHANDLE("STDOUT");
> -    int status;
> -    GV *handle_save = (GV*)Nullsv;
> -    SV *sv = sv_newmortal();
> -
> -    MP_TRACE_o(MP_FUNC, "start");
> -
> -    /* 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);
> +    if (mode == O_WRONLY) {
> +        /* XXX: shouldn't we preserve the value STDOUT had before it was
> +        * overridden? */
> +        IoFLUSH_off(handle); /* STDOUT's $|=0 */
>     }
>
> -    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 STD%s", mode==O_RDONLY ? "IN" : "OUT");
>
> -    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)
> +MP_INLINE GV *modperl_io_perlio_override_stdin(pTHX_ request_rec *r)
>  {
> -    GV *handle_orig = gv_fetchpv("STDIN", FALSE, SVt_PVIO);
> +    return modperl_io_perlio_override_stdhandle(aTHX_ r, O_RDONLY);
> +}
>
> -    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");
> +/* XXX: refactor to merge with the previous function */
> +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_stdout(pTHX_ GV *handle)
> +static void modperl_io_perlio_restore_stdhandle(pTHX_ GV *handle, int mode)
>  {
> -    GV *handle_orig = gv_fetchpv("STDOUT", FALSE, SVt_PVIO);
> +    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");
>
>     /* since closing unflushed STDOUT may trigger a subrequest
>      * (e.g. via mod_include), resulting in potential another response
> @@ -242,7 +189,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_WRONLY &&
> +       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));
>     }
> @@ -251,16 +199,15 @@
>     do_close(handle_orig, FALSE);
>
>     /*
> -     * open STDOUT, ">&STDOUT_SAVED" or die "Can't dup STDOUT_SAVED: $!";
> -     * close STDOUT_SAVED;
> +     * open STDIN, "<&=$FD_SAVED" or die "Can't dup STDIN_SAVED: $!";
>      */
>     if (handle != (GV*)Nullsv) {
>         SV *err = Nullsv;
>
> -        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) {
> +        if (do_open(handle_orig, SvPVX(GvSV(handle)), SvCUR(GvSV(handle)),
> +                   FALSE, mode, 0, NULL) == 0) {
>             err = get_sv("!", TRUE);
>         }
>
> @@ -269,9 +216,21 @@
>                         GvNAME(handle), GvNAMELEN(handle), G_DISCARD);
>
>         if (err != Nullsv) {
> -            Perl_croak(aTHX_ "Failed to restore STDOUT: %" SVf, err);
> +           Perl_croak(aTHX_ "Failed to restore STD: %" SVf,
> +                      mode == O_RDONLY ? "IN" : "OUT", err);
>         }
>     }
>
> -    MP_TRACE_o(MP_FUNC, "end");
> +    MP_TRACE_o(MP_FUNC, "end STD%s", mode == O_RDONLY ? "IN" : "OUT");
>  }
> +
> +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);
> +}
> +
>
>
>
>>
>> Previously the code did something similar to
>>
>>  open SAVEFH, '<&STDIN';
>>  close STDIN;
>>  ...
>>  open STDIN, '<&SAVEFH';
>>
>> The idea is to change that into
>>
>>  open SAVEFH, '<&='.fileno(STDIN);
>>  close STDIN;
>>  ...
>>  open STDIN, '<&='.fileno(SAVEFH);
>>
>> This avoids calling dup().
>>
>> This is the first time I do something Perl-IO-related in C. So, please 
>> review!
>> One thing that I don't understand is the difference between IoIFP and IoOFP.
>> Why does perl need 2 such structures to hold 1 file handle?
>>
>> Torsten Förtsch
>>
>> --
>> Need professional modperl support? Hire me! (http://foertsch.name)
>>
>> Like fantasy? http://kabatinte.net
>>
>>
>> ---------------------------------------------------------------------
>> To unsubscribe, e-mail: dev-unsubscr...@perl.apache.org
>> For additional commands, e-mail: dev-h...@perl.apache.org
>>
>

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscr...@perl.apache.org
For additional commands, e-mail: dev-h...@perl.apache.org

Reply via email to