/* ====================================================================
 * The Apache Software License, Version 1.1
 *
 * Copyright (c) 1996-2000 The Apache Software Foundation.  All rights
 * reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 *
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in
 *    the documentation and/or other materials provided with the
 *    distribution.
 *
 * 3. The end-user documentation included with the redistribution,
 *    if any, must include the following acknowledgment:
 *       "This product includes software developed by the
 *        Apache Software Foundation (http://www.apache.org/)."
 *    Alternately, this acknowledgment may appear in the software itself,
 *    if and wherever such third-party acknowledgments normally appear.
 *
 * 4. The names "Apache" and "Apache Software Foundation" must
 *    not be used to endorse or promote products derived from this
 *    software without prior written permission. For written
 *    permission, please contact apache@apache.org.
 *
 * 5. Products derived from this software may not be called "Apache",
 *    nor may "Apache" appear in their name, without prior written
 *    permission of the Apache Software Foundation.
 *
 * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED.  IN NO EVENT SHALL THE APACHE SOFTWARE FOUNDATION OR
 * ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
 * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
 * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 * ====================================================================
 */
#define CORE_PRIVATE
#include "mod_perl.h"
#include "mod_perl_xs.h"
#ifdef USE_SFIO
#undef send_fd_length    
static long send_fd_length(FILE *f, request_rec *r, long length)
{
    croak("Apache::send_fd() not supported with sfio");
    return 0;
}
#endif
#if defined(PERL_STACKED_HANDLERS) && defined(PERL_GET_SET_HANDLERS)
#define PER_DIR_CONFIG 1
#define PER_SRV_CONFIG 2
typedef struct {
    int type;
    char *name;
    void *offset;
    void (*set_func) (void *, void *, SV *);
} perl_handler_table;
typedef struct {
    I32 fill;
    AV *av;
    AV **ptr;
} perl_save_av;
static void set_handler_dir (perl_handler_table *tab, request_rec *r, SV *sv);
static void set_handler_srv (perl_handler_table *tab, request_rec *r, SV *sv);
#define HandlerDirEntry(name,member) \
PER_DIR_CONFIG, name, (void*)XtOffsetOf(perl_dir_config,member), \
(void(*)(void *, void *, SV *)) set_handler_dir
#define HandlerSrvEntry(name,member) \
PER_SRV_CONFIG, name, (void*)XtOffsetOf(perl_server_config,member), \
(void(*)(void *, void *, SV *)) set_handler_srv
static perl_handler_table handler_table[] = {
    {HandlerSrvEntry("PerlPostReadRequestHandler", PerlPostReadRequestHandler)},
    {HandlerSrvEntry("PerlTransHandler", PerlTransHandler)},
    {HandlerDirEntry("PerlHeaderParserHandler", PerlHeaderParserHandler)},
    {HandlerDirEntry("PerlAccessHandler", PerlAccessHandler)},
    {HandlerDirEntry("PerlAuthenHandler", PerlAuthenHandler)},
    {HandlerDirEntry("PerlAuthzHandler", PerlAuthzHandler)},
    {HandlerDirEntry("PerlTypeHandler", PerlTypeHandler)},
    {HandlerDirEntry("PerlFixupHandler", PerlFixupHandler)},
    {HandlerDirEntry("PerlHandler", PerlHandler)},
    {HandlerDirEntry("PerlLogHandler", PerlLogHandler)},
    {HandlerDirEntry("PerlCleanupHandler", PerlCleanupHandler)},
    { FALSE, NULL }
};
static void perl_restore_av(void *data)
{
    perl_save_av *save_av = (perl_save_av *)data;
    if(save_av->fill != DONE) {
        AvFILLp(*save_av->ptr) = save_av->fill;
    }
    else if(save_av->av != Nullav) {
        *save_av->ptr = save_av->av;
    }
}
static void perl_handler_merge_avs(char *hook, AV **dest)
{
    int i = 0;
    HV *hv = perl_get_hv("Apache::PerlStackedHandlers", FALSE);
    SV **svp = hv_fetch(hv, hook, strlen(hook), FALSE);
    AV *base;
     
    if(!(svp && SvROK(*svp)))
        return;
    base = (AV*)SvRV(*svp);
    for(i=0; i<=AvFILL(base); i++) { 
        SV *sv = *av_fetch(base, i, FALSE);
        av_push(*dest, SvREFCNT_inc(sv));
    }
}
static void set_handler_base(void *ptr, perl_handler_table *tab, pool *p, SV *sv) 
{
    AV **av = (AV **)((char *)ptr + (int)(long)tab->offset);
    perl_save_av *save_av = 
        (perl_save_av *)palloc(p, sizeof(perl_save_av));
    save_av->fill = DONE;
    save_av->av = Nullav;
     
    if((sv == &sv_undef) || (SvIOK(sv) && SvIV(sv) == DONE)) {
        if(AvTRUE(*av)) {
            save_av->fill = AvFILL(*av);
            AvFILLp(*av) = -1;
        }
    }
    else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
        if(AvTRUE(*av))
            save_av->av = av_copy_array(*av);
        *av = (AV*)SvRV(sv);
        ++SvREFCNT(*av);
    }
    else {
        croak("Can't set_handler with that value");
    }
    save_av->ptr = av;
    register_cleanup(p, save_av, perl_restore_av, mod_perl_noop);
}
static void set_handler_dir(perl_handler_table *tab, request_rec *r, SV *sv)
{
    dPPDIR; 
    set_handler_base((void*)cld, tab, r->pool, sv);
}
static void set_handler_srv(perl_handler_table *tab, request_rec *r, SV *sv)
{
    dPSRV(r->server); 
    set_handler_base((void*)cls, tab, r->pool, sv);
}
static perl_handler_table *perl_handler_lookup(char *name)
{
    int i;
    for (i=0; handler_table[i].name; i++) {
        perl_handler_table *tab = &handler_table[i];
        if(strEQ(name, tab->name))
            return tab;
    }
    return NULL;
}
static SV *get_handlers(request_rec *r, char *hook)
{
    AV *avcopy;
    AV **av;
    dPPDIR;
    dPSRV(r->server);
    void *ptr;
    perl_handler_table *tab = perl_handler_lookup(hook);
    if(!tab) return Nullsv;
    if(tab->type == PER_DIR_CONFIG)
        ptr = (void*)cld;
    else
        ptr = (void*)cls;
    av = (AV **)((char *)ptr + (int)(long)tab->offset);
    if(*av) 
        avcopy = av_copy_array(*av);
    else
        avcopy = newAV();
    perl_handler_merge_avs(hook, &avcopy);
    return newRV_noinc((SV*)avcopy);
}
static void set_handlers(request_rec *r, SV *hook, SV *sv)
{
    dTHR;
    perl_handler_table *tab = perl_handler_lookup(SvPV(hook,na));
    if(tab && tab->set_func) 
        (*tab->set_func)(tab, r, sv);
    (void)hv_delete_ent(perl_get_hv("Apache::PerlStackedHandlers", FALSE),
                        hook, G_DISCARD, FALSE);
}
#endif
#if MODULE_MAGIC_NUMBER < 19970909
static void
child_terminate(request_rec *r)
{
#ifndef WIN32
    log_transaction(r);
#endif
    exit(0);
}
#endif
static char *custom_response(request_rec *r, int status, char *string, int reset)
{
    core_dir_config *conf = (core_dir_config *)
        get_module_config(r->per_dir_config, &core_module);
    int idx;
    char *retval = NULL;
    if(conf->response_code_strings == NULL) {
        conf->response_code_strings = (char **)
          pcalloc(perl_get_startup_pool(),
                  sizeof(*conf->response_code_strings) * 
                  RESPONSE_CODES);
    }
    idx = index_of_response(status);
    retval = conf->response_code_strings[idx];
    if (reset) {
        conf->response_code_strings[idx] = NULL;
    }
    else if (string) {
        conf->response_code_strings[idx] = 
            ((is_url(string) || (*string == '/')) && (*string != '"')) ? 
                pstrdup(r->pool, string) : pstrcat(r->pool, "\"", string, NULL);
    }
    return retval;
}
static void Apache_terminate_if_done(request_rec *r, int sts)
{
#ifndef WIN32
    if(Apache_exit_is_done(sts)) child_terminate(r);
#endif
}
#if MODULE_MAGIC_NUMBER < 19980317
int basic_http_header(request_rec *r);
#endif
#if MODULE_MAGIC_NUMBER < 19980201
unsigned get_server_port(const request_rec *r)
{
    unsigned port = r->server->port ? r->server->port : 80;
    return r->hostname ? ntohs(r->connection->local_addr.sin_port)
        : port;
}
#define get_server_name(r) \
    (r->hostname ? r->hostname : r->server->server_hostname) 
#endif
#if MODULE_MAGIC_AT_LEAST(19981108, 1)
#define mod_perl_define(sv,name) ap_exists_config_define(name)
#elif(MODULE_MAGIC_NUMBER >= MMN_131) && !defined(WIN32)
static int mod_perl_define(SV *sv, char *name)
{
    char **defines;
    int i;
    defines = (char **)ap_server_config_defines->elts;
    for (i = 0; i < ap_server_config_defines->nelts; i++) {
        if (strcmp(defines[i], name) == 0) {
            return 1;
        }
    }
    return 0;
}
#else
#define mod_perl_define(sv,name) 0
#endif
static int sv_str_header(void *arg, const char *k, const char *v)
{
    SV *sv = (SV*)arg;
    sv_catpvf(sv, "%s: %s\n", k, v);
    return 1;
}
#if MODULE_MAGIC_NUMBER >= 19980806
/*
 * ap_scan_script_header_err_core(r, buffer, getsfunc_SV, sv)
 */
#if 0
static int getsfunc_SV(char *buf, int bufsiz, void *param)
{
    SV *sv = (SV*)param;
    STRLEN len;
    char *tmp = SvPV(sv,len);
    int i;
    if(!SvTRUE(sv)) 
        return 0;
    for(i=0; i<=len; i++) {
        if(tmp[i] == LF) break;
    }
    Move(tmp, buf, i, char);
    buf[i] = '\0';
    if(len < i) {
        sv_setpv(sv, "");
    }
    else {
        tmp += i+1;
        sv_setpv(sv, tmp);
    }
    return 1;
}
#endif /*0*/
#endif /*MODULE_MAGIC_NUMBER*/
static void rwrite_neg_trace(request_rec *r)
{
#if HAS_MMN_130
    ap_log_error(APLOG_MARK, APLOG_DEBUG, r->server,
#else
    fprintf(stderr,
#endif
                 "mod_perl: rwrite returned -1 (fd=%d, B_EOUT=%d)\n",
                 ap_bfileno(r->connection->client, B_WR), 
                 r->connection->client->flags & B_EOUT);
}
#define check_auth_type(r) \
    if (!auth_type(r)) { \
        (void)mod_perl_auth_type(r, "Basic"); \
    }
MODULE = Apache  PACKAGE = Apache   PREFIX = mod_perl_
PROTOTYPES: DISABLE
BOOT:
    items = items; /*avoid warning*/ 
void
add_version_component(name)
    const char *name
    CODE:
    ap_add_version_component(name);
const char *
current_callback(r)
    Apache     r
    CODE:
    RETVAL = PERL_GET_CUR_HOOK;
    OUTPUT:
    RETVAL
int
mod_perl_sent_header(r, val=0)
    Apache     r
    int val
     
int
mod_perl_seqno(self, inc=0)
    SV *self
    int inc
int
perl_hook(name)
    char *name
#if defined(PERL_GET_SET_HANDLERS)
SV *
get_handlers(r, hook)
    Apache     r
    char *hook
    CODE:
#ifdef get_handlers
    get_handlers(r,hook);
#else
    RETVAL = get_handlers(r,hook);
#endif
    
    OUTPUT:
    RETVAL
void    
set_handlers(r, hook, sv)
    Apache     r
    SV *hook
    SV *sv
#endif
int
mod_perl_push_handlers(self, hook, cv)
    SV *self
    char *hook
    SV *cv;
    CODE:
    RETVAL = mod_perl_push_handlers(self, hook, cv, Nullav);
    OUTPUT:
    RETVAL
int
mod_perl_can_stack_handlers(self)
    SV *self
void
mod_perl_register_cleanup(r, sv)
    Apache     r
    SV *sv
    ALIAS:
    Apache::post_connection = 1
    PREINIT:
    ix = ix; /* avoid -Wall warning */
     
#define APACHE_REGISTRY_CURSTASH perl_get_sv("Apache::Registry::curstash", TRUE)
void
mod_perl_clear_rgy_endav(r, sv=APACHE_REGISTRY_CURSTASH)
    Apache     r
    SV *sv
void
mod_perl_stash_rgy_endav(r, sv=APACHE_REGISTRY_CURSTASH)
    Apache     r
    SV *sv
    CODE:
    perl_stash_rgy_endav(r->uri, sv);
I32
mod_perl_define(sv, name)
    SV *sv
    char *name
    CLEANUP:
    sv = sv; /*-Wall*/
I32
module(sv, name)
    SV *sv
    SV *name
    CODE:
    if((*(SvEND(name) - 2) == '.') && (*(SvEND(name) - 1) == 'c'))
        RETVAL = find_linked_module(SvPVX(name)) ? 1 : 0;
    else
        RETVAL = (sv && perl_module_is_loaded(SvPVX(name)));
    OUTPUT:
    RETVAL
char *
mod_perl_set_opmask(r, sv)
    Apache     r
    SV *sv
void
untaint(...)
    PREINIT:
    int i;
    CODE:
    if(!tainting) XSRETURN_EMPTY;
    for(i=1; i<items; i++) 
        mod_perl_untaint(ST(i));
void
taint(...)
    PREINIT:
    int i;
    CODE:
    if(!tainting) XSRETURN_EMPTY;
    for(i=1; i<items; i++)
        sv_magic(ST(i), Nullsv, 't', Nullch, 0);
#ifndef WIN32
void
child_terminate(r)
    Apache     r
#endif
#CORE::exit only causes trouble when we're embedded
void
exit(...)
    PREINIT:
    int sts = 0;
    request_rec *r = NULL;
    CODE:
    /* $r->exit */
    r = sv2request_rec(ST(0), "Apache", cv);
    if(items > 1) {
        sts = (int)SvIV(ST(1));
    }
    else { /* Apache::exit() */
        if(SvTRUE(ST(0)) && SvIOK(ST(0)))
            sts = (int)SvIV(ST(0));
    }
    MP_CHECK_REQ(r, "Apache::exit");
    if(!r->connection->aborted)
        rflush(r);
    Apache_terminate_if_done(r,sts);
    perl_call_halt(sts);
#in case you need Apache::fork
# INCLUDE: fork.xs
void 
CLOSE(...)
    ALIAS:
    BINMODE = 1
     
    CODE:
    items = items;
    ix = ix;
    /*NOOP*/
Apache
TIEHANDLE(classname, r=NULL)
    SV *classname
    Apache r
    CODE:
    RETVAL = (r && classname) ? r : perl_request_rec(NULL);
    OUTPUT:
    RETVAL
int
OPEN(self, arg1, arg2=Nullsv)
    SV *self
    SV *arg1
    SV *arg2
    PREINIT:
    char *name;
    STRLEN len;
    GV *gv = gv_fetchpv("STDOUT", TRUE, SVt_PVIO);
    SV *arg;
    CODE:
    sv_unmagic((SV*)gv, 'q'); /* untie *STDOUT */
    if (arg2 && self) {
        arg = newSVsv(arg1);
        sv_catsv(arg, arg2);
    }
    else {
        arg = arg1;
    }
    name = SvPV(arg, len);
    RETVAL = do_open(gv, name, len, FALSE, O_RDONLY, 0, Nullfp);
    OUTPUT:
    RETVAL
int
FILENO(r)
    Apache r
    CODE:
    RETVAL = fileno(stdout);
    OUTPUT:
    RETVAL
SV *
as_string(r)
    Apache r
    CODE:
    RETVAL = newSVpv(r->the_request,0);
    sv_catpvn(RETVAL, "\n", 1);
    table_do(sv_str_header, (void*)RETVAL, r->headers_in, NULL);
    sv_catpvf(RETVAL, "\n%s %s\n", r->protocol, r->status_line);
    table_do(sv_str_header, (void*)RETVAL, r->headers_out, NULL);
    table_do(sv_str_header, (void*)RETVAL, r->err_headers_out, NULL);
    sv_catpvn(RETVAL, "\n", 1);
    OUTPUT:
    RETVAL
#httpd.h
      
void
chdir_file(r, file=r->filename)
    Apache r
    const char *file
    CODE:
    chdir_file(file);
SV *
mod_perl_gensym(pack="Apache::Symbol")
    char *pack
SV *
mod_perl_slurp_filename(r)
    Apache r
char *
unescape_url(string)
char *string
    CODE:
    unescape_url(string);
    RETVAL = string;
    OUTPUT:
    RETVAL
#
# Doing our own unscape_url for the query info part of an url
#
char *
unescape_url_info(url)
    char *     url
    CODE:
    register char * trans = url ;
    char digit ;
    if (!url || !*url) {
        XSRETURN_UNDEF;
    }
    RETVAL = url;
    while (*url != '\0') {
        if (*url == '+')
            *trans = ' ';
        else if (*url != '%')
            *trans = *url;
        else if (!isxdigit(url[1]) || !isxdigit(url[2]))
            *trans = '%';
        else {
            url++ ;
            digit = ((*url >= 'A') ? ((*url & 0xdf) - 'A')+10 : (*url - '0'));
            url++ ;
            *trans = (digit << 4) +
                (*url >= 'A' ? ((*url & 0xdf) - 'A')+10 : (*url - '0'));
        }
        url++, trans++ ;
    }
    *trans = '\0';
    OUTPUT:
    RETVAL
#functions from http_main.c
void
hard_timeout(r, string)
    Apache     r
    char       *string
    CODE:
#ifndef USE_THREADS
    hard_timeout(string, r);
#endif
void
soft_timeout(r, string)
    Apache     r
    char       *string
    CODE:
    soft_timeout(string, r);
void
kill_timeout(r)
    Apache     r
    CODE:
#ifndef USE_THREADS
    kill_timeout(r);
#endif
void
reset_timeout(r)
    Apache     r
#functions from http_config.c
int
translate_name(r)
    Apache     r
    CODE:
#ifdef WIN32
    croak("Apache->translate_name not supported under Win32");
    RETVAL = DECLINED;
#else
    RETVAL = translate_name(r);
#endif
    OUTPUT:
    RETVAL
#functions from http_core.c
char *
custom_response(r, status, string=NULL)
    Apache     r
    int status
    char *string
    
    CODE:
    RETVAL = custom_response(r, status, string, ST(2) == &sv_undef);
    OUTPUT:
    RETVAL
     
int
satisfies(r)
    Apache     r
int
some_auth_required(r)
    Apache     r
void
requires(r)
    Apache     r
    PREINIT:
    AV *av;
    HV *hv;
    register int x;
    int m;
    char *t;
    MP_CONST_ARRAY_HEADER *reqs_arr;
    require_line *reqs;
    CODE:
    m = r->method_number;
    reqs_arr = requires (r);
    if (!reqs_arr)
        ST(0) = &sv_undef;
    else {
        reqs = (require_line *)reqs_arr->elts;
        iniAV(av);
        for(x=0; x < reqs_arr->nelts; x++) {
            /* XXX should we do this or let PerlAuthzHandler? */
            if (! (reqs[x].method_mask & (1 << m))) continue;
            t = reqs[x].requirement;
            iniHV(hv);
            hv_store(hv, "method_mask", 11, 
                     newSViv((IV)reqs[x].method_mask), 0);
            hv_store(hv, "requirement", 11, 
                     newSVpv(reqs[x].requirement,0), 0);
            av_push(av, newRV((SV*)hv));
        }
        ST(0) = newRV_noinc((SV*)av); 
    }
int 
allow_options(r)
    Apache      r
unsigned
get_server_port(r)
    Apache      r
const char *
get_server_name(r)
    Apache      r
char *
get_remote_host(r, type=REMOTE_NAME)
    Apache      r
    int type
    CODE:
    RETVAL = (char *)get_remote_host(r->connection, 
                                     r->per_dir_config, type);
    OUTPUT:
    RETVAL
const char *
get_remote_logname(r)
    Apache      r
char *
mod_perl_auth_name(r, val=NULL)
    Apache    r
    char *val
const char *
mod_perl_auth_type(r, val=NULL)
    Apache    r
    char *val
const char *
document_root(r, ...)
    Apache    r
    PREINIT:
    core_server_config *conf;
    CODE:
    conf = (core_server_config *)
      get_module_config(r->server->module_config, &core_module);
    RETVAL = conf->ap_document_root;
    if (items > 1) {
        SV *doc_root = perl_get_sv("Apache::Server::DocumentRoot", TRUE);
        sv_setsv(doc_root, ST(1));
        conf->ap_document_root = SvPVX(doc_root);
    }
    OUTPUT:
    RETVAL
char *
server_root_relative(rsv, name="")
    SV   *rsv
    char *name
    PREINIT:
    pool *p;
    request_rec *r;
    CODE:
    if (SvROK(rsv) && (r = sv2request_rec(rsv, "Apache", cv))) {
        p = r->pool;
    }
    else {
        if(!(p = perl_get_startup_pool()))
           croak("Apache::server_root_relative: no startup pool available");
    }
    RETVAL = (char *)server_root_relative(p, name);
    OUTPUT:
    RETVAL
#functions from http_protocol.c
void
note_basic_auth_failure(r)
    Apache r
    CODE:
    check_auth_type(r);
    note_basic_auth_failure(r);
void
get_basic_auth_pw(r)
    Apache r
    PREINIT:
    MP_CONST_CHAR *sent_pw = NULL;
    int ret;
    PPCODE:
    check_auth_type(r);
    ret = get_basic_auth_pw(r, &sent_pw);
    XPUSHs(sv_2mortal((SV*)newSViv(ret)));
    if(ret == OK)
        XPUSHs(sv_2mortal((SV*)newSVpv((char *)sent_pw, 0)));
    else
        XPUSHs(&sv_undef);
char *
user(r, ...)
    Apache   r
    CODE:
    get_set_PVp(r->connection->user,r->pool);
    OUTPUT:
    RETVAL
void
basic_http_header(r)
    Apache      r
     
    CODE:
#ifdef WIN32
    croak("Apache->basic_http_header() not supported under Win32!");
#else
    basic_http_header(r);
#endif
void
send_http_header(r, type=NULL)
    Apache      r
    char *type
    CODE:
    if(type)
        r->content_type = pstrdup(r->pool, type);
    send_http_header(r);
    mod_perl_sent_header(r, 1);
#ifndef PERL_OBJECT
int
send_fd(r, f, length=-1)
    Apache      r
    FILE *f
    long length
    CODE:
    if (!f) {
        croak("send_fd: NULL filehandle "
              "(hint: did you check the return value of open?)");
    }
    RETVAL = send_fd_length(f, r, length);
    OUTPUT:
    RETVAL
#endif
int
rflush(r)
    Apache     r
void
read_client_block(r, buffer, bufsiz)
    Apache      r
    SV    *buffer
    int      bufsiz
    PREINIT:
    long nrd = 0, old_read_length;
    int rc;
    PPCODE:
    if (!r->read_length) {
        if ((rc = setup_client_block(r, REQUEST_CHUNKED_ERROR)) != OK) {
            aplog_error(APLOG_MARK, APLOG_ERR | APLOG_NOERRNO, r->server, 
                        "mod_perl: setup_client_block failed: %d", rc);
            XSRETURN_UNDEF;
        }
    }
    old_read_length = r->read_length;
    r->read_length = 0;
    if (should_client_block(r)) {
        (void)SvUPGRADE(buffer, SVt_PV);
        SvGROW(buffer, bufsiz+1);
        nrd = get_client_block(r, SvPVX(buffer), bufsiz);
    }
    r->read_length += old_read_length;
    if (nrd > 0) {
        XPUSHs(sv_2mortal(newSViv((long)nrd)));
#ifdef PERL_STASH_POST_DATA
        table_set(r->subprocess_env, "POST_DATA", SvPVX(buffer));
#endif
        SvCUR_set(buffer, nrd);
        *SvEND(buffer) = '\0';
        SvPOK_only(buffer);
        SvTAINTED_on(buffer);
    } 
    else {
        sv_setsv(buffer, &sv_undef);
    }
int
setup_client_block(r, policy=REQUEST_CHUNKED_ERROR)
    Apache      r
    int policy
int
should_client_block(r)
    Apache      r
void
get_client_block(r, buffer, bufsiz)
    Apache      r
    SV    *buffer
    int      bufsiz
    PREINIT:
    long nrd = 0;
    PPCODE:
    (void)SvUPGRADE(buffer, SVt_PV);
    SvGROW(buffer, bufsiz+1);
    nrd = get_client_block(r, SvPVX(buffer), bufsiz);
    if ( nrd > 0 ) {
        XPUSHs(sv_2mortal(newSViv((long)nrd)));
        SvCUR_set(buffer, nrd);
        *SvEND(buffer) = '\0';
        SvPOK_only(buffer);
        SvTAINTED_on(buffer);
    } 
    else {
        sv_setsv(ST(1), &sv_undef);
    }
int
write(r, sv_buffer, sv_length=-1, offset=0)
    Apache      r
    SV *sv_buffer
    int sv_length
    int offset
    ALIAS:
    Apache::WRITE = 1
    PREINIT:
    STRLEN len;
    char *buffer;
    int sent = 0;
    CODE:
    ix = ix; /* avoid -Wall warning */
    RETVAL = 0;
    if (r->connection->aborted) {
        XSRETURN_UNDEF;
    }
    buffer = SvPV(sv_buffer, len);
    if (sv_length != -1) {
        len = sv_length;
    }
    if (offset) {
        buffer += offset;
    }
    while (len > 0) {
        sent = rwrite(buffer,
                      len < HUGE_STRING_LEN ? len : HUGE_STRING_LEN,
                      r);
        if (sent < 0) {
            rwrite_neg_trace(r);
            break;
        }
        buffer += sent;
        len -= sent;
        RETVAL += sent;
    }
    OUTPUT:
    RETVAL
int
print(r, ...)
    Apache      r
    ALIAS:
    Apache::PRINT = 1
    CODE:
    ix = ix; /* avoid -Wall warning */
    if(!mod_perl_sent_header(r, 0)) {
        SV *sv = sv_newmortal();
        SV *rp = ST(0);
        SV *sendh = perl_get_sv("Apache::__SendHeader", TRUE);
        if(items > 2)
            do_join(sv, &sv_no, MARK+1, SP); /* $sv = join '', @_[1..$#_] */
        else
            sv_setsv(sv, ST(1));
        PUSHMARK(sp);
        XPUSHs(rp);
        XPUSHs(sv);
        PUTBACK;
        sv_setiv(sendh, 1);
        perl_call_pv("Apache::send_cgi_header", G_SCALAR);
        sv_setiv(sendh, 0);
    }
    else {
        CV *cv = GvCV(gv_fetchpv("Apache::write_client", FALSE, SVt_PVCV));
        soft_timeout("mod_perl: Apache->print", r);
        PUSHMARK(mark);
#ifdef PERL_OBJECT
        (void)(*CvXSUB(cv))(cv, pPerl); /* &Apache::write_client; */
#else
        (void)(*CvXSUB(cv))(aTHXo_ cv); /* &Apache::write_client; */
#endif
        if(IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) /* if $| != 0; */
#if MODULE_MAGIC_NUMBER >= 19970103
            rflush(r);
#else
            bflush(r->connection->client);
#endif
        kill_timeout(r);
    }
    RETVAL = !r->connection->aborted;
    OUTPUT:
    RETVAL
int
write_client(r, ...)
    Apache      r
    PREINIT:
    int i;
    char * buffer;
    STRLEN len;
    CODE:
    RETVAL = 0;
    if (r->connection->aborted)
        XSRETURN_IV(0);
    for(i = 1; i <= items - 1; i++) {
        int sent = 0;
        SV *sv = SvROK(ST(i)) && (SvTYPE(SvRV(ST(i))) == SVt_PV) ?
                 (SV*)SvRV(ST(i)) : ST(i);
        buffer = SvPV(sv, len);
#ifdef APACHE_SSL
        while(len > 0) {
            sent = rwrite(buffer,
                          len < HUGE_STRING_LEN ? len : HUGE_STRING_LEN,
                          r);
            if(sent < 0) {
                rwrite_neg_trace(r);
                /* break out of outer loop too */
                i = items;
                break;
            }
            buffer += sent;
            len -= sent;
            RETVAL += sent;
        }
#else
        if((sent = rwrite(buffer, len, r)) < 0) {
            rwrite_neg_trace(r);
            break;
        }
        RETVAL += sent;
#endif
    }
    OUTPUT:
    RETVAL
#functions from http_request.c
void
internal_redirect_handler(r, location)
    Apache      r
    char *      location
    ALIAS: 
    Apache::internal_redirect = 1
    CODE:
    switch((ix = XSANY.any_i32)) {
        case 0:
        internal_redirect_handler(location, r);
        break;
        case 1:
        internal_redirect(location, r);
        break;
    }
#functions from http_log.c
void
mod_perl_log_reason(r, reason, filename=NULL)
    Apache      r
    char *      reason
    char *      filename
    CODE:
    if(filename == NULL)
        filename = r->uri; 
    mod_perl_log_reason(reason, filename, r);
void
log_error(...)
    ALIAS:
    Apache::warn = 1
    Apache::Server::log_error = 2
    Apache::Server::warn = 3
    PREINIT:
    server_rec *s = NULL;
    request_rec *r = NULL;
    int i=0;
    char *errstr = NULL;
    SV *sv = Nullsv;
    CODE:
    if((items > 1) && (r = sv2request_rec(ST(0), "Apache", cv))) {
        s = r->server;
        i=1;
    }
    else if((items > 1) && sv_derived_from(ST(0), "Apache::Server")) {
        IV tmp = SvIV((SV*)SvRV(ST(0)));
        s = (Apache__Server )tmp;
        i=1;    
        /* if below is true, delay log_error */
        if(PERL_RUNNING() < PERL_DONE_STARTUP) {
            MP_TRACE_g(fprintf(stderr, "error_log not open yet\n"));
            XSRETURN_UNDEF;
        }
    }
    else { 
        if(r) 
            s = r->server;
        else
            s = perl_get_startup_server();
    }
    if(!s) croak("Apache::warn: no server_rec!");
    if(items > 1+i) {
        sv = newSV(0);
        do_join(sv, &sv_no, MARK+i, SP); /* $sv = join '', @_[1..$#_] */
        errstr = SvPV(sv,na);
    }
    else
        errstr = SvPV(ST(i),na);
    switch((ix = XSANY.any_i32)) {
        case 0:
        case 2:
        mod_perl_error(s, errstr);
        break;
        case 1:
        case 3:
        mod_perl_warn(s, errstr);
        break;
        default:
        mod_perl_error(s, errstr);
        break;
    }
    if(sv) SvREFCNT_dec(sv);
#methods for creating a CGI environment
SV *
subprocess_env(r, key=NULL, ...)
    Apache    r
    char *key
    ALIAS:
    Apache::cgi_env = 1
    Apache::cgi_var = 2
    PREINIT:
    I32 gimme = GIMME_V;
  
    CODE:
    if(((ix = XSANY.any_i32) == 1) && (gimme == G_ARRAY)) {
        /* backwards compat */
        int i;
        array_header *arr  = perl_cgi_env_init(r);
        table_entry *elts = (table_entry *)arr->elts;
        SP -= items;
        for (i = 0; i < arr->nelts; ++i) {
            if (!elts[i].key) continue;
            PUSHelt(elts[i].key, elts[i].val, 0);
        }
        PUTBACK;
        return;
    }
    if((items == 1) && (gimme == G_VOID)) {
        (void)perl_cgi_env_init(r);
        XSRETURN_UNDEF;
    }
    TABLE_GET_SET(r->subprocess_env, FALSE);
    OUTPUT:
    RETVAL
#see httpd.h
#struct request_rec {
void
request(self, r=NULL)
    SV *self
    Apache r
    PPCODE: 
    self = self;
    if(items > 1) perl_request_rec(r);
    XPUSHs(perl_bless_request_rec(perl_request_rec(NULL)));
#  pool *pool;
#  conn_rec *connection;
#  server_rec *server;
Apache::Connection
connection(r)
    Apache      r
    CODE:       
    RETVAL = r->connection;
    OUTPUT:
    RETVAL
Apache::Server
server(rsv)
    SV *rsv
         
    PREINIT:
    server_rec *s;
    request_rec *r;
    CODE:
    if (SvROK(rsv) && (r = sv2request_rec(rsv, "Apache", cv))) {
        s = r->server;
    }
    else {
        if(!(s = perl_get_startup_server()))
           croak("Apache->server: no startup server_rec available");
    }
    RETVAL = s;
    OUTPUT:
    RETVAL
#  request_rec *next;           /* If we wind up getting redirected,
#                                * pointer to the request we redirected to.
#                                */
#  request_rec *prev;           /* If this is an internal redirect,
#                                * pointer to where we redirected *from*.
#                                */
   
#  request_rec *main;           /* If this is a sub_request (see request.h) 
#                                * pointer back to the main request.
#                                */
# ...
#  /* Info about the request itself... we begin with stuff that only
#   * protocol.c should ever touch...
#   */
   
#  char *the_request;           /* First line of request, so we can log it */
#  int assbackwards;            /* HTTP/0.9, "simple" request */
#  int proxyreq;                 /* A proxy request */
#  int header_only;             /* HEAD request, as opposed to GET */
#  char *protocol;              /* Protocol, as given to us, or HTTP/0.9 */
#  char *hostname;              /* Host, as set by full URI or Host: */
#  int hostlen;                 /* Length of http://host:port in full URI */
#  char *status_line;           /* Status line, if set by script */
#  int status;                  /* In any case */
void
main(r)
    Apache   r
    CODE:
    if(r->main != NULL)
        ST(0) = perl_bless_request_rec((request_rec *)r->main);
    else
        ST(0) = &sv_undef;
void
prev(r)
    Apache   r
    CODE:
    if(r->prev != NULL)
        ST(0) = perl_bless_request_rec((request_rec *)r->prev);
    else
        ST(0) = &sv_undef;
void
next(r)
    Apache   r
    CODE:
    if(r->next != NULL)
        ST(0) = perl_bless_request_rec((request_rec *)r->next);
    else
        ST(0) = &sv_undef;
Apache
last(r)
    Apache   r
    CODE:
    for(RETVAL=r; RETVAL->next; RETVAL=RETVAL->next)
        continue;
    OUTPUT:
    RETVAL
int
is_initial_req(r)
    Apache   r
int 
is_main(r)
    Apache   r
    CODE:
    if(r->main != NULL) RETVAL = 0;
    else RETVAL = 1;
        
    OUTPUT:
    RETVAL
char *
the_request(r, ...)
    Apache   r
    CODE:
    get_set_PVp(r->the_request,r->pool);
    OUTPUT:
    RETVAL
int
proxyreq(r, ...)
    Apache   r
    CODE:
    get_set_IV(r->proxyreq);
    OUTPUT:
    RETVAL
int
header_only(r)
    Apache   r
    CODE:
    RETVAL = r->header_only;
    OUTPUT:
    RETVAL
char *
protocol(r)
    Apache      r
    CODE:
    RETVAL = r->protocol;
    OUTPUT:
    RETVAL
char *
hostname(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->hostname,r->pool);
    OUTPUT:
    RETVAL
int
status(r, ...)
    Apache      r
    CODE:
    get_set_IV(r->status);
    OUTPUT:
    RETVAL
int
allowed(r, ...)
    Apache      r
    CODE:
    get_set_IV(r->allowed);
    OUTPUT:
    RETVAL
time_t
request_time(r)
    Apache      r
    CODE:
    RETVAL = r->request_time;
    OUTPUT:
    RETVAL
char *
status_line(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->status_line,r->pool);
    OUTPUT:
    RETVAL
   
#  /* Request method, two ways; also, protocol, etc..  Outside of protocol.c,
#   * look, but don't touch.
#   */
   
#  char *method;                        /* GET, HEAD, POST, etc. */
#  int method_number;           /* M_GET, M_POST, etc. */
#  int sent_bodyct;             /* byte count in stream is for body */
#  long bytes_sent;             /* body byte count, for easy access */
char *
method(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->method,r->pool);
    OUTPUT:
    RETVAL
int
method_number(r, ...)
    Apache      r
    CODE:
    get_set_IV(r->method_number);
    OUTPUT:
    RETVAL
long
bytes_sent(r, ...)
    Apache      r
    PREINIT:
    request_rec *last;
    CODE:
    for(last=r; last->next; last=last->next)
        continue;
    if (last->sent_bodyct && !last->bytes_sent) {
        ap_bgetopt(last->connection->client, BO_BYTECT, &last->bytes_sent);
    }
    RETVAL = last->bytes_sent;
    if(items > 1) {
        long nbytes = last->bytes_sent = (long)SvIV(ST(1));
        ap_bsetopt(last->connection->client, BO_BYTECT, &nbytes);
    }
    OUTPUT:
    RETVAL
#    /* MIME header environments, in and out.  Also, an array containing
#   * environment variables to be passed to subprocesses, so people can
#   * write modules to add to that environment.
#   *
#   * The difference between headers_out and err_headers_out is that the
#   * latter are printed even on error, and persist across internal redirects
#   * (so the headers printed for ErrorDocument handlers will have them).
#   *
#   * The 'notes' table is for notes from one module to another, with no
#   * other set purpose in mind...
#   */
   
#  table *headers_in;
#  table *headers_out;
#  table *err_headers_out;
#  table *subprocess_env;
#  table *notes;
#  char *content_type;          /* Break these out --- we dispatch on 'em */
#  char *handler;               /* What we *really* dispatch on           */
#  char *content_encoding;
#  char *content_language;
   
#  int no_cache;
SV *
header_in(r, key, ...)
    Apache      r
    char *key
    CODE:
    TABLE_GET_SET(r->headers_in, TRUE);
    OUTPUT:
    RETVAL
void
headers_in(r)
    Apache      r
    PREINIT:
     
    int i;
    array_header *hdrs_arr;
    table_entry  *hdrs;
    PPCODE:
    if(GIMME == G_SCALAR) {
        ST(0) = mod_perl_tie_table(r->headers_in); 
        XSRETURN(1);    
    }
    hdrs_arr = table_elts (r->headers_in);
    hdrs = (table_entry *)hdrs_arr->elts;
    for (i = 0; i < hdrs_arr->nelts; ++i) {
        if (!hdrs[i].key) continue;
        PUSHelt(hdrs[i].key, hdrs[i].val, 0);
    }
SV *
header_out(r, key, ...)
    Apache      r
    char *key
    CODE:
    TABLE_GET_SET(r->headers_out, TRUE);
    OUTPUT:
    RETVAL
SV *
cgi_header_out(r, key, ...)
    Apache      r
    char *key
    PREINIT:
    char *val;
    CODE:
    if((val = (char *)table_get(r->headers_out, key))) 
        RETVAL = newSVpv(val, 0);
    else
        RETVAL = newSV(0);
    SvTAINTED_on(RETVAL);
    if(items > 2) {
        int status = 302;
        val = SvPV(ST(2),na);
        if(!strncasecmp(key, "Content-type", 12)) {
            r->content_type = pstrdup (r->pool, val);
        }
        else if(!strncasecmp(key, "Status", 6)) {
            sscanf(val, "%d", &r->status);
            r->status_line = pstrdup(r->pool, val);
        }
        else if(!strncasecmp(key, "Location", 8)) {
            if (val && val[0] == '/' && r->status == 200) {
                /* not sure if this is quite right yet */
                /* set $Apache::DoInternalRedirect++ to test */
                if(DO_INTERNAL_REDIRECT) {
                    r->method = pstrdup(r->pool, "GET");
                    r->method_number = M_GET;
                    table_unset(r->headers_in, "Content-Length");
                    status = 200;
                    perl_soak_script_output(r);
                    internal_redirect_handler(val, r);
                }
            }
            table_set (r->headers_out, key, val);
            r->status = status;
        }   
        else if(!strncasecmp(key, "Content-Length", 14)) {
            table_set (r->headers_out, key, val);
        }   
        else if(!strncasecmp(key, "Transfer-Encoding", 17)) {
            table_set (r->headers_out, key, val);
        }   
#The HTTP specification says that it is legal to merge duplicate
#headers into one.  Some browsers that support Cookies don't like
#merged headers and prefer that each Set-Cookie header is sent
#separately.  Lets humour those browsers.
        else if(!strncasecmp(key, "Set-Cookie", 10)) {
            table_add(r->err_headers_out, key, val);
        }
        else {
            table_merge (r->err_headers_out, key, val);
        }
    }
void
headers_out(r)
    Apache      r
    PREINIT:
    int i;
    array_header *hdrs_arr;
    table_entry  *hdrs;
    PPCODE:
    if(GIMME == G_SCALAR) {
        ST(0) = mod_perl_tie_table(r->headers_out); 
        XSRETURN(1);    
    }
    hdrs_arr = table_elts (r->headers_out);
    hdrs = (table_entry *)hdrs_arr->elts;
    for (i = 0; i < hdrs_arr->nelts; ++i) {
        if (!hdrs[i].key) continue;
        PUSHelt(hdrs[i].key, hdrs[i].val, 0);
    }
SV *
err_header_out(r, key, ...)
    Apache      r
    char *key
    CODE:
    TABLE_GET_SET(r->err_headers_out, TRUE);
    OUTPUT:
    RETVAL
void
err_headers_out(r, ...)
    Apache      r
    PREINIT:
    int i;
    array_header *hdrs_arr;
    table_entry  *hdrs;
    PPCODE:
    if(GIMME == G_SCALAR) {
        ST(0) = mod_perl_tie_table(r->err_headers_out); 
        XSRETURN(1);    
    }
    hdrs_arr = table_elts (r->err_headers_out);
    hdrs = (table_entry *)hdrs_arr->elts;
    for (i = 0; i < hdrs_arr->nelts; ++i) {
        if (!hdrs[i].key) continue;
        PUSHelt(hdrs[i].key, hdrs[i].val, 0);
    }
SV *
notes(r, key=NULL, ...)
    Apache    r
    char *key
    CODE:
    TABLE_GET_SET(r->notes, FALSE);
    OUTPUT:
    RETVAL
void
pnotes(r, k=Nullsv, val=Nullsv)
    Apache r
    SV *k
    SV *val
    PREINIT:
    perl_request_config *cfg = NULL;
    char *key = NULL;
    STRLEN len;
    CODE:
    if(k) {
        key = SvPV(k,len);
    }
    cfg = (perl_request_config *)
      get_module_config(r->request_config, &perl_module);
    if (!cfg) {
        XSRETURN_UNDEF;
    }
    if(!cfg->pnotes) cfg->pnotes = newHV();
    if(key) {
        if(hv_exists(cfg->pnotes, key, len)) {
            ST(0) = SvREFCNT_inc(*hv_fetch(cfg->pnotes, key, len, FALSE));
            sv_2mortal(ST(0));
        }
        else {
            ST(0) = &sv_undef;
        }
        if(val) {
            hv_store(cfg->pnotes, key, len, SvREFCNT_inc(val), FALSE);
        }
    }
    else {
        ST(0) = newRV_inc((SV*)cfg->pnotes);
        sv_2mortal(ST(0));
    }
char *
content_type(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->content_type,r->pool);
   
    OUTPUT:
    RETVAL
char *
handler(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->handler,r->pool);
   
    OUTPUT:
    RETVAL
char *
content_encoding(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->content_encoding,r->pool);
    OUTPUT:
    RETVAL
char *
content_language(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->content_language,r->pool);
    OUTPUT:
    RETVAL
void
content_languages(r, avrv=Nullsv)
    Apache      r
    SV *avrv
    PREINIT:   
    I32 gimme = GIMME_V;
    CODE:
    if(avrv && SvROK(avrv))
        r->content_languages = avrv2array_header(avrv, r->pool);
    if(gimme != G_VOID)
        ST(0) = array_header2avrv(r->content_languages);
                                    
int
no_cache(r, ...)
    Apache      r
    CODE: 
    get_set_IV(r->no_cache);
    if (r->no_cache) {
        ap_table_setn(r->headers_out, "Pragma", "no-cache");
        ap_table_setn(r->headers_out, "Cache-control", "no-cache");
    }
    else if (items > 1) { /* $r->no_cache(0) */
       ap_table_unset(r->headers_out, "Pragma");
       ap_table_unset(r->headers_out, "Cache-control");
    }
    OUTPUT:
    RETVAL
#  /* What object is being requested (either directly, or via include
#   * or content-negotiation mapping).
#   */
#  char *uri;                    /* complete URI for a proxy req, or
#                                   URL path for a non-proxy req */
#  char *filename;
#  char *path_info;
#  char *args;                  /* QUERY_ARGS, if any */
#  struct stat finfo;           /* ST_MODE set to zero if no such file */
SV *
finfo(r, sv_statbuf=Nullsv)
    Apache r
    SV *sv_statbuf
    CODE:
    if (sv_statbuf) {
        if (SvROK(sv_statbuf) && SvOBJECT(SvRV(sv_statbuf))) {
            STRLEN sz;
            char *buf = SvPV((SV*)SvRV(sv_statbuf), sz);
            if (sz != sizeof(r->finfo)) {
                croak("statbuf size mismatch, got %d, wanted %d",
                      sz, sizeof(r->finfo));
            }
            memcpy(&r->finfo, buf, sz);
        }
        else {
            croak("statbuf is not an object");
        }
    }
    statcache = r->finfo;
    if (r->finfo.st_mode) {
        laststatval = 0;
        sv_setpv(statname, r->filename);
    }
    else {
        laststatval = -1;
        sv_setpv(statname, "");
    }
    if(GIMME_V == G_VOID) XSRETURN_UNDEF;
    RETVAL = newRV_noinc((SV*)gv_fetchpv("_", TRUE, SVt_PVIO));
    OUTPUT:
    RETVAL
char *
uri(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->uri,r->pool);
    OUTPUT:
    RETVAL
char *
filename(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->filename,r->pool);
#ifndef WIN32
    if(items > 1)
        if ((laststatval = stat(r->filename, &r->finfo)) < 0) {
            r->finfo.st_mode = 0;
        }
#endif
    OUTPUT:
    RETVAL
char *
path_info(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->path_info,r->pool);
    OUTPUT:
    RETVAL
char *
query_string(r, ...)
    Apache      r
    CODE:
    get_set_PVp(r->args,r->pool);
    OUTPUT:
    RETVAL
    CLEANUP:
    if (ST(0) != &sv_undef) SvTAINTED_on(ST(0));
#  /* Various other config info which may change with .htaccess files
#   * These are config vectors, with one void* pointer for each module
#   * (the thing pointed to being the module's business).
#   */
   
#  void *per_dir_config;                /* Options set in config files, etc. */
char *
location(r)
    Apache  r
    CODE:
    if(r->per_dir_config) {                             
        dPPDIR;
        RETVAL = cld->location;
    }
    else XSRETURN_UNDEF;
    OUTPUT:
    RETVAL
SV *
dir_config(r, key=NULL, ...)
    Apache  r
    char *key
    ALIAS:
    Apache::Server::dir_config = 1
    PREINIT:
    perl_dir_config *c;
    perl_server_config *cs;
    server_rec *s;
    CODE:
    ix = ix; /*-Wall*/
    RETVAL = Nullsv;
    if(r && r->per_dir_config) {                                
        c = (perl_dir_config *)get_module_config(r->per_dir_config, 
                                                 &perl_module);
        TABLE_GET_SET(c->vars, FALSE);
    }
    if (!SvTRUE(RETVAL)) {
        s = r && r->server ? r->server : perl_get_startup_server();
        if (s && s->module_config) {
            SvREFCNT_dec(RETVAL); /* in case above did newSV(0) */
            cs = (perl_server_config *)get_module_config(s->module_config, 
                                                         &perl_module);
            TABLE_GET_SET(cs->vars, FALSE);
        }
        else XSRETURN_UNDEF;
    }
  
    OUTPUT:
    RETVAL
    
#  void *request_config;                /* Notes on *this* request */
#/*
# * a linked list of the configuration directives in the .htaccess files
# * accessed by this request.
# * N.B. always add to the head of the list, _never_ to the end.
# * that way, a sub request's list can (temporarily) point to a parent's list
# */
#  const struct htaccess_result *htaccess;
#};
Apache::SubRequest
lookup_uri(r, uri)
    Apache r
    char *uri
    CODE:
    RETVAL = sub_req_lookup_uri(uri,r);
    OUTPUT:
    RETVAL
Apache::SubRequest
lookup_file(r, file)
    Apache r
    char *file
    CODE:
    RETVAL = sub_req_lookup_file(file,r);
    OUTPUT:
    RETVAL
MODULE = Apache  PACKAGE = Apache::SubRequest
BOOT:
    av_push(perl_get_av("Apache::SubRequest::ISA",TRUE), newSVpv("Apache",6));
void
DESTROY(r)
    Apache::SubRequest r
    CODE:
    destroy_sub_req(r);
    MP_TRACE_g(fprintf(stderr, 
            "Apache::SubRequest::DESTROY(0x%lx)\n", (unsigned long)r));
int
run(r, allow_send_header=0)
    Apache::SubRequest r
    int allow_send_header
    CODE:
    if (allow_send_header) {
        r->assbackwards = 0;
    }
    RETVAL = run_sub_req(r);
    OUTPUT:
    RETVAL