use Config;
use ExtUtils::MakeMaker;
-do 'FCGI.cfg' or die "no FCGI.cfg";
-
open OUT, ">FCGI.pm";
print "Generating FCGI.pm\n";
print OUT '$VERSION = q{'.MM->parse_version('version.pm')."};\n\n";
-print OUT "bootstrap FCGI;\n" unless ($pure);
+print OUT "bootstrap FCGI;\n";
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};
-}
-
-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);
- }
- $len;
-}
-
-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";
-}
-
-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;
-}
-
-sub UndoBindings {
- my ($req) = @_;
- untie ${$req->{in}};
- untie ${$req->{out}};
- untie ${$req->{err}};
- $req->{bound} = 0;
-}
-
-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}};
- }
- $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;
- }
- $self->{buf} .= $buf;
- }
- my ($newbuf, $result) = (substr($self->{buf}, $len),
- substr($self->{buf}, 0, $len));
- $self->{buf} = $newbuf;
- $result;
-}
-
-sub Flush {
- my ($req) = @_;
-}
-
-sub write {
- my ($self, $type, $content, $len) = @_;
- return unless $len > 0;
- $self->write_record($type, $content, $len);
-}
-
-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;
- }
-}
-
-{ package FCGI::Stream;
-
-sub new {
- my ($class, $src, $type) = @_;
- my $handle = do { \local *FH };
- tie($$handle, $class, $src, $type);
- $handle;
-}
-
-sub TIEHANDLE {
- my ($class, $src, $type) = @_;
- bless { src => $src, type => $type }, $class;
-}
-
-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;
-}
-
-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);
-}
-
-}
-
-EOP
print OUT while <DATA>;
close OUT;
__END__
projects / catagits/fcgi2.git / blobdiff