blob: d4775975a0e3bf0ec86db3a14716ae040fc2d02a [file] [log] [blame]
/* Licensed to the Apache Software Foundation (ASF) under one or more
* contributor license agreements. See the NOTICE file distributed with
* this work for additional information regarding copyright ownership.
* The ASF licenses this file to You under the Apache License, Version 2.0
* (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*/
#ifdef WIN32
/* win32 not happy with &PL_sv_no */
# define SVNO newSViv(0)
# define SVYES newSViv(1)
#else
# define SVNO &PL_sv_no
# define SVYES &PL_sv_yes
#endif
#define mpxs_Apache2__RequestRec_TIEHANDLE(stashsv, sv) \
modperl_newSVsv_obj(aTHX_ stashsv, sv)
#define mpxs_Apache2__RequestRec_PRINT mpxs_Apache2__RequestRec_print
#define mpxs_Apache2__RequestRec_PRINTF mpxs_ap_rprintf
#define mpxs_Apache2__RequestRec_BINMODE(r) \
r ? SVYES : SVNO /* noop */
#define mpxs_Apache2__RequestRec_CLOSE(r) \
r ? SVYES : SVNO /* noop */
#define mpxs_Apache2__RequestRec_UNTIE(r, refcnt) \
(r && refcnt) ? SVYES : SVNO /* noop */
#define mpxs_output_flush(r, rcfg, name) \
/* if ($|) */ \
if (IoFLUSH(PL_defoutgv)) { \
MP_TRACE_o(MP_FUNC, "(flush) %d bytes [%s]", \
rcfg->wbucket->outcnt, \
apr_pstrmemdup(rcfg->wbucket->pool, rcfg->wbucket->outbuf, \
rcfg->wbucket->outcnt)); \
MP_RUN_CROAK(modperl_wbucket_flush(rcfg->wbucket, TRUE), \
name); \
}
static MP_INLINE apr_size_t mpxs_ap_rvputs(pTHX_ I32 items,
SV **MARK, SV **SP)
{
modperl_config_req_t *rcfg;
apr_size_t bytes = 0;
request_rec *r;
dMP_TIMES;
mpxs_usage_va_1(r, "$r->puts(...)");
rcfg = modperl_config_req_get(r);
MP_START_TIMES();
MP_CHECK_WBUCKET_INIT("$r->puts");
mpxs_write_loop(modperl_wbucket_write, rcfg->wbucket,
"Apache2::RequestIO::puts");
MP_END_TIMES();
MP_PRINT_TIMES("r->puts");
/* we do not check $| for this method,
* only in the functions called by the tied interface
*/
return bytes;
}
static MP_INLINE
SV *mpxs_Apache2__RequestRec_print(pTHX_ I32 items,
SV **MARK, SV **SP)
{
modperl_config_req_t *rcfg;
request_rec *r;
/* bytes must be called bytes */
apr_size_t bytes = 0;
/* this also magically assings to r ;-) */
mpxs_usage_va_1(r, "$r->print(...)");
rcfg = modperl_config_req_get(r);
MP_CHECK_WBUCKET_INIT("$r->print");
mpxs_write_loop(modperl_wbucket_write, rcfg->wbucket,
"Apache2::RequestIO::print");
mpxs_output_flush(r, rcfg, "Apache2::RequestIO::print");
return bytes ? newSVuv(bytes) : newSVpvn("0E0", 3);
}
static MP_INLINE
apr_size_t mpxs_ap_rprintf(pTHX_ I32 items, SV **MARK, SV **SP)
{
modperl_config_req_t *rcfg;
request_rec *r;
apr_size_t bytes = 0;
SV *sv;
mpxs_usage_va(2, r, "$r->printf($fmt, ...)");
rcfg = modperl_config_req_get(r);
/* Reduce items by 1 since it otherwise includes the
* Apache2::RequestRec object, which shouldn't be included in the
* count of arguments being given to the sprintf() call.
*/
--items;
/* XXX: we could have an rcfg->sprintf_buffer to reuse this SV
* across requests
*/
sv = sv_newmortal();
modperl_perl_do_sprintf(aTHX_ sv, items, MARK);
bytes = SvCUR(sv);
MP_CHECK_WBUCKET_INIT("$r->printf");
MP_TRACE_o(MP_FUNC, "%d bytes [%s]", bytes, SvPVX(sv));
MP_RUN_CROAK(modperl_wbucket_write(aTHX_ rcfg->wbucket,
SvPVX(sv), &bytes),
"Apache2::RequestIO::printf");
mpxs_output_flush(r, rcfg, "Apache2::RequestIO::printf");
return bytes;
}
/* alias */
#define mpxs_Apache2__RequestRec_WRITE(r, buffer, len, offset) \
mpxs_Apache2__RequestRec_write(aTHX_ r, buffer, len, offset)
static MP_INLINE
apr_size_t mpxs_Apache2__RequestRec_write(pTHX_ request_rec *r,
SV *buffer, apr_size_t len,
apr_off_t offset)
{
apr_size_t wlen;
const char *buf;
STRLEN avail;
MP_dRCFG;
buf = (const char *)SvPV(buffer, avail);
if (len == -1) {
wlen = offset ? avail - offset : avail;
}
else {
wlen = len;
}
MP_CHECK_WBUCKET_INIT("$r->write");
MP_RUN_CROAK(modperl_wbucket_write(aTHX_ rcfg->wbucket,
buf+offset, &wlen),
"Apache2::RequestIO::write");
return wlen;
}
static MP_INLINE
void mpxs_Apache2__RequestRec_rflush(pTHX_ I32 items,
SV **MARK, SV **SP)
{
modperl_config_req_t *rcfg;
request_rec *r;
/* this also magically assings to r ;-) */
mpxs_usage_va_1(r, "$r->rflush()");
rcfg = modperl_config_req_get(r);
MP_CHECK_WBUCKET_INIT("$r->rflush");
MP_TRACE_o(MP_FUNC, "%d bytes [%s]",
rcfg->wbucket->outcnt,
apr_pstrmemdup(rcfg->wbucket->pool, rcfg->wbucket->outbuf,
rcfg->wbucket->outcnt));
MP_RUN_CROAK_RESET_OK(r->server,
modperl_wbucket_flush(rcfg->wbucket, TRUE),
"Apache2::RequestIO::rflush");
}
static MP_INLINE long mpxs_ap_get_client_block(pTHX_ request_rec *r,
SV *buffer, int bufsiz)
{
long nrd = 0;
mpxs_sv_grow(buffer, bufsiz);
nrd = ap_get_client_block(r, SvPVX(buffer), bufsiz);
if (nrd > 0) {
mpxs_sv_cur_set(buffer, nrd);
SvTAINTED_on(buffer);
}
else {
sv_setpvn(buffer, "", 0);
}
/* must run any set magic */
SvSETMAGIC(buffer);
return nrd;
}
static MP_INLINE
apr_status_t mpxs_setup_client_block(request_rec *r)
{
if (!r->read_length) {
apr_status_t rc;
/* only do this once per-request */
if ((rc = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR)) != OK) {
ap_log_error(APLOG_MARK, APLOG_ERR, 0, r->server,
"mod_perl: ap_setup_client_block failed: %d", rc);
return rc;
}
}
return APR_SUCCESS;
}
#define mpxs_should_client_block(r) \
(r->read_length || ap_should_client_block(r))
#ifndef sv_setpvn_mg
# define sv_setpvn_mg sv_setpvn
#endif
/* alias */
#define mpxs_Apache2__RequestRec_READ(r, buffer, len, offset) \
mpxs_Apache2__RequestRec_read(aTHX_ r, buffer, len, offset)
static SV *mpxs_Apache2__RequestRec_read(pTHX_ request_rec *r,
SV *buffer, apr_size_t len,
apr_off_t offset)
{
SSize_t total;
STRLEN blen;
if (!SvOK(buffer)) {
sv_setpvn_mg(buffer, "", 0);
}
(void)SvPV_force(buffer, blen); /* make it a valid PV */
if (len <= 0) {
Perl_croak(aTHX_ "The LENGTH argument can't be negative");
}
/* handle negative offset */
if (offset < 0) {
if (-offset > (int)blen) Perl_croak(aTHX_ "Offset outside string");
offset += blen;
}
mpxs_sv_grow(buffer, len+offset);
/* need to pad with \0 if offset > size of the buffer */
if (offset > SvCUR(buffer)) {
Zero(SvEND(buffer), offset - SvCUR(buffer), char);
}
total = modperl_request_read(aTHX_ r, SvPVX(buffer)+offset, len);
/* modperl_request_read can return only >=0. So it's safe to do this. */
/* if total==0 we need to set the buffer length in case it is larger */
mpxs_sv_cur_set(buffer, offset+total);
/* must run any set magic */
SvSETMAGIC(buffer);
SvTAINTED_on(buffer);
return newSViv(total);
}
static MP_INLINE
SV *mpxs_Apache2__RequestRec_GETC(pTHX_ request_rec *r)
{
char c[1] = "\0";
/* XXX: reimplement similar to read() w/o using the deprecated
* client_block interface */
if (mpxs_setup_client_block(r) == APR_SUCCESS) {
if (mpxs_should_client_block(r)) {
if (ap_get_client_block(r, c, 1) == 1) {
return newSVpvn((char *)&c, 1);
}
}
}
return &PL_sv_undef;
}
static MP_INLINE
int mpxs_Apache2__RequestRec_OPEN(pTHX_ SV *self, SV *arg1, SV *arg2)
{
char *name;
STRLEN len;
SV *arg;
dHANDLE("STDOUT");
modperl_io_handle_untie(aTHX_ handle); /* untie *STDOUT */
if (arg2 && self) {
arg = newSVsv(arg1);
sv_catsv(arg, arg2);
}
else {
arg = arg1;
}
name = SvPV(arg, len);
return do_open(handle, name, len, FALSE, O_RDONLY, 0, (PerlIO *)NULL);
}
static MP_INLINE
int mpxs_Apache2__RequestRec_FILENO(pTHX_ request_rec *r)
{
dHANDLE("STDOUT");
return PerlIO_fileno(IoOFP(TIEHANDLE_SV(handle)));
}
static MP_INLINE
apr_status_t mpxs_Apache2__RequestRec_sendfile(pTHX_ request_rec *r,
const char *filename,
apr_off_t offset,
apr_size_t len)
{
apr_size_t nbytes;
apr_status_t rc;
apr_file_t *fp;
rc = apr_file_open(&fp, filename, APR_READ|APR_BINARY,
APR_OS_DEFAULT, r->pool);
if (rc != APR_SUCCESS) {
if (GIMME_V == G_VOID) {
modperl_croak(aTHX_ rc,
apr_psprintf(r->pool,
"Apache2::RequestIO::sendfile('%s')",
filename));
}
else {
return rc;
}
}
if (!len) {
apr_finfo_t finfo;
apr_file_info_get(&finfo, APR_FINFO_SIZE, fp);
len = finfo.size;
if (offset) {
len -= offset;
}
}
/* flush any buffered modperl output */
{
modperl_config_req_t *rcfg = modperl_config_req_get(r);
MP_CHECK_WBUCKET_INIT("$r->rflush");
if (rcfg->wbucket->outcnt) {
MP_TRACE_o(MP_FUNC, "flushing %d bytes [%s]",
rcfg->wbucket->outcnt,
apr_pstrmemdup(rcfg->wbucket->pool,
rcfg->wbucket->outbuf,
rcfg->wbucket->outcnt));
MP_RUN_CROAK(modperl_wbucket_flush(rcfg->wbucket, TRUE),
"Apache2::RequestIO::sendfile");
}
}
rc = ap_send_fd(fp, r, offset, len, &nbytes);
/* apr_file_close(fp); */ /* do not do this */
if (GIMME_V == G_VOID && rc != APR_SUCCESS) {
modperl_croak(aTHX_ rc, "Apache2::RequestIO::sendfile");
}
return rc;
}
/*
* Local Variables:
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*/