use Config;
+use ExtUtils::MakeMaker;
do 'FCGI.cfg' or die "no FCGI.cfg";
print "Generating FCGI.pm\n";
print OUT <<'EOP';
-# $Id: FCGI.PL,v 1.26 2001/08/22 17:20:20 skimo Exp $
+# $Id: FCGI.PL,v 1.37 2002/12/15 20:02:48 skimo Exp $
package FCGI;
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
-
-);
-$VERSION = '0.60';
+);
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 FILTER => 3;
%FCGI::rolenames = (RESPONDER, "RESPONDER",
- AUTHORIZER, "AUTHORIZER",
- FILTER, "FILTER",
- );
+ 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};
+ (!defined getpeername shift->{listen_sock}) && $! == ENOTCONN
+ unless exists $req->{isfastcgi};
return $req->{isfastcgi};
}
+sub GetEnvironment {
+ return shift->{'env'};
+}
+
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);
+ $buf = pack("C", $len & 0x7F);
+ return undef unless read $stream, $buf, 3, 1;
+ $len = unpack("N", $buf);
}
$len;
}
sub RequestX {
my $self = {
- in => shift,
- out => shift,
- err => shift,
- env => shift,
- socket => shift,
- flags => shift,
+ in => shift,
+ out => shift,
+ err => shift,
+ env => shift,
+ socket => shift,
+ flags => shift,
+ last => 0,
};
open $self->{listen_sock}, "<&=0";
bless $self, "FCGI";
my ($req) = @_;
unless ($req->IsFastCGI()) {
- return -1 if $run_once;
+ return -1 if $run_once;
- $run_once = 1;
- return 0;
+ $run_once = 1;
+ return 0;
}
$req->Finish();
$req->{socket} = gensym();
- if (!accept($req->{socket}, $req->{listen_sock})) {
- $req->{error} = "accept";
- return -1;
+ 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;
+ $req->{error} = "begin request";
+ return -1;
}
my ($role, $flags) = unpack("nC", $body);
$req->{role} = $role;
$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;
+ 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;
my ($req) = @_;
return unless $req->{accepted};
if ($req->{bound}) {
- $req->UndoBindings();
- close ${$req->{out}};
- close ${$req->{err}};
+ $req->UndoBindings();
+ # apparently these are harmful
+ # close ${$req->{out}};
+ # close ${$req->{err}};
}
$req->{accepted} = 0;
}
+sub LastCall {
+ shift->{last} = 1;
+}
+
sub DESTROY {
shift->Finish();
}
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;
- }
- $self->{buf} .= $buf;
+ my ($type, $id, $buf) = $self->read_record();
+ return undef unless defined $buf;
+ if ($type != $rtype) {
+ $self->{error} = "unexpected stream type";
+ return 0;
+ }
+ $self->{buf} .= $buf;
}
- my ($newbuf, $result) = (substr($self->{buf}, $len),
- substr($self->{buf}, 0, $len));
+ my ($newbuf, $result) = (substr($self->{buf}, $len),
+ substr($self->{buf}, 0, $len));
$self->{buf} = $newbuf;
$result;
}
}
sub write_record {
- my ($self, $type, $content, $len) = @_;
- my $padlen = (8 - ($len % 8)) % 8;
- my $templ = "CCnnCxa${len}x$padlen";
- my $data = pack($templ,
- VERSION_1, $type, $self->{id}, $len, $padlen, $content);
- syswrite $self->{socket}, $data;
+ 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;
+ }
}
{ package FCGI::Stream;
sub PRINT {
my ($stream) = shift;
for (@_) {
- $stream->{src}->write($stream->{type}, $_, length($_));
+ $stream->{src}->write($stream->{type}, $_, length($_));
}
+ return 1;
}
sub CLOSE {
*FAIL_ACCEPT_ON_INTR = sub() { 1 };
sub Request(;***$*$) {
- my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, 0);
- $_[4] = fileno($_[4]) if defined(fileno($_[4]));
+ 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);
}
-sub accept() {
- warn "accept called as a method; you probably wanted to call Accept" if @_;
- if (defined %FCGI::ENV) {
- %ENV = %FCGI::ENV;
- } else {
- %FCGI::ENV = %ENV;
- }
- my $rc = Accept($global_request);
- for (keys %FCGI::ENV) {
- $ENV{$_} = $FCGI::ENV{$_} unless exists $ENV{$_};
- }
-
- # not SFIO
- $SIG{__WARN__} = $warn_handler if (tied (*STDIN));
- $SIG{__DIE__} = $die_handler if (tied (*STDIN));
-
- return $rc;
-}
-
-sub finish() {
- warn "finish called as a method; you probably wanted to call Finish" if @_;
- %ENV = %FCGI::ENV if (defined %FCGI::ENV);
-
- # not SFIO
- if (tied (*STDIN)) {
- delete $SIG{__WARN__} if ($SIG{__WARN__} == $warn_handler);
- delete $SIG{__DIE__} if ($SIG{__DIE__} == $die_handler);
- }
-
- Finish ($global_request);
-}
-
-sub flush() {
- warn "flush called as a method; you probably wanted to call Flush" if @_;
- Flush($global_request);
-}
-
-sub detach() {
- warn "detach called as a method; you probably wanted to call Detach" if @_;
- Detach($global_request);
-}
-
-sub attach() {
- warn "attach called as a method; you probably wanted to call Attach" if @_;
- Attach($global_request);
-}
-
-# deprecated
-sub set_exit_status {
-}
-
-sub start_filter_data() {
- StartFilterData($global_request);
-}
-
-$global_request = Request();
-$warn_handler = sub { print STDERR @_ };
-$die_handler = sub { print STDERR @_ unless $^S };
-
package FCGI::Stream;
sub PRINTF {
$c = $stream->GETC();
if ($/ eq '') {
- while ($c eq "\n") {
- $c = $stream->GETC();
- }
+ while ($c eq "\n") {
+ $c = $stream->GETC();
+ }
}
while (defined $c) {
- $s .= $c;
- last if $c eq $l and substr($s, -$len) eq $rs;
- $c = $stream->GETC();
+ $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]);
+ return open($_[0], $_[1]);
} else {
- my $rc;
- eval("$rc = open($_[0], $_[1], $_[2])");
- die $@ if $@;
- return $rc;
+ my $rc;
+ eval("$rc = open($_[0], $_[1], $_[2])");
+ die $@ if $@;
+ return $rc;
}
}
+# 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 }
+
1;
=pod
my $request = FCGI::Request();
while($request->Accept() >= 0) {
- print("Content-type: text/html\r\n\r\n", ++$count);
+ print("Content-type: text/html\r\n\r\n", ++$count);
}
=head1 DESCRIPTION
=item error perl file handle (default: \*STDERR)
These filehandles will be setup to act as input/output/error
-on succesful Accept.
+on successful Accept.
=item environment hash reference (default: \%ENV)
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.
+(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.
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.
=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>
projects / catagits/fcgi2.git / blobdiff