[catagits/fcgi2.git] / perl / FCGI.PL

use Config;

open OUT, ">FCGI.xs";

print "Generating FCGI.xs for Perl version $]\n";
#unless (exists $Config{apiversion} && $Config{apiversion} >= 5.005) 
unless ($] >= 5.005) {
    for (qw(sv_undef diehook warnhook in_eval)) {
	print OUT "#define PL_$_ $_\n" 
    }
}
print OUT while <DATA>;
close OUT;
__END__
/* $Id: FCGI.PL,v 1.8 1999/07/30 08:22:31 skimo Exp $ */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "fcgiapp.h"

#ifndef FALSE
#define FALSE (0)
#endif

#ifndef TRUE
#define TRUE  (1)
#endif

#ifdef WIN32
#define environ _environ
#endif

extern char **environ;

#ifdef USE_SFIO
typedef struct
{
    Sfdisc_t	disc;
    FCGX_Stream	*stream;
} FCGI_Disc;

static ssize_t
sffcgiread(f, buf, n, disc)
Sfio_t*		f;      /* stream involved */
Void_t*		buf;    /* buffer to read into */
size_t		n;      /* number of bytes to read */
Sfdisc_t*	disc;   /* discipline */
{
    return FCGX_GetStr(buf, n, ((FCGI_Disc *)disc)->stream);
}

static ssize_t
sffcgiwrite(f, buf, n, disc)
Sfio_t*		f;      /* stream involved */
const Void_t*	buf;    /* buffer to read into */
size_t		n;      /* number of bytes to read */
Sfdisc_t*	disc;   /* discipline */
{
    n = FCGX_PutStr(buf, n, ((FCGI_Disc *)disc)->stream);
    FCGX_FFlush(((FCGI_Disc *)disc)->stream);
    return n;
}

Sfdisc_t *
sfdcnewfcgi(stream)
	FCGX_Stream *stream;
{
    FCGI_Disc*	disc;

    New(1000,disc,1,FCGI_Disc);
    if (!disc) return (Sfdisc_t *)disc;

    disc->disc.exceptf = (Sfexcept_f)NULL;
    disc->disc.seekf = (Sfseek_f)NULL;
    disc->disc.readf = sffcgiread;
    disc->disc.writef = sffcgiwrite;
    disc->stream = stream;
    return (Sfdisc_t *)disc;
}

Sfdisc_t *
sfdcdelfcgi(disc)
    Sfdisc_t*	disc;
{
    Safefree(disc);
    return 0;
}
#endif

static int isCGI = -1; /* -1: not checked; 0: FCGI; 1: FCGI */

static FCGX_Request global_fcgx_request;

typedef struct FCGP_Request {
    int		    compat;
    int		    acceptCalled;
    int		    finishCalled;
    SV*		    svin;
    SV*		    svout;
    SV*		    sverr;
    GV*		    gv[3];
    GV*		    gvNew[3];
    HV*		    hvEnv;
    FCGX_Stream*    in;
    FCGX_ParamArray envp;
    FCGX_Request*   requestPtr;
#ifdef USE_SFIO
    int		    sfcreated[3];
#endif
} FCGP_Request;

static FCGP_Request global_request;
static SV*	    global_sverr;

static int 
FCGI_Flush(FCGP_Request* request)
{
    if(!request->acceptCalled || isCGI) {
	return;
    }
#ifdef USE_SFIO
    sfsync(IoOFP(GvIOp(request->gv[1])));
    sfsync(IoOFP(GvIOp(request->gv[2])));
#else
    FCGX_FFlush((FCGX_Stream *) SvIV((SV*) SvRV(request->svout)));
    FCGX_FFlush((FCGX_Stream *) SvIV((SV*) SvRV(request->sverr)));
#endif
}

static void
FCGI_UndoBinding(FCGP_Request* request)
{
#ifdef USE_SFIO
    IO *io[3];
    int i;
#endif

#ifdef USE_SFIO
    sfdcdelfcgi(sfdisc(IoIFP(io[0] = GvIOp(request->gv[0])), SF_POPDISC));
    sfdcdelfcgi(sfdisc(IoOFP(io[1] = GvIOp(request->gv[1])), SF_POPDISC));
    sfdcdelfcgi(sfdisc(IoOFP(io[2] = GvIOp(request->gv[2])), SF_POPDISC));
    for (i = 0; i < 3; ++i) {
	if (request->sfcreated[i]) {
	    sfclose(IoIFP(io[i]));
	    IoIFP(io[i]) = IoOFP(io[i]) = Nullfp;
	    request->sfcreated[i] = FALSE;
	}
    }
#else
    FCGI_Flush(request);
    sv_unmagic((SV *)request->gv[0], 'q');
    sv_unmagic((SV *)request->gv[1], 'q');
    sv_unmagic((SV *)request->gv[2], 'q');
#endif
}

static int 
FCGI_Accept(FCGP_Request* request)
{
    if(isCGI == -1) {
        /*
         * First call to FCGI_Accept.  Is application running
         * as FastCGI or as CGI?
         */
        isCGI = FCGX_IsCGI();
    } else if(isCGI) {
        /*
         * Not first call to FCGI_Accept and running as CGI means
         * application is done.
         */
        return(EOF);
    } 
    if(request->acceptCalled && !request->finishCalled) {
	FCGI_UndoBinding(request);
    }
    if(!isCGI) {
#ifdef USE_SFIO
	IO *io[3];
	int i;
#endif
	FCGX_Stream *out, *error;
        int acceptResult = FCGX_Accept_r(&request->in, &out, &error, 
					 &request->envp,
				         request->requestPtr);
        if(acceptResult < 0) {
            return acceptResult;
        }
#ifdef USE_SFIO
	for (i = 0; i < 3; ++i) {
	    io[i] = GvIOn(request->gv[i] = request->gvNew[i]);
	    if (!(i == 0 ? IoIFP(io[i]) : IoOFP(io[i]))) {
		IoIFP(io[i]) = sftmp(0);
		/*IoIFP(io[i]) = sfnew(NULL, NULL, SF_UNBOUND, 0, 
				     SF_STRING | (i ? SF_WRITE : SF_READ));*/
		if (i != 0) IoOFP(io[i]) = IoIFP(io[i]);
		request->sfcreated[i] = TRUE;
	    }
	}
        sfdisc(IoIFP(io[0]), sfdcnewfcgi(request->in));
        sfdisc(IoOFP(io[1]), sfdcnewfcgi(out));
        sfdisc(IoOFP(io[2]), sfdcnewfcgi(error));
#else
	if (!request->svout) {
	    newSVrv(request->svout = newSV(0), "FCGI::Stream");
	    newSVrv(request->sverr = newSV(0), "FCGI::Stream");
	    newSVrv(request->svin = newSV(0), "FCGI::Stream");
	}
	sv_magic((SV *)request->gv[1] = request->gvNew[1], 
		request->svout, 'q', Nullch, 0);
	sv_magic((SV *)request->gv[2] = request->gvNew[2], 
		request->sverr, 'q', Nullch, 0);
	sv_magic((SV *)request->gv[0] = request->gvNew[0], 
		request->svin, 'q', Nullch, 0);
	sv_setiv(SvRV(request->svout), (IV) out);
	sv_setiv(SvRV(request->sverr), (IV) error);
	sv_setiv(SvRV(request->svin), (IV) request->in);

	if (request->compat) {
	    global_sverr = request->sverr;
	    if (PL_warnhook) SvREFCNT_dec(PL_warnhook);
	    PL_warnhook = SvREFCNT_inc(GvCV(gv_fetchmethod(Nullhv, "FCGI::WARN")));
	    if (PL_diehook) SvREFCNT_dec(PL_diehook);
	    PL_diehook = SvREFCNT_inc(GvCV(gv_fetchmethod(Nullhv, "FCGI::DIE")));
	}
#endif
	request->finishCalled = FALSE;
    }
    request->acceptCalled = TRUE;
    return 0;
}

static void 
FCGI_Finish(FCGP_Request* request)
{
    if(!request->acceptCalled || isCGI) {
	return;
    }
    FCGI_UndoBinding(request);
    request->in = NULL;
    FCGX_Finish_r(request->requestPtr);
    request->finishCalled = TRUE;
#ifndef USE_SFIO
    if (request->compat) {
	if (PL_warnhook == (SV*)GvCV(gv_fetchmethod(Nullhv, "FCGI::WARN"))) {
	    SvREFCNT_dec(PL_warnhook);
	    PL_warnhook = Nullsv;
	}
	if (PL_diehook == (SV*)GvCV(gv_fetchmethod(Nullhv, "FCGI::DIE"))) {
	    SvREFCNT_dec(PL_diehook);
	    PL_diehook = Nullsv;
	}
    }
#endif
}

static int 
FCGI_StartFilterData(FCGP_Request* request)
{
    return request->in ? FCGX_StartFilterData(request->in) : -1;
}

static void
FCGI_SetExitStatus(FCGP_Request* request, int status)
{
    if (request->in) FCGX_SetExitStatus(status, request->in);
}

static FCGP_Request *
FCGI_Request()
{
    FCGX_Request* fcgx_req;
    FCGP_Request* req;

    Newz(551, fcgx_req, 1, FCGX_Request);
    Newz(551, req, 1, FCGP_Request);
    req->requestPtr = fcgx_req;

    return req;
}

static void
FCGI_Release_Request(FCGP_Request *req)
{
    Safefree(req->requestPtr);
    Safefree(req);
}

static void
populate_env(envp, hv)
char **envp;
HV *hv;
{
    int i;
    char *p, *p1;
    SV   *sv;

    for(i = 0; ; i++) {
	if((p = envp[i]) == NULL) {
	    break;
	}
	p1 = strchr(p, '=');
	assert(p1 != NULL);
	sv = newSVpv(p1 + 1, 0);
	/* call magic for this value ourselves */
	hv_store(hv, p, p1 - p, sv, 0);
	SvSETMAGIC(sv);
    }
}

/*
 * For each variable in the array envp, either set or unset it
 * in the global hash %ENV.
 */
static void
DoPerlEnv(envp, set)
char **envp;
int set;
{
    if (!set)
	perl_eval_pv("%ENV = %FCGI::ENV", 0);
    else {
	perl_eval_pv("%FCGI::ENV = %ENV", 0);
	populate_env(envp, perl_get_hv("ENV", TRUE));
    }
}

#define REQUEST_ARG(arg,request) \
	if (sv_isa(ST(arg), "FCGI")) { \
	    request = (FCGP_Request*) SvIV((SV*)SvRV(ST(arg))); \
	} else \
	    croak("request is not of type FCGI")

typedef FCGX_Stream *	FCGI__Stream;
typedef FCGP_Request *	FCGI;

MODULE = FCGI		PACKAGE = FCGI

BOOT:
    FCGX_Init();
    FCGX_InitRequest(&global_fcgx_request);
    memset(&global_request, 0, sizeof(global_request));
    global_request.compat = 1;
    global_request.requestPtr = &global_fcgx_request;
    global_request.gvNew[0] = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
    global_request.gvNew[1] = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
    global_request.gvNew[2] = gv_fetchpv("STDERR",TRUE, SVt_PVIO);


SV *
request()

    PROTOTYPE:
    CODE:
    RETVAL = Perl_sv_setref_pv(Perl_newSV(0), "FCGI", FCGI_Request());

    OUTPUT:
    RETVAL


int
accept(...)

    PROTOTYPE: ;$***$

    PREINIT:
    FCGP_Request* request = &global_request;

    CODE:
    if (items != 0 && items != 5)
	croak("Usage: FCGI::accept() or "
	      "FCGI::accept(request, IN, OUT, ERR, env)");
    if (items) {
	static const char* names[] = {"", "IN", "OUT", "ERR"};
	int i;

	REQUEST_ARG(0,request);
	for(i = 1; i <= 3; ++i) {
	    if (SvROK(ST(i)) && isGV(SvRV(ST(i)))) {
		request->gvNew[i-1] = (GV*)SvRV(ST(i));
	    } else
		croak("%s is not a GLOB reference", names[i]);
	}
	if (SvROK(ST(4)) && SvTYPE(SvRV(ST(4))) == SVt_PVHV) {
	    request->hvEnv = (HV*)SvRV(ST(4));
	} else
	    croak("env is not a reference to a hash");
    }
    {
        int acceptStatus;
        /*
         * Unmake Perl variable settings for the request just completed.
         */
        if(request->envp != NULL) {
            DoPerlEnv(request->envp, FALSE);
            request->envp = NULL;
        }
        /*
         * Call FCGI_Accept but preserve environ.
         */
        acceptStatus = FCGI_Accept(request);
        /*
         * Make Perl variable settings for the new request.
         */
        if(acceptStatus >= 0 && !isCGI) {
	    if (request->compat)
		DoPerlEnv(request->envp, TRUE);
	    else {
		populate_env(request->envp, request->hvEnv);
		request->envp = NULL;
	    }
        } else {
            request->envp = NULL;
        }
        RETVAL = acceptStatus;
    }
    OUTPUT:
    RETVAL


void
finish(...)

    PROTOTYPE: ;$

    PREINIT:
    FCGP_Request* request = &global_request;

    CODE:
    if (items != 0 && items != 1)
	croak("Usage: FCGI::finish() or "
	      "FCGI::finish(request)");
    if (items) {
	REQUEST_ARG(0,request);
    }
    {
        /*
         * Unmake Perl variable settings for the completed request.
         */
        if(request->envp != NULL) {
            DoPerlEnv(request->envp, FALSE);
            request->envp = NULL;
        }
        /*
         * Finish the request.
         */
        FCGI_Finish(request);
    }


void
flush(...)

    PROTOTYPE: ;$

    PREINIT:
    FCGP_Request* request = &global_request;

    CODE:
    if (items != 0 && items != 1)
	croak("Usage: FCGI::flush([request])");
    if (items) {
	REQUEST_ARG(0,request);
    }
    FCGI_Flush(request);

void
set_exit_status(...)

    PROTOTYPE: $;$

    PREINIT:
    FCGP_Request* request = &global_request;
    int status;

    CODE:
    if (items != 1 && items != 2)
	croak("Usage: FCGI::set_exit_status(status[,request])");
    if (items == 2) {
	REQUEST_ARG(0,request);
    }
    status = (int)SvIV(ST(items-1));
    FCGI_SetExitStatus(request, status);

int
start_filter_data(...)

    PROTOTYPE: ;$

    PREINIT:
    FCGP_Request* request = &global_request;

    CODE:
    if (items != 0 && items != 1)
	croak("Usage: FCGI::flush([request])");
    if (items) {
	REQUEST_ARG(0,request);
    }
    RETVAL = FCGI_StartFilterData(request);

    OUTPUT:
    RETVAL


void
DESTROY(request)
    FCGI    request;

    CODE:
    FCGI_Release_Request(request);


MODULE = FCGI		PACKAGE = FCGI::Stream

#ifndef USE_SFIO
void
DIE(msg)
	char *	msg;

	CODE:
	if (!PL_in_eval) /* ? maybe !(PL_in_eval & 1) */
	    FCGX_PutS(msg, (FCGX_Stream *) SvIV((SV*) SvRV(global_sverr)));

void
WARN(msg)
	char *	msg;

	CODE:
	FCGX_PutS(msg, (FCGX_Stream *) SvIV((SV*) SvRV(global_sverr)));

void
PRINT(stream, ...)
	FCGI::Stream	stream;

	PREINIT:
	int	n;

	CODE:
	for (n = 1; n < items; ++n) {
            STRLEN len;
            register char *tmps = (char *)SvPV(ST(n),len);
            FCGX_PutStr(tmps, len, stream);
	}
	if (SvTRUEx(perl_get_sv("|", FALSE))) 
	    FCGX_FFlush(stream);

int
WRITE(stream, bufsv, len, ...)
	FCGI::Stream	stream;
	SV *	bufsv;
	int	len;

	PREINIT:
	int	offset;
	char *	buf;
	STRLEN	blen;
	int	n;

	CODE:
	offset = (items == 4) ? (int)SvIV(ST(3)) : 0;
	buf = SvPV(bufsv, blen);
	if (offset < 0) offset += blen;
	if (len > blen - offset)
	    len = blen - offset;
	if (offset < 0 || offset >= blen ||
		(n = FCGX_PutStr(buf+offset, len, stream)) < 0) 
	    ST(0) = &PL_sv_undef;
	else {
	    ST(0) = sv_newmortal();
	    sv_setpvf(ST(0), "%c", n);
	}

int
READ(stream, bufsv, len, ...)
	FCGI::Stream	stream;
	SV *	bufsv;
	int	len;

	PREINIT:
	int	offset;
	char *	buf;

	CODE:
	offset = (items == 4) ? (int)SvIV(ST(3)) : 0;
	if (! SvOK(bufsv))
	    sv_setpvn(bufsv, "", 0);
	buf = SvGROW(bufsv, len+offset+1);
	len = FCGX_GetStr(buf+offset, len, stream);
	SvCUR_set(bufsv, len+offset);
	*SvEND(bufsv) = '\0';
	(void)SvPOK_only(bufsv);
	SvSETMAGIC(bufsv);
	RETVAL = len;

	OUTPUT:
	RETVAL

SV *
GETC(stream)
	FCGI::Stream	stream;

	PREINIT:
	int	retval;

	CODE:
	if ((retval = FCGX_GetChar(stream)) != -1) {
	    ST(0) = sv_newmortal();
	    sv_setpvf(ST(0), "%c", retval);
	} else ST(0) = &PL_sv_undef;

bool
CLOSE(stream)
	FCGI::Stream	stream;

	ALIAS:
	DESTROY = 1

	CODE:
	RETVAL = FCGX_FClose(stream) != -1;

	OUTPUT:
	RETVAL

#endif
Commit	Line	Data
1b64d24d	1	use Config;
	2
	3	open OUT, ">FCGI.xs";
	4
	5	print "Generating FCGI.xs for Perl version $]\n";
	6	#unless (exists $Config{apiversion} && $Config{apiversion} >= 5.005)
	7	unless ($] >= 5.005) {
	8	for (qw(sv_undef diehook warnhook in_eval)) {
	9	print OUT "#define PL_$_ $_\n"
	10	}
	11	}
	12	print OUT while <DATA>;
	13	close OUT;
	14	__END__
cebfd7c4	15	/* $Id: FCGI.PL,v 1.8 1999/07/30 08:22:31 skimo Exp $ */
1b64d24d	16
	17	#include "EXTERN.h"
	18	#include "perl.h"
	19	#include "XSUB.h"
	20
	21	#include "fcgiapp.h"
	22
	23	#ifndef FALSE
	24	#define FALSE (0)
	25	#endif
	26
	27	#ifndef TRUE
	28	#define TRUE (1)
	29	#endif
	30
0074e702	31	#ifdef WIN32
	32	#define environ _environ
	33	#endif
	34
1b64d24d	35	extern char **environ;
1b64d24d	36
	37	#ifdef USE_SFIO
	38	typedef struct
	39	{
	40	Sfdisc_t disc;
	41	FCGX_Stream *stream;
	42	} FCGI_Disc;
	43
	44	static ssize_t
	45	sffcgiread(f, buf, n, disc)
	46	Sfio_t* f; /* stream involved */
	47	Void_t* buf; /* buffer to read into */
	48	size_t n; /* number of bytes to read */
	49	Sfdisc_t* disc; /* discipline */
	50	{
	51	return FCGX_GetStr(buf, n, ((FCGI_Disc *)disc)->stream);
	52	}
	53
	54	static ssize_t
	55	sffcgiwrite(f, buf, n, disc)
	56	Sfio_t* f; /* stream involved */
	57	const Void_t* buf; /* buffer to read into */
	58	size_t n; /* number of bytes to read */
	59	Sfdisc_t* disc; /* discipline */
	60	{
	61	n = FCGX_PutStr(buf, n, ((FCGI_Disc *)disc)->stream);
	62	FCGX_FFlush(((FCGI_Disc *)disc)->stream);
	63	return n;
	64	}
	65
	66	Sfdisc_t *
	67	sfdcnewfcgi(stream)
	68	FCGX_Stream *stream;
	69	{
	70	FCGI_Disc* disc;
	71
	72	New(1000,disc,1,FCGI_Disc);
	73	if (!disc) return (Sfdisc_t *)disc;
	74
	75	disc->disc.exceptf = (Sfexcept_f)NULL;
	76	disc->disc.seekf = (Sfseek_f)NULL;
	77	disc->disc.readf = sffcgiread;
	78	disc->disc.writef = sffcgiwrite;
	79	disc->stream = stream;
	80	return (Sfdisc_t *)disc;
	81	}
	82
	83	Sfdisc_t *
	84	sfdcdelfcgi(disc)
	85	Sfdisc_t* disc;
	86	{
	87	Safefree(disc);
	88	return 0;
	89	}
	90	#endif
	91
90a18d65	92	static int isCGI = -1; /* -1: not checked; 0: FCGI; 1: FCGI */
	93
	94	static FCGX_Request global_fcgx_request;
	95
	96	typedef struct FCGP_Request {
	97	int compat;
	98	int acceptCalled;
	99	int finishCalled;
	100	SV* svin;
	101	SV* svout;
	102	SV* sverr;
eede4b76	103	GV* gv[3];
cebfd7c4	104	GV* gvNew[3];
34bfd355	105	HV* hvEnv;
90a18d65	106	FCGX_Stream* in;
eede4b76	107	FCGX_ParamArray envp;
90a18d65	108	FCGX_Request* requestPtr;
2c38ecd7	109	#ifdef USE_SFIO
	110	int sfcreated[3];
	111	#endif
90a18d65	112	} FCGP_Request;
	113
	114	static FCGP_Request global_request;
	115	static SV* global_sverr;
1b64d24d	116
1b64d24d	117	static int
90a18d65	118	FCGI_Flush(FCGP_Request* request)
1b64d24d	119	{
eede4b76	120	if(!request->acceptCalled \|\| isCGI) {
1b64d24d	121	return;
	122	}
	123	#ifdef USE_SFIO
2c38ecd7	124	sfsync(IoOFP(GvIOp(request->gv[1])));
2c38ecd7	125	sfsync(IoOFP(GvIOp(request->gv[2])));
1b64d24d	126	#else
90a18d65	127	FCGX_FFlush((FCGX_Stream ) SvIV((SV) SvRV(request->svout)));
90a18d65	128	FCGX_FFlush((FCGX_Stream ) SvIV((SV) SvRV(request->sverr)));
1b64d24d	129	#endif
	130	}
	131
34bfd355	132	static void
	133	FCGI_UndoBinding(FCGP_Request* request)
	134	{
	135	#ifdef USE_SFIO
2c38ecd7	136	IO *io[3];
	137	int i;
	138	#endif
	139
	140	#ifdef USE_SFIO
	141	sfdcdelfcgi(sfdisc(IoIFP(io[0] = GvIOp(request->gv[0])), SF_POPDISC));
	142	sfdcdelfcgi(sfdisc(IoOFP(io[1] = GvIOp(request->gv[1])), SF_POPDISC));
	143	sfdcdelfcgi(sfdisc(IoOFP(io[2] = GvIOp(request->gv[2])), SF_POPDISC));
	144	for (i = 0; i < 3; ++i) {
	145	if (request->sfcreated[i]) {
	146	sfclose(IoIFP(io[i]));
	147	IoIFP(io[i]) = IoOFP(io[i]) = Nullfp;
	148	request->sfcreated[i] = FALSE;
	149	}
	150	}
34bfd355	151	#else
	152	FCGI_Flush(request);
	153	sv_unmagic((SV *)request->gv[0], 'q');
	154	sv_unmagic((SV *)request->gv[1], 'q');
	155	sv_unmagic((SV *)request->gv[2], 'q');
	156	#endif
	157	}
	158
1b64d24d	159	static int
cebfd7c4	160	FCGI_Accept(FCGP_Request* request)
1b64d24d	161	{
90a18d65	162	if(isCGI == -1) {
1b64d24d	163	/*
	164	* First call to FCGI_Accept. Is application running
	165	* as FastCGI or as CGI?
	166	*/
	167	isCGI = FCGX_IsCGI();
	168	} else if(isCGI) {
	169	/*
	170	* Not first call to FCGI_Accept and running as CGI means
	171	* application is done.
	172	*/
	173	return(EOF);
eede4b76	174	}
eede4b76	175	if(request->acceptCalled && !request->finishCalled) {
34bfd355	176	FCGI_UndoBinding(request);
1b64d24d	177	}
1b64d24d	178	if(!isCGI) {
2c38ecd7	179	#ifdef USE_SFIO
	180	IO *io[3];
	181	int i;
	182	#endif
1b64d24d	183	FCGX_Stream out, error;
eede4b76	184	int acceptResult = FCGX_Accept_r(&request->in, &out, &error,
eede4b76	185	&request->envp,
90a18d65	186	request->requestPtr);
1b64d24d	187	if(acceptResult < 0) {
	188	return acceptResult;
	189	}
	190	#ifdef USE_SFIO
2c38ecd7	191	for (i = 0; i < 3; ++i) {
cebfd7c4	192	io[i] = GvIOn(request->gv[i] = request->gvNew[i]);
2c38ecd7	193	if (!(i == 0 ? IoIFP(io[i]) : IoOFP(io[i]))) {
	194	IoIFP(io[i]) = sftmp(0);
	195	/*IoIFP(io[i]) = sfnew(NULL, NULL, SF_UNBOUND, 0,
	196	SF_STRING \| (i ? SF_WRITE : SF_READ));*/
	197	if (i != 0) IoOFP(io[i]) = IoIFP(io[i]);
	198	request->sfcreated[i] = TRUE;
	199	}
	200	}
	201	sfdisc(IoIFP(io[0]), sfdcnewfcgi(request->in));
	202	sfdisc(IoOFP(io[1]), sfdcnewfcgi(out));
	203	sfdisc(IoOFP(io[2]), sfdcnewfcgi(error));
1b64d24d	204	#else
90a18d65	205	if (!request->svout) {
eede4b76	206	newSVrv(request->svout = newSV(0), "FCGI::Stream");
eede4b76	207	newSVrv(request->sverr = newSV(0), "FCGI::Stream");
eede4b76	208	newSVrv(request->svin = newSV(0), "FCGI::Stream");
1b64d24d	209	}
cebfd7c4	210	sv_magic((SV *)request->gv[1] = request->gvNew[1],
	211	request->svout, 'q', Nullch, 0);
	212	sv_magic((SV *)request->gv[2] = request->gvNew[2],
	213	request->sverr, 'q', Nullch, 0);
	214	sv_magic((SV *)request->gv[0] = request->gvNew[0],
	215	request->svin, 'q', Nullch, 0);
90a18d65	216	sv_setiv(SvRV(request->svout), (IV) out);
	217	sv_setiv(SvRV(request->sverr), (IV) error);
	218	sv_setiv(SvRV(request->svin), (IV) request->in);
	219
	220	if (request->compat) {
	221	global_sverr = request->sverr;
6ef7789b	222	if (PL_warnhook) SvREFCNT_dec(PL_warnhook);
6ef7789b	223	PL_warnhook = SvREFCNT_inc(GvCV(gv_fetchmethod(Nullhv, "FCGI::WARN")));
6ef7789b	224	if (PL_diehook) SvREFCNT_dec(PL_diehook);
	225	PL_diehook = SvREFCNT_inc(GvCV(gv_fetchmethod(Nullhv, "FCGI::DIE")));
	226	}
1b64d24d	227	#endif
90a18d65	228	request->finishCalled = FALSE;
1b64d24d	229	}
90a18d65	230	request->acceptCalled = TRUE;
1b64d24d	231	return 0;
	232	}
	233
	234	static void
90a18d65	235	FCGI_Finish(FCGP_Request* request)
1b64d24d	236	{
90a18d65	237	if(!request->acceptCalled \|\| isCGI) {
1b64d24d	238	return;
1b64d24d	239	}
34bfd355	240	FCGI_UndoBinding(request);
90a18d65	241	request->in = NULL;
	242	FCGX_Finish_r(request->requestPtr);
	243	request->finishCalled = TRUE;
	244	#ifndef USE_SFIO
	245	if (request->compat) {
	246	if (PL_warnhook == (SV*)GvCV(gv_fetchmethod(Nullhv, "FCGI::WARN"))) {
	247	SvREFCNT_dec(PL_warnhook);
	248	PL_warnhook = Nullsv;
	249	}
	250	if (PL_diehook == (SV*)GvCV(gv_fetchmethod(Nullhv, "FCGI::DIE"))) {
	251	SvREFCNT_dec(PL_diehook);
	252	PL_diehook = Nullsv;
	253	}
1b64d24d	254	}
	255	#endif
	256	}
	257
	258	static int
90a18d65	259	FCGI_StartFilterData(FCGP_Request* request)
	260	{
	261	return request->in ? FCGX_StartFilterData(request->in) : -1;
	262	}
	263
	264	static void
	265	FCGI_SetExitStatus(FCGP_Request* request, int status)
	266	{
	267	if (request->in) FCGX_SetExitStatus(status, request->in);
	268	}
	269
	270	static FCGP_Request *
	271	FCGI_Request()
1b64d24d	272	{
90a18d65	273	FCGX_Request* fcgx_req;
	274	FCGP_Request* req;
	275
	276	Newz(551, fcgx_req, 1, FCGX_Request);
	277	Newz(551, req, 1, FCGP_Request);
	278	req->requestPtr = fcgx_req;
	279
	280	return req;
1b64d24d	281	}
	282
	283	static void
90a18d65	284	FCGI_Release_Request(FCGP_Request *req)
1b64d24d	285	{
90a18d65	286	Safefree(req->requestPtr);
90a18d65	287	Safefree(req);
1b64d24d	288	}
1b64d24d	289
34bfd355	290	static void
	291	populate_env(envp, hv)
	292	char **envp;
	293	HV *hv;
	294	{
	295	int i;
	296	char p, p1;
	297	SV *sv;
	298
	299	for(i = 0; ; i++) {
	300	if((p = envp[i]) == NULL) {
	301	break;
	302	}
	303	p1 = strchr(p, '=');
	304	assert(p1 != NULL);
	305	sv = newSVpv(p1 + 1, 0);
	306	/* call magic for this value ourselves */
	307	hv_store(hv, p, p1 - p, sv, 0);
	308	SvSETMAGIC(sv);
	309	}
	310	}
	311
1b64d24d	312	/*
	313	* For each variable in the array envp, either set or unset it
	314	* in the global hash %ENV.
	315	*/
	316	static void
	317	DoPerlEnv(envp, set)
	318	char **envp;
	319	int set;
	320	{
1b64d24d	321	if (!set)
	322	perl_eval_pv("%ENV = %FCGI::ENV", 0);
	323	else {
	324	perl_eval_pv("%FCGI::ENV = %ENV", 0);
34bfd355	325	populate_env(envp, perl_get_hv("ENV", TRUE));
1b64d24d	326	}
	327	}
	328
eede4b76	329	#define REQUEST_ARG(arg,request) \
	330	if (sv_isa(ST(arg), "FCGI")) { \
	331	request = (FCGP_Request) SvIV((SV)SvRV(ST(arg))); \
	332	} else \
	333	croak("request is not of type FCGI")
1b64d24d	334
eede4b76	335	typedef FCGX_Stream * FCGI__Stream;
eede4b76	336	typedef FCGP_Request * FCGI;
1b64d24d	337
	338	MODULE = FCGI PACKAGE = FCGI
	339
90a18d65	340	BOOT:
	341	FCGX_Init();
	342	FCGX_InitRequest(&global_fcgx_request);
	343	memset(&global_request, 0, sizeof(global_request));
	344	global_request.compat = 1;
	345	global_request.requestPtr = &global_fcgx_request;
cebfd7c4	346	global_request.gvNew[0] = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
	347	global_request.gvNew[1] = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
	348	global_request.gvNew[2] = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
eede4b76	349
	350
	351	SV *
	352	request()
	353
	354	PROTOTYPE:
	355	CODE:
	356	RETVAL = Perl_sv_setref_pv(Perl_newSV(0), "FCGI", FCGI_Request());
	357
	358	OUTPUT:
	359	RETVAL
	360
	361
	362	int
	363	accept(...)
	364
	365	PROTOTYPE: ;$***$
	366
	367	PREINIT:
	368	FCGP_Request* request = &global_request;
	369
	370	CODE:
	371	if (items != 0 && items != 5)
	372	croak("Usage: FCGI::accept() or "
	373	"FCGI::accept(request, IN, OUT, ERR, env)");
	374	if (items) {
	375	static const char* names[] = {"", "IN", "OUT", "ERR"};
	376	int i;
	377
	378	REQUEST_ARG(0,request);
	379	for(i = 1; i <= 3; ++i) {
	380	if (SvROK(ST(i)) && isGV(SvRV(ST(i)))) {
cebfd7c4	381	request->gvNew[i-1] = (GV*)SvRV(ST(i));
eede4b76	382	} else
	383	croak("%s is not a GLOB reference", names[i]);
	384	}
34bfd355	385	if (SvROK(ST(4)) && SvTYPE(SvRV(ST(4))) == SVt_PVHV) {
	386	request->hvEnv = (HV*)SvRV(ST(4));
	387	} else
	388	croak("env is not a reference to a hash");
eede4b76	389	}
eede4b76	390	{
eede4b76	391	int acceptStatus;
	392	/*
	393	* Unmake Perl variable settings for the request just completed.
	394	*/
	395	if(request->envp != NULL) {
	396	DoPerlEnv(request->envp, FALSE);
	397	request->envp = NULL;
	398	}
	399	/*
	400	* Call FCGI_Accept but preserve environ.
	401	*/
cebfd7c4	402	acceptStatus = FCGI_Accept(request);
eede4b76	403	/*
	404	* Make Perl variable settings for the new request.
	405	*/
34bfd355	406	if(acceptStatus >= 0 && !isCGI) {
	407	if (request->compat)
	408	DoPerlEnv(request->envp, TRUE);
	409	else {
	410	populate_env(request->envp, request->hvEnv);
	411	request->envp = NULL;
	412	}
eede4b76	413	} else {
	414	request->envp = NULL;
	415	}
	416	RETVAL = acceptStatus;
	417	}
	418	OUTPUT:
	419	RETVAL
	420
	421
	422	void
	423	finish(...)
	424
	425	PROTOTYPE: ;$
	426
	427	PREINIT:
	428	FCGP_Request* request = &global_request;
	429
	430	CODE:
	431	if (items != 0 && items != 1)
	432	croak("Usage: FCGI::finish() or "
	433	"FCGI::finish(request)");
	434	if (items) {
	435	REQUEST_ARG(0,request);
	436	}
	437	{
	438	/*
	439	* Unmake Perl variable settings for the completed request.
	440	*/
	441	if(request->envp != NULL) {
	442	DoPerlEnv(request->envp, FALSE);
	443	request->envp = NULL;
	444	}
	445	/*
	446	* Finish the request.
	447	*/
	448	FCGI_Finish(request);
	449	}
	450
	451
	452	void
	453	flush(...)
	454
	455	PROTOTYPE: ;$
	456
	457	PREINIT:
	458	FCGP_Request* request = &global_request;
	459
	460	CODE:
	461	if (items != 0 && items != 1)
	462	croak("Usage: FCGI::flush([request])");
	463	if (items) {
	464	REQUEST_ARG(0,request);
	465	}
	466	FCGI_Flush(request);
	467
	468	void
cebfd7c4	469	set_exit_status(...)
eede4b76	470
	471	PROTOTYPE: $;$
	472
	473	PREINIT:
	474	FCGP_Request* request = &global_request;
cebfd7c4	475	int status;
eede4b76	476
	477	CODE:
	478	if (items != 1 && items != 2)
	479	croak("Usage: FCGI::set_exit_status(status[,request])");
	480	if (items == 2) {
cebfd7c4	481	REQUEST_ARG(0,request);
eede4b76	482	}
cebfd7c4	483	status = (int)SvIV(ST(items-1));
eede4b76	484	FCGI_SetExitStatus(request, status);
	485
	486	int
	487	start_filter_data(...)
	488
	489	PROTOTYPE: ;$
	490
	491	PREINIT:
	492	FCGP_Request* request = &global_request;
	493
	494	CODE:
	495	if (items != 0 && items != 1)
	496	croak("Usage: FCGI::flush([request])");
	497	if (items) {
	498	REQUEST_ARG(0,request);
	499	}
	500	RETVAL = FCGI_StartFilterData(request);
	501
	502	OUTPUT:
	503	RETVAL
	504
	505
	506	void
	507	DESTROY(request)
	508	FCGI request;
	509
	510	CODE:
	511	FCGI_Release_Request(request);
	512
	513
	514
	515	MODULE = FCGI PACKAGE = FCGI::Stream
90a18d65	516
1b64d24d	517	#ifndef USE_SFIO
	518	void
	519	DIE(msg)
	520	char * msg;
	521
	522	CODE:
cebfd7c4	523	if (!PL_in_eval) /* ? maybe !(PL_in_eval & 1) */
90a18d65	524	FCGX_PutS(msg, (FCGX_Stream ) SvIV((SV) SvRV(global_sverr)));
1b64d24d	525
	526	void
	527	WARN(msg)
	528	char * msg;
	529
	530	CODE:
90a18d65	531	FCGX_PutS(msg, (FCGX_Stream ) SvIV((SV) SvRV(global_sverr)));
1b64d24d	532
	533	void
	534	PRINT(stream, ...)
eede4b76	535	FCGI::Stream stream;
1b64d24d	536
	537	PREINIT:
	538	int n;
	539
	540	CODE:
	541	for (n = 1; n < items; ++n) {
	542	STRLEN len;
	543	register char tmps = (char )SvPV(ST(n),len);
	544	FCGX_PutStr(tmps, len, stream);
	545	}
	546	if (SvTRUEx(perl_get_sv("\|", FALSE)))
	547	FCGX_FFlush(stream);
	548
	549	int
	550	WRITE(stream, bufsv, len, ...)
eede4b76	551	FCGI::Stream stream;
1b64d24d	552	SV * bufsv;
	553	int len;
	554
	555	PREINIT:
	556	int offset;
	557	char * buf;
	558	STRLEN blen;
	559	int n;
	560
	561	CODE:
	562	offset = (items == 4) ? (int)SvIV(ST(3)) : 0;
	563	buf = SvPV(bufsv, blen);
	564	if (offset < 0) offset += blen;
	565	if (len > blen - offset)
	566	len = blen - offset;
	567	if (offset < 0 \|\| offset >= blen \|\|
	568	(n = FCGX_PutStr(buf+offset, len, stream)) < 0)
	569	ST(0) = &PL_sv_undef;
	570	else {
	571	ST(0) = sv_newmortal();
	572	sv_setpvf(ST(0), "%c", n);
	573	}
	574
	575	int
	576	READ(stream, bufsv, len, ...)
eede4b76	577	FCGI::Stream stream;
1b64d24d	578	SV * bufsv;
	579	int len;
	580
	581	PREINIT:
	582	int offset;
	583	char * buf;
	584
	585	CODE:
	586	offset = (items == 4) ? (int)SvIV(ST(3)) : 0;
	587	if (! SvOK(bufsv))
	588	sv_setpvn(bufsv, "", 0);
	589	buf = SvGROW(bufsv, len+offset+1);
	590	len = FCGX_GetStr(buf+offset, len, stream);
	591	SvCUR_set(bufsv, len+offset);
	592	*SvEND(bufsv) = '\0';
	593	(void)SvPOK_only(bufsv);
	594	SvSETMAGIC(bufsv);
	595	RETVAL = len;
	596
	597	OUTPUT:
	598	RETVAL
	599
	600	SV *
	601	GETC(stream)
eede4b76	602	FCGI::Stream stream;
1b64d24d	603
	604	PREINIT:
	605	int retval;
	606
	607	CODE:
	608	if ((retval = FCGX_GetChar(stream)) != -1) {
	609	ST(0) = sv_newmortal();
	610	sv_setpvf(ST(0), "%c", retval);
	611	} else ST(0) = &PL_sv_undef;
	612
	613	bool
	614	CLOSE(stream)
eede4b76	615	FCGI::Stream stream;
1b64d24d	616
	617	ALIAS:
	618	DESTROY = 1
	619
	620	CODE:
	621	RETVAL = FCGX_FClose(stream) != -1;
	622
	623	OUTPUT:
	624	RETVAL
	625
	626	#endif