MP_INLINE static void modperl_io_perlio_restore_stdhandle(pTHX_ int mode) { GV *handle_orig = gv_fetchpv(mode == O_RDONLY ? "STDIN" : "STDOUT", FALSE, SVt_PVIO); 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 * handler call, which may try to close STDOUT too. We will * segfault, if that subrequest doesn't return before the the top * level STDOUT is attempted to be closed. To prevent this * situation always explicitly flush STDOUT, before reopening it. */ 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)); } /* close the overriding filehandle */ do_close(handle_orig, FALSE); MP_TRACE_o(MP_FUNC, "end STD%s", mode == O_RDONLY ? "IN" : "OUT"); }
MP_INLINE static void modperl_io_perlio_override_stdhandle(pTHX_ request_rec *r, int mode) { dHANDLE(mode == O_RDONLY ? "STDIN" : "STDOUT"); int status; SV *sv = sv_newmortal(); MP_TRACE_o(MP_FUNC, "start STD%s", mode == O_RDONLY ? "IN" : "OUT"); save_gp(handle, 1); sv_setref_pv(sv, "Apache2::RequestRec", (void*)r); status = do_open9(handle, mode == O_RDONLY ? "<:Apache2" : ">:Apache2", 9, FALSE, mode, 0, (PerlIO *)NULL, sv, 1); if (status == 0) { Perl_croak(aTHX_ "Failed to open STD%s: %" SVf, mode == O_RDONLY ? "IN" : "OUT", get_sv("!", TRUE)); } MP_TRACE_o(MP_FUNC, "end STD%s", mode==O_RDONLY ? "IN" : "OUT"); }
MP_INLINE SV *modperl_slurp_filename(pTHX_ request_rec *r, int tainted) { SV *sv; apr_status_t rc; apr_size_t size; apr_file_t *file; size = r->finfo.size; sv = newSV(size); /* XXX: could have checked whether r->finfo.filehand is valid and * save the apr_file_open call, but apache gives us no API to * check whether filehand is valid. we can't test whether it's * NULL or not, as it may contain garbagea */ rc = apr_file_open(&file, r->filename, APR_READ|APR_BINARY, APR_OS_DEFAULT, r->pool); SLURP_SUCCESS("opening"); rc = apr_file_read(file, SvPVX(sv), &size); SLURP_SUCCESS("reading"); MP_TRACE_o(MP_FUNC, "read %d bytes from '%s'", size, r->filename); if (r->finfo.size != size) { SvREFCNT_dec(sv); Perl_croak(aTHX_ "Error: read %d bytes, expected %d ('%s')", size, (apr_size_t)r->finfo.size, r->filename); } rc = apr_file_close(file); SLURP_SUCCESS("closing"); SvPVX(sv)[size] = '\0'; SvCUR_set(sv, size); SvPOK_on(sv); if (tainted) { SvTAINTED_on(sv); } else { SvTAINTED_off(sv); } return newRV_noinc(sv); }