use Config;
+use ExtUtils::MakeMaker;
-open OUT, ">FCGI.xs";
+do 'FCGI.cfg' or die "no FCGI.cfg";
-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"
- }
+open OUT, ">FCGI.pm";
+
+print "Generating FCGI.pm\n";
+print OUT <<'EOP';
+# $Id: FCGI.PL,v 1.37 2002/12/15 20:02:48 skimo Exp $
+
+package FCGI;
+
+require Exporter;
+require DynaLoader;
+
+@ISA = qw(Exporter DynaLoader);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+@EXPORT = qw(
+
+);
+
+EOP
+
+print OUT '$VERSION = q{'.MM->parse_version('version.pm')."};\n\n";
+
+print OUT "bootstrap FCGI;\n" unless ($pure);
+
+print OUT '$VERSION = eval $VERSION;';
+
+print OUT <<'EOP' if ($pure);
+use Symbol;
+use POSIX 'ENOTCONN';
+
+use constant VERSION_1 => 1;
+
+use constant BEGIN_REQUEST => 1;
+use constant PARAMS => 4;
+use constant FCGI_STDIN => 5;
+use constant FCGI_STDOUT => 6;
+use constant FCGI_STDERR => 7;
+
+use constant RESPONDER => 1;
+use constant AUTHORIZER => 2;
+use constant FILTER => 3;
+
+%FCGI::rolenames = (RESPONDER, "RESPONDER",
+ AUTHORIZER, "AUTHORIZER",
+ FILTER, "FILTER",
+ );
+
+# This only works on Unix; anyone familiar with Windows is welcome
+# to give a hand here
+sub IsFastCGI {
+ my ($req) = @_;
+ $req->{isfastcgi} =
+ (!defined getpeername shift->{listen_sock}) && $! == ENOTCONN
+ unless exists $req->{isfastcgi};
+ return $req->{isfastcgi};
}
-print OUT while <DATA>;
-close OUT;
-__END__
-/* $Id: FCGI.PL,v 1.4 1999/07/28 16:15:40 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;
-static char **requestEnviron = NULL;
-
-#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);
+
+sub GetEnvironment {
+ return shift->{'env'};
}
-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;
+sub read_nv_len {
+ my ($stream) = @_;
+ my $buf;
+ return undef unless read $stream, $buf, 1, 0;
+ my ($len) = unpack("C", $buf);
+ if ($len & 0x80) {
+ $buf = pack("C", $len & 0x7F);
+ return undef unless read $stream, $buf, 3, 1;
+ $len = unpack("N", $buf);
+ }
+ $len;
}
-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;
+sub RequestX {
+ my $self = {
+ in => shift,
+ out => shift,
+ err => shift,
+ env => shift,
+ socket => shift,
+ flags => shift,
+ last => 0,
+ };
+ open $self->{listen_sock}, "<&=0";
+ bless $self, "FCGI";
}
-Sfdisc_t *
-sfdcdelfcgi(disc)
- Sfdisc_t* disc;
-{
- Safefree(disc);
+my $run_once = 0;
+
+sub Accept {
+ my ($req) = @_;
+
+ unless ($req->IsFastCGI()) {
+ return -1 if $run_once;
+
+ $run_once = 1;
+ return 0;
+ }
+ $req->Finish();
+ $req->{socket} = gensym();
+ if ($req->{last} || !accept($req->{socket}, $req->{listen_sock})) {
+ $req->{error} = "accept";
+ return -1;
+ }
+ my ($type, $id, $body) = $req->read_record();
+ if ($type != BEGIN_REQUEST) {
+ $req->{error} = "begin request";
+ return -1;
+ }
+ my ($role, $flags) = unpack("nC", $body);
+ $req->{role} = $role;
+ $req->{flags} = $flags;
+ $req->{id} = $id;
+
+ %{$req->{env}} = ();
+ $req->{env}{FCGI_ROLE} = $FCGI::rolenames{$req->{role}};
+ my $param = FCGI::Stream->new($req, PARAMS);
+ my ($nlen, $vlen);
+ while (defined($nlen = read_nv_len($param)) &&
+ defined($vlen = read_nv_len($param)))
+ {
+ my ($name, $val);
+ read $param, $name, $nlen;
+ read $param, $val, $vlen;
+ $req->{env}{$name} = $val;
+ }
+ $req->Bind;
+ $req->{accepted} = 1;
+
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;
- FCGX_Stream* in;
- FCGX_Request* requestPtr;
-} FCGP_Request;
-
-static FCGP_Request global_request;
-static SV* global_sverr;
-
-static int
-FCGI_Flush(FCGP_Request* request)
-{
- if(!request->compat || !request->acceptCalled || isCGI) {
- return;
- }
-#ifdef USE_SFIO
- sfsync(PerlIO_stdout());
- sfsync(PerlIO_stderr());
-#else
- FCGX_FFlush((FCGX_Stream *) SvIV((SV*) SvRV(request->svout)));
- FCGX_FFlush((FCGX_Stream *) SvIV((SV*) SvRV(request->sverr)));
-#endif
+
+sub UndoBindings {
+ my ($req) = @_;
+ untie ${$req->{in}};
+ untie ${$req->{out}};
+ untie ${$req->{err}};
+ $req->{bound} = 0;
}
-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);
- } else {
- if(request->compat && !request->finishCalled) {
-#ifdef USE_SFIO
- sfdcdelfcgi(sfdisc(PerlIO_stdin(), SF_POPDISC));
- sfdcdelfcgi(sfdisc(PerlIO_stdout(), SF_POPDISC));
- sfdcdelfcgi(sfdisc(PerlIO_stderr(), SF_POPDISC));
-#else
- FCGI_Flush(request);
-#endif
- }
+sub Bind {
+ my ($req) = @_;
+ tie ${$req->{in}}, 'FCGI::Stream', $req, FCGI_STDIN;
+ tie ${$req->{out}}, 'FCGI::Stream', $req, FCGI_STDOUT;
+ tie ${$req->{err}}, 'FCGI::Stream', $req, FCGI_STDERR;
+ $req->{bound} = 1;
+}
+
+sub Attach {
+ my ($req) = @_;
+ $req->Bind() if ($req->{accepted} && !$req->{bound});
+}
+
+sub Detach {
+ my ($req) = @_;
+ $req->UndoBindings() if ($req->{accepted} && $req->{bound});
+}
+
+sub Finish {
+ my ($req) = @_;
+ return unless $req->{accepted};
+ if ($req->{bound}) {
+ $req->UndoBindings();
+ # apparently these are harmful
+ # close ${$req->{out}};
+ # close ${$req->{err}};
}
- if(!isCGI) {
- FCGX_ParamArray envp;
- FCGX_Stream *out, *error;
- int acceptResult = FCGX_Accept_r(&request->in, &out, &error, &envp,
- request->requestPtr);
- if(acceptResult < 0) {
- return acceptResult;
+ $req->{accepted} = 0;
+}
+
+sub LastCall {
+ shift->{last} = 1;
+}
+
+sub DESTROY {
+ shift->Finish();
+}
+
+sub read_record {
+ my ($self) = @_;
+ my ($header, $body);
+
+ read($self->{socket}, $header, 8);
+ my ($version, $type, $id, $clen, $plen) = unpack("CCnnC", $header);
+ read($self->{socket}, $body, $clen+$plen);
+ $body = undef if $clen == 0;
+ ($type, $id, $body);
+}
+
+sub read {
+ my ($self, $rtype, $len) = @_;
+ while (length $self->{buf} < $len) {
+ my ($type, $id, $buf) = $self->read_record();
+ return undef unless defined $buf;
+ if ($type != $rtype) {
+ $self->{error} = "unexpected stream type";
+ return 0;
}
-#ifdef USE_SFIO
- sfdisc(PerlIO_stdin(), sfdcnewfcgi(request->in));
- sfdisc(PerlIO_stdout(), sfdcnewfcgi(out));
- sfdisc(PerlIO_stderr(), sfdcnewfcgi(error));
-#else
- if (!request->svout) {
- newSVrv(request->svout = newSV(0), "FCGI");
- sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO),
- request->svout, 'q', Nullch, 0);
- newSVrv(request->sverr = newSV(0), "FCGI");
- sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO),
- request->sverr, 'q', Nullch, 0);
- newSVrv(request->svin = newSV(0), "FCGI");
- sv_magic((SV *)gv_fetchpv("STDIN",TRUE, SVt_PVIO),
- 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;
- environ = envp;
+ $self->{buf} .= $buf;
}
- request->acceptCalled = TRUE;
- return 0;
+ my ($newbuf, $result) = (substr($self->{buf}, $len),
+ substr($self->{buf}, 0, $len));
+ $self->{buf} = $newbuf;
+ $result;
}
-static void
-FCGI_Finish(FCGP_Request* request)
-{
- if(!request->acceptCalled || isCGI) {
- return;
- }
- if (request->compat) {
-#ifdef USE_SFIO
- sfdcdelfcgi(sfdisc(PerlIO_stdin(), SF_POPDISC));
- sfdcdelfcgi(sfdisc(PerlIO_stdout(), SF_POPDISC));
- sfdcdelfcgi(sfdisc(PerlIO_stderr(), SF_POPDISC));
-#else
- FCGI_Flush(request);
-#endif
- }
- 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
+sub Flush {
+ my ($req) = @_;
}
-static int
-FCGI_StartFilterData(FCGP_Request* request)
-{
- return request->in ? FCGX_StartFilterData(request->in) : -1;
+sub write {
+ my ($self, $type, $content, $len) = @_;
+ return unless $len > 0;
+ $self->write_record($type, $content, $len);
}
-static void
-FCGI_SetExitStatus(FCGP_Request* request, int status)
-{
- if (request->in) FCGX_SetExitStatus(status, request->in);
+sub write_record {
+ my ($self, $type, $content, $length) = @_;
+ my $offset = 0;
+ while ($length > 0) {
+ my $len = $length > 32*1024 ? 32*1024 : $length;
+ my $padlen = (8 - ($len % 8)) % 8;
+ my $templ = "CCnnCxa${len}x$padlen";
+ my $data = pack($templ,
+ VERSION_1, $type, $self->{id}, $len, $padlen,
+ substr($content, $offset, $len));
+ syswrite $self->{socket}, $data;
+ $length -= $len;
+ $offset += $len;
+ }
}
-static FCGP_Request *
-FCGI_Request()
-{
- FCGX_Request* fcgx_req;
- FCGP_Request* req;
+{ package FCGI::Stream;
- Newz(551, fcgx_req, 1, FCGX_Request);
- Newz(551, req, 1, FCGP_Request);
- req->requestPtr = fcgx_req;
+sub new {
+ my ($class, $src, $type) = @_;
+ my $handle = do { \local *FH };
+ tie($$handle, $class, $src, $type);
+ $handle;
+}
- return req;
+sub TIEHANDLE {
+ my ($class, $src, $type) = @_;
+ bless { src => $src, type => $type }, $class;
}
-static void
-FCGI_Release_Request(FCGP_Request *req)
-{
- Safefree(req->requestPtr);
- Safefree(req);
+sub READ {
+ my ($stream, undef, $len, $offset) = @_;
+ my ($ref) = \$_[1];
+ my $buf = $stream->{src}->read($stream->{type}, $len);
+ return undef unless defined $buf;
+ substr($$ref, $offset, 0, $buf);
+ length $buf;
}
-/*
- * 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;
-{
- 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 = '=';
- }
+sub PRINT {
+ my ($stream) = shift;
+ for (@_) {
+ $stream->{src}->write($stream->{type}, $_, length($_));
}
+ return 1;
}
+sub CLOSE {
+ my ($stream) = @_;
+ $stream->{src}->write_record($stream->{type}, undef, 0);
+}
-typedef FCGX_Stream * FCGI;
-typedef FCGP_Request * FCGI__Request;
-
-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;
-
-#ifndef USE_SFIO
-void
-DIE(msg)
- char * msg;
-
- CODE:
- if (!PL_in_eval)
- 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;
-
- 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;
- 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;
- 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;
-
- 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;
-
- ALIAS:
- DESTROY = 1
-
- CODE:
- RETVAL = FCGX_FClose(stream) != -1;
-
- OUTPUT:
- RETVAL
-
-#endif
-
-SV *
-request()
-
- PROTOTYPE:
- CODE:
- RETVAL = Perl_sv_setref_pv(Perl_newSV(0), "FCGI::Request", FCGI_Request());
-
- OUTPUT:
- RETVAL
-
-
-int
-accept(...)
-
- PROTOTYPE: ;$***$
-
- PREINIT:
- FCGP_Request* request = &global_request;
- SV * sv;
-
- CODE:
- if (items != 0 && items != 5)
- croak("Usage: FCGI::accept() or "
- "FCGI::accept(request, IN, OUT, ERR, env)");
- if (items) {
- if (sv_isa(ST(0), "FCGI::Request")) {
- request = (FCGP_Request*) SvIV((SV*)SvRV(ST(0)));
- } else
- croak("request is not of type FCGI::Request");
- if (SvROK(ST(1)) && isGV(SvRV(ST(1)))) {
- } else
- croak("IN is not a GLOB reference");
- }
- {
- 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(request);
- requestEnviron = environ;
- environ = savedEnviron;
- /*
- * Make Perl variable settings for the new request.
- */
- if(acceptStatus >= 0 && !FCGX_IsCGI()) {
- DoPerlEnv(requestEnviron, TRUE);
- } else {
- requestEnviron = NULL;
+}
+
+EOP
+print OUT while <DATA>;
+close OUT;
+__END__
+
+# Preloaded methods go here.
+
+# Autoload methods go after __END__, and are processed by the autosplit program.
+
+*FAIL_ACCEPT_ON_INTR = sub() { 1 };
+
+sub Request(;***$*$) {
+ my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, FAIL_ACCEPT_ON_INTR());
+ $_[4] = fileno($_[4]) if defined($_[4]) && defined(fileno($_[4]));
+ splice @defaults,0,@_,@_;
+ RequestX(@defaults);
+}
+
+package FCGI::Stream;
+
+sub PRINTF {
+ shift->PRINT(sprintf(shift, @_));
+}
+
+sub BINMODE {
+}
+
+sub READLINE {
+ my $stream = shift;
+ my ($s, $c);
+ my $rs = $/ eq '' ? "\n\n" : $/;
+ my $l = substr $rs, -1;
+ my $len = length $rs;
+
+ $c = $stream->GETC();
+ if ($/ eq '') {
+ while ($c eq "\n") {
+ $c = $stream->GETC();
}
- RETVAL = acceptStatus;
}
- OUTPUT:
- RETVAL
+ while (defined $c) {
+ $s .= $c;
+ last if $c eq $l and substr($s, -$len) eq $rs;
+ $c = $stream->GETC();
+ }
+ $s;
+}
+sub OPEN {
+ $_[0]->CLOSE;
+ if (@_ == 2) {
+ return open($_[0], $_[1]);
+ } else {
+ my $rc;
+ eval("$rc = open($_[0], $_[1], $_[2])");
+ die $@ if $@;
+ return $rc;
+ }
+}
-void
-finish(...)
+# Some things (e.g. IPC::Run) use fileno to determine if a filehandle is open,
+# so we return a defined, but meaningless value. (-1 being the error return
+# value from the syscall in c, meaning it can never be a valid fd no)
+# Probably a better alternative would be to return the fcgi stream fd.
+sub FILENO { -1 }
- PROTOTYPE: ;$
- CODE:
- {
- /*
- * Unmake Perl variable settings for the completed request.
- */
- if(requestEnviron != NULL) {
- DoPerlEnv(requestEnviron, FALSE);
- requestEnviron = NULL;
- }
- /*
- * Finish the request.
- */
- FCGI_Finish(&global_request);
+1;
+
+=pod
+
+=head1 NAME
+
+FCGI - Fast CGI module
+
+=head1 SYNOPSIS
+
+ use FCGI;
+
+ my $count = 0;
+ my $request = FCGI::Request();
+
+ while($request->Accept() >= 0) {
+ print("Content-type: text/html\r\n\r\n", ++$count);
}
+=head1 DESCRIPTION
+
+Functions:
+
+=over 4
+
+=item FCGI::Request
+
+Creates a request handle. It has the following optional parameters:
+
+=over 8
+
+=item input perl file handle (default: \*STDIN)
+
+=item output perl file handle (default: \*STDOUT)
+
+=item error perl file handle (default: \*STDERR)
+
+These filehandles will be setup to act as input/output/error
+on successful Accept.
+
+=item environment hash reference (default: \%ENV)
+
+The hash will be populated with the environment.
+
+=item socket (default: 0)
+
+Socket to communicate with the server.
+Can be the result of the OpenSocket function.
+For the moment, it's the file descriptor of the socket
+that should be passed. This may change in the future.
+
+You should only use your own socket if your program
+is not started by a process manager such as mod_fastcgi
+(except for the FastCgiExternalServer case) or cgi-fcgi.
+If you use the option, you have to let your FastCGI
+server know which port (and possibly server) your program
+is listening on.
+See remote.pl for an example.
+
+=item flags (default: 0)
+
+Possible values:
+
+=over 12
+
+=item FCGI::FAIL_ACCEPT_ON_INTR
+
+If set, Accept will fail if interrupted.
+It not set, it will just keep on waiting.
+
+=back
-void
-flush(...)
+=back
- PROTOTYPE: ;$
- CODE:
- FCGI_Flush(&global_request);
+Example usage:
+ my $req = FCGI::Request;
-void
-set_exit_status(status,...)
+or:
+ my %env;
+ my $in = new IO::Handle;
+ my $out = new IO::Handle;
+ my $err = new IO::Handle;
+ my $req = FCGI::Request($in, $out, $err, \%env);
- int status;
+=item FCGI::OpenSocket(path, backlog)
- PROTOTYPE: $;$
- CODE:
- FCGI_SetExitStatus(&global_request, status);
+Creates a socket suitable to use as an argument to Request.
-int
-start_filter_data(...)
+=over 8
- PROTOTYPE: ;$
- CODE:
- RETVAL = FCGI_StartFilterData(&global_request);
+=item path
- OUTPUT:
- RETVAL
+Pathname of socket or colon followed by local tcp port.
+Note that some systems take file permissions into account
+on Unix domain sockets, so you'll have to make sure that
+the server can write to the created file, by changing
+the umask before the call and/or changing permissions and/or
+group of the file afterwards.
-MODULE = FCGI PACKAGE = FCGI::Request
+=item backlog
-void
-DESTROY(request)
- FCGI::Request request;
+Maximum length of the queue of pending connections.
+If a connection
+request arrives with the queue full the client may receive
+an error with an indication of ECONNREFUSED.
- CODE:
- FCGI_Release_Request(request);
+=back
+
+=item FCGI::CloseSocket(socket)
+
+Close a socket opened with OpenSocket.
+
+=item $req->Accept()
+
+Accepts a connection on $req, attaching the filehandles and
+populating the environment hash.
+Returns 0 on success.
+If a connection has been accepted before, the old
+one will be finished first.
+
+Note that unlike with the old interface, no die and warn
+handlers are installed by default. This means that if
+you are not running an sfio enabled perl, any warn or
+die message will not end up in the server's log by default.
+It is advised you set up die and warn handlers yourself.
+FCGI.pm contains an example of die and warn handlers.
+
+=item $req->Finish()
+
+Finishes accepted connection.
+Also detaches filehandles.
+
+=item $req->Flush()
+
+Flushes accepted connection.
+
+=item $req->Detach()
+
+Temporarily detaches filehandles on an accepted connection.
+
+=item $req->Attach()
+
+Re-attaches filehandles on an accepted connection.
+
+=item $req->LastCall()
+
+Tells the library not to accept any more requests on this handle.
+It should be safe to call this method from signal handlers.
+
+Note that this method is still experimental and everything
+about it, including its name, is subject to change.
+
+=item $env = $req->GetEnvironment()
+
+Returns the environment parameter passed to FCGI::Request.
+
+=item ($in, $out, $err) = $req->GetHandles()
+
+Returns the file handle parameters passed to FCGI::Request.
+
+=item $isfcgi = $req->IsFastCGI()
+
+Returns whether or not the program was run as a FastCGI.
+
+=back
+
+=HEAD1 LIMITATIONS
+
+FCGI.pm isn't Unicode aware, only characters within the range 0x00-0xFF are
+supported. Attempts to output strings containing characters above 0xFF results
+in a exception: (F) C<Wide character in %s>.
+
+Users who wants the previous (FCGI.pm <= 0.68) incorrect behavior can disable the
+exception by using the C<bytes> pragma.
+
+ {
+ use bytes;
+ print "\x{263A}";
+ }
+
+
+=head1 AUTHOR
+
+Sven Verdoolaege <skimo@kotnet.org>
+
+=cut
+
+__END__
projects / catagits/fcgi2.git / blobdiff