Version 0.54 changes
[catagits/fcgi2.git] / perl / FCGI.PL
index b4a60bd..b148dcb 100644 (file)
@@ -12,13 +12,15 @@ unless ($] >= 5.005) {
 print OUT while <DATA>;
 close OUT;
 __END__
-/* $Id: FCGI.PL,v 1.1 1999/02/13 05:26:42 roberts Exp $ */
+/* $Id: FCGI.PL,v 1.15 2000/07/10 09:56:49 skimo Exp $ */
 
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 
+#include "fcgi_config.h"
 #include "fcgiapp.h"
+#include "fastcgi.h"
 
 #ifndef FALSE
 #define FALSE (0)
@@ -28,8 +30,9 @@ __END__
 #define TRUE  (1)
 #endif
 
-extern char **environ;
-static char **requestEnviron = NULL;
+#ifndef dTHX
+#define dTHX
+#endif
 
 #ifdef USE_SFIO
 typedef struct
@@ -86,193 +89,391 @@ sfdcdelfcgi(disc)
 }
 #endif
 
-static int acceptCalled = FALSE;
-static int finishCalled = FALSE;
-static int isCGI = FALSE;
-static FCGX_Stream *in = NULL;
-static SV *svout = NULL, *svin, *sverr;
+#if defined(USE_LOCKING) && defined(USE_THREADS)
+static perl_mutex   accept_mutex;
+#endif
+
+typedef struct FCGP_Request {
+    int                    accepted;
+    int                    bound;
+    SV*                    svin;
+    SV*                    svout;
+    SV*                    sverr;
+    GV*                    gv[3];
+    HV*                    hvEnv;
+    FCGX_Request*   requestPtr;
+#ifdef USE_SFIO
+    int                    sfcreated[3];
+    IO*                    io[3];
+#endif
+} FCGP_Request;
+
+static void FCGI_Finish(FCGP_Request* request);
 
 static int 
-FCGI_Flush(void)
+FCGI_Flush(FCGP_Request* request)
 {
-    if(!acceptCalled || isCGI) {
+    dTHX;
+
+    if(!request->bound) {
        return;
     }
 #ifdef USE_SFIO
-    sfsync(PerlIO_stdout());
-    sfsync(PerlIO_stderr());
+    sfsync(IoOFP(GvIOp(request->gv[1])));
+    sfsync(IoOFP(GvIOp(request->gv[2])));
 #else
-    FCGX_FFlush((FCGX_Stream *) SvIV((SV*) SvRV(svout)));
-    FCGX_FFlush((FCGX_Stream *) SvIV((SV*) SvRV(sverr)));
+    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)
+{
+    dTHX;
+
+#ifdef USE_SFIO
+    sfdcdelfcgi(sfdisc(IoIFP(request->io[0]), SF_POPDISC));
+    sfdcdelfcgi(sfdisc(IoOFP(request->io[1]), SF_POPDISC));
+    sfdcdelfcgi(sfdisc(IoOFP(request->io[2]), SF_POPDISC));
+#else
+    sv_unmagic((SV *)request->gv[0], 'q');
+    sv_unmagic((SV *)request->gv[1], 'q');
+    sv_unmagic((SV *)request->gv[2], 'q');
+#endif
+    request->bound = FALSE;
+}
+
+static void
+FCGI_Bind(FCGP_Request* request)
+{
+    dTHX;
+
+#ifdef USE_SFIO
+    sfdisc(IoIFP(request->io[0]), sfdcnewfcgi(request->requestPtr->in));
+    sfdisc(IoOFP(request->io[1]), sfdcnewfcgi(request->requestPtr->out));
+    sfdisc(IoOFP(request->io[2]), sfdcnewfcgi(request->requestPtr->err));
+#else
+    sv_magic((SV *)request->gv[1], request->svout, 'q', Nullch, 0);
+    sv_magic((SV *)request->gv[2], request->sverr, 'q', Nullch, 0);
+    sv_magic((SV *)request->gv[0], request->svin, 'q', Nullch, 0);
+#endif
+    request->bound = TRUE;
+}
+
+static void
+populate_env(envp, hv)
+char **envp;
+HV *hv;
+{
+    int i;
+    char *p, *p1;
+    SV   *sv;
+    dTHX;
+
+    hv_clear(hv);
+    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);
+    }
+}
+
 static int 
-FCGI_Accept(void)
+FCGI_Accept(FCGP_Request* request)
 {
-    if(!acceptCalled) {
+    static int isCGI = -1; /* -1: not checked; 0: FCGI; 1: FCGI */
+
+    int req_isCGI = 
+       request->requestPtr->listen_sock == FCGI_LISTENSOCK_FILENO ?
+       isCGI : 0;
+
+    dTHX;
+
+    if(req_isCGI == -1) {
         /*
          * First call to FCGI_Accept.  Is application running
          * as FastCGI or as CGI?
          */
-        isCGI = FCGX_IsCGI();
-    } else if(isCGI) {
+        req_isCGI = isCGI = FCGX_IsCGI();
+    } else if(req_isCGI) {
         /*
          * Not first call to FCGI_Accept and running as CGI means
          * application is done.
          */
         return(EOF);
-    } else {
-       if(!finishCalled) {
+    } 
+    if(!req_isCGI) {
 #ifdef USE_SFIO
-            sfdcdelfcgi(sfdisc(PerlIO_stdin(), SF_POPDISC));
-            sfdcdelfcgi(sfdisc(PerlIO_stdout(), SF_POPDISC));
-            sfdcdelfcgi(sfdisc(PerlIO_stderr(), SF_POPDISC));
-#else
-           FCGI_Flush();
+       int i;
+#endif
+       FCGX_Request *fcgx_req = request->requestPtr;
+        int acceptResult;
+
+       FCGI_Finish(request);
+#if defined(USE_LOCKING) && defined(USE_THREADS)
+       MUTEX_LOCK(&accept_mutex);
+#endif
+       acceptResult = FCGX_Accept_r(fcgx_req);
+#if defined(USE_LOCKING) && defined(USE_THREADS)
+       MUTEX_UNLOCK(&accept_mutex);
 #endif
-       }
-    }
-    if(!isCGI) {
-        FCGX_ParamArray envp;
-       FCGX_Stream *out, *error;
-        int acceptResult = FCGX_Accept(&in, &out, &error, &envp);
         if(acceptResult < 0) {
             return acceptResult;
         }
+
+       populate_env(fcgx_req->envp, request->hvEnv);
+
 #ifdef USE_SFIO
-        sfdisc(PerlIO_stdin(), sfdcnewfcgi(in));
-        sfdisc(PerlIO_stdout(), sfdcnewfcgi(out));
-        sfdisc(PerlIO_stderr(), sfdcnewfcgi(error));
+       for (i = 0; i < 3; ++i) {
+           request->io[i] = GvIOn(request->gv[i]);
+           if (!(i == 0 ? IoIFP(request->io[i]) 
+                        : IoOFP(request->io[i]))) {
+               IoIFP(request->io[i]) = sftmp(0);
+               /*IoIFP(request->io[i]) = sfnew(NULL, NULL, SF_UNBOUND, 0, 
+                                    SF_STRING | (i ? SF_WRITE : SF_READ));*/
+               if (i != 0) 
+                   IoOFP(request->io[i]) = IoIFP(request->io[i]);
+               request->sfcreated[i] = TRUE;
+           }
+       }
 #else
-       if (!svout) {
-           newSVrv(svout = newSV(0), "FCGI");
-           sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), 
-                       svout, 'q', Nullch, 0);
-           newSVrv(sverr = newSV(0), "FCGI");
-           sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), 
-                       sverr, 'q', Nullch, 0);
-           newSVrv(svin = newSV(0), "FCGI");
-           sv_magic((SV *)gv_fetchpv("STDIN",TRUE, SVt_PVIO), 
-                       svin, 'q', Nullch, 0);
+       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_setiv(SvRV(svout), (IV) out);
-       sv_setiv(SvRV(sverr), (IV) error);
-       sv_setiv(SvRV(svin), (IV) in);
-       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")));
+       sv_setiv(SvRV(request->svout), (IV) fcgx_req->out);
+       sv_setiv(SvRV(request->sverr), (IV) fcgx_req->err);
+       sv_setiv(SvRV(request->svin), (IV) fcgx_req->in);
 #endif
-       finishCalled = FALSE;
-        environ = envp;
+       FCGI_Bind(request);
+       request->accepted = TRUE;
     }
-    acceptCalled = TRUE;
     return 0;
 }
 
 static void 
-FCGI_Finish(void)
+FCGI_Finish(FCGP_Request* request)
 {
-    if(!acceptCalled || isCGI) {
-       return;
-    }
 #ifdef USE_SFIO
-    sfdcdelfcgi(sfdisc(PerlIO_stdin(), SF_POPDISC));
-    sfdcdelfcgi(sfdisc(PerlIO_stdout(), SF_POPDISC));
-    sfdcdelfcgi(sfdisc(PerlIO_stderr(), SF_POPDISC));
-#else
-    FCGI_Flush();
+    int i;
 #endif
-    in = NULL;
-    FCGX_Finish();
-    /*
-    environ = NULL;
-    */
-    finishCalled = TRUE;
-#ifndef USE_SFIO
-    if (PL_warnhook) {
-       SvREFCNT_dec(PL_warnhook);
-       PL_warnhook = Nullsv;
+    dTHX;
+
+    if(!request->accepted) {
+       return;
     }
-    if (PL_diehook) {
-       SvREFCNT_dec(PL_diehook);
-       PL_diehook = Nullsv;
+
+    if (request->bound) {
+       FCGI_UndoBinding(request);
+    }
+#ifdef USE_SFIO
+    for (i = 0; i < 3; ++i) {
+       if (request->sfcreated[i]) {
+           sfclose(IoIFP(request->io[i]));
+           IoIFP(request->io[i]) = IoOFP(request->io[i]) = Nullfp;
+           request->sfcreated[i] = FALSE;
+       }
     }
 #endif
+    FCGX_Finish_r(request->requestPtr);
+    request->accepted = FALSE;
 }
 
 static int 
-FCGI_StartFilterData(void)
+FCGI_StartFilterData(FCGP_Request* request)
 {
-    return in ? FCGX_StartFilterData(in) : -1;
+    return request->requestPtr->in ? 
+           FCGX_StartFilterData(request->requestPtr->in) : -1;
 }
 
-static void
-FCGI_SetExitStatus(int status)
+static FCGP_Request *
+FCGI_Request(in, out, err, env, socket, flags)
+    GV*            in;
+    GV*            out;
+    GV*            err;
+    HV*            env;
+    int            socket;
+    int            flags;
 {
-    if (in) FCGX_SetExitStatus(status, in);
+    FCGX_Request* fcgx_req;
+    FCGP_Request* req;
+
+    Newz(551, fcgx_req, 1, FCGX_Request);
+    FCGX_InitRequest(fcgx_req, socket, flags);
+    Newz(551, req, 1, FCGP_Request);
+    req->requestPtr = fcgx_req;
+    req->gv[0] = in;
+    req->gv[1] = out;
+    req->gv[2] = err;
+    req->hvEnv = env;
+
+    return req;
 }
 
-/*
- * 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;
+FCGI_Release_Request(FCGP_Request *req)
 {
-    int i;
-    char *p, *p1;
-    HV   *hv;
-    SV   *sv;
-    hv = perl_get_hv("ENV", TRUE);
-
-    if (!set)
-       perl_eval_pv("%ENV = %FCGI::ENV", 0);
-    else {
-       perl_eval_pv("%FCGI::ENV = %ENV", 0);
-       for(i = 0; ; i++) {
-           if((p = envp[i]) == NULL) {
-               break;
-           }
-           p1 = strchr(p, '=');
-           assert(p1 != NULL);
-           *p1 = '\0';
-           sv = newSVpv(p1 + 1, 0);
-           /* call magic for this value ourselves */
-           hv_store(hv, p, p1 - p, sv, 0);
-           SvSETMAGIC(sv);
-           *p1 = '=';
-       }
-    }
+    FCGI_Finish(req);
+    Safefree(req->requestPtr);
+    Safefree(req);
 }
 
+static void
+FCGI_Init()
+{
+#if defined(USE_LOCKING) && defined(USE_THREADS)
+    dTHX;
+
+    MUTEX_INIT(&accept_mutex);
+#endif
+}
 
-typedef FCGX_Stream *  FCGI;
+typedef FCGX_Stream *  FCGI__Stream;
+typedef FCGP_Request * FCGI;
+typedef        GV*             GLOBREF;
+typedef        HV*             HASHREF;
 
 MODULE = FCGI          PACKAGE = FCGI
 
-#ifndef USE_SFIO
+BOOT:
+    FCGI_Init();
+
+SV *
+RequestX(in, out, err, env, socket, flags)
+    GLOBREF in;
+    GLOBREF out;
+    GLOBREF err;
+    HASHREF env;
+    int            socket;
+    int            flags;
+
+    PROTOTYPE: ***$$$
+    CODE:
+    RETVAL = sv_setref_pv(newSV(0), "FCGI", 
+               FCGI_Request(in, out, err, env, socket, flags));
+
+    OUTPUT:
+    RETVAL
+
+int
+OpenSocket(path, backlog)
+    char* path;
+    int backlog;
+
+    PROTOTYPE: $$
+    CODE:
+    RETVAL = FCGX_OpenSocket(path, backlog);
+    OUTPUT:
+    RETVAL
+
 void
-DIE(msg)
-       char *  msg;
+CloseSocket(socket)
+    int socket;
+
+    PROTOTYPE: $
+    CODE:
+    close(socket);
+
+int
+Accept(request)
+
+    FCGI    request;
+
+    PROTOTYPE: $
+
+    CODE:
+    RETVAL = FCGI_Accept(request);
+
+    OUTPUT:
+    RETVAL
 
-       CODE:
-       if (!PL_in_eval)
-           FCGX_PutS(msg, (FCGX_Stream *) SvIV((SV*) SvRV(sverr)));
 
 void
-WARN(msg)
-       char *  msg;
+Finish(request)
 
-       CODE:
-       FCGX_PutS(msg, (FCGX_Stream *) SvIV((SV*) SvRV(sverr)));
+    FCGI    request;
+
+    PROTOTYPE: $
+
+    CODE:
+    {
+        /*
+         * Finish the request.
+         */
+        FCGI_Finish(request);
+    }
+
+
+void
+Flush(request)
+
+    FCGI    request;
+
+    PROTOTYPE: $
+
+    CODE:
+    FCGI_Flush(request);
+
+void
+Detach(request)
+
+    FCGI    request;
+
+    PROTOTYPE: $
+
+    CODE:
+    if (request->accepted && request->bound)
+       FCGI_UndoBinding(request);
+
+void
+Attach(request)
+
+    FCGI    request;
+
+    PROTOTYPE: $
+
+    CODE:
+    if (request->accepted && !request->bound)
+       FCGI_Bind(request);
+
+
+int
+StartFilterData(request)
+
+    FCGI    request;
+
+    PROTOTYPE: $
+
+    CODE:
+    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
 PRINT(stream, ...)
-       FCGI    stream;
+       FCGI::Stream    stream;
 
        PREINIT:
        int     n;
@@ -288,7 +489,7 @@ PRINT(stream, ...)
 
 int
 WRITE(stream, bufsv, len, ...)
-       FCGI    stream;
+       FCGI::Stream    stream;
        SV *    bufsv;
        int     len;
 
@@ -314,7 +515,7 @@ WRITE(stream, bufsv, len, ...)
 
 int
 READ(stream, bufsv, len, ...)
-       FCGI    stream;
+       FCGI::Stream    stream;
        SV *    bufsv;
        int     len;
 
@@ -339,7 +540,7 @@ READ(stream, bufsv, len, ...)
 
 SV *
 GETC(stream)
-       FCGI    stream;
+       FCGI::Stream    stream;
 
        PREINIT:
        int     retval;
@@ -352,10 +553,10 @@ GETC(stream)
 
 bool
 CLOSE(stream)
-       FCGI    stream;
+       FCGI::Stream    stream;
 
-       ALIAS:
-       DESTROY = 1
+#      ALIAS:
+#      DESTROY = 1
 
        CODE:
        RETVAL = FCGX_FClose(stream) != -1;
@@ -364,85 +565,3 @@ CLOSE(stream)
        RETVAL
 
 #endif
-
-int
-accept()
-
-    PROTOTYPE:
-    CODE:
-    {
-        char **savedEnviron;
-        int acceptStatus;
-        /*
-         * Unmake Perl variable settings for the request just completed.
-         */
-        if(requestEnviron != NULL) {
-            DoPerlEnv(requestEnviron, FALSE);
-            requestEnviron = NULL;
-        }
-        /*
-         * Call FCGI_Accept but preserve environ.
-         */
-        savedEnviron = environ;
-        acceptStatus = FCGI_Accept();
-        requestEnviron = environ;
-        environ = savedEnviron;
-        /*
-         * Make Perl variable settings for the new request.
-         */
-        if(acceptStatus >= 0 && !FCGX_IsCGI()) {
-            DoPerlEnv(requestEnviron, TRUE);
-        } else {
-            requestEnviron = NULL;
-        }
-        RETVAL = acceptStatus;
-    }
-    OUTPUT:
-    RETVAL
-
-
-void
-finish()
-
-    PROTOTYPE:
-    CODE:
-    {
-        /*
-         * Unmake Perl variable settings for the completed request.
-         */
-        if(requestEnviron != NULL) {
-            DoPerlEnv(requestEnviron, FALSE);
-            requestEnviron = NULL;
-        }
-        /*
-         * Finish the request.
-         */
-        FCGI_Finish();
-    }
-
-
-void
-flush()
-
-    PROTOTYPE:
-    CODE:
-    FCGI_Flush();
-
-void
-set_exit_status(status)
-
-    int status;
-
-    PROTOTYPE: $
-    CODE:
-    FCGI_SetExitStatus(status);
-
-int
-start_filter_data()
-
-    PROTOTYPE:
-    CODE:
-    RETVAL = FCGI_StartFilterData();
-
-    OUTPUT:
-    RETVAL