On Sun, 08 Jun 2003 10:47, Rocco Caputo wrote:
> Nice standard, if seemingly baroque. Is it possible to write a
> POE::Filter::FastCGI? If so, you could probably use it just about
> everywhere POE::Filter::Line fits. That would let you write clients and
> servers fairly trivially.
POE::Filter::FastCGI - I wrote that a while ago and gave up finishing
it; I got kind of deadlocked when I considered that POE is kind of
fundamentally incompatible with Tangram; with Tangram, dereferencing a
reference may involve a database query, auto-vivifying a tied scalar
which is distinctly not co-operatively multi-threading :-).
It's not an unsurmountable problem, but it would involve making some
fairly fundamental changes to Tangram to allow it to use
POE::Component::DBI. On the list, but quite far down.
I've attached what I've got as an idea; it doesn't work, but it's a
substantial starting point for those interested. I've implemented it
from the Specs, not the C implementation. I figure that the
implementation would end up looking less like a hack that way.
I've implemented just the packet layer so far - no FastCGI session
management or tracking yet.
Perhaps it was a little ambitious for a starting POE project ;-)
--
Sam Vilain, [EMAIL PROTECTED]
The greatness of a nation and its moral progress can be judged by the
way its animals are treated.
-- Mahatma Gandhi
package FastCGI::Record;
use POE::Preprocessor ( isa => "POE::Filter::FastCGI" );
use base qw(Class::Tangram);
our $schema =
{
fields => {
int => [ qw(RequestId Type) ],
string => { Data => { sql => "BLOB" }, },
},
};
sub Chunks {
my $self = shift;
# pad packets to 8 byte boundaries
my $pad_len = (8 - length $self->{Data}) & 7;
return (# header
pack ("CCvvCC",
FCGI_VERSION_1
$self->Type,
$self->RequestId,
length $self->Data,
$pad_len,
0),
# data
$self->{Data},
# padding
'\0' x $pad_len);
}
1;
package POE::Filter::FastCGI;
use strict;
use POE::Preprocessor;
use FastCGI::Record;
# is it really 1?
const FCGI_VERSION_1 1
# states states states
const WAIT_HEADER 0
const WAIT_DATA 1
const HEADER_LENGTH 8
# start a new filter
sub new { bless { buffer => "",
length => 0,
min_length => HEADER_LENGTH,
state => WAIT_HEADER }, shift }
# positions in the header
const VERSION 0
const TYPE 1
const REQUESTID 2
const LENGTH 3
const PAD_LEN 4
const RESERVED 5
# new data in
sub get {
my $self = shift;
my $stream = shift;
$self->{records} ||= [];
# for a laugh, let's code this like a C programmer would, using
# iterators instead of slurping everything together (this will
# need to be ported to XS or PASM later)
while ( my $chunk = shift @$stream ) {
# add a chunk to the buffer
$self->{buffer} .= $chunk;
$self->{length} += length $chunk;
# and build into records
$self->{wanted} = -1;
$self->get_one();
delete $self->{wanted};
}
# return as many as we can
return delete $self->{records};
}
# slurp in some data
sub get_one_start {
my $self = shift;
my $stream = shift;
while ( my $chunk = shift @$stream ) {
$self->{buffer} .= $chunk;
$self->{length} += length $chunk;
}
}
# fetch a single record
sub get_one {
my $self = shift;
$self->{wanted} ||= 1;
while ( $self->{length} > $self->{min_length}
and (
$self->{wanted} == -1 or
@{$self->{records}} == $self->{wanted}
)
){
# here we have complete sub-chunks
if ( $self->{state} == WAIT_HEADER ) {
# extract info from the header
$self->{header} =
[
unpack "CCvvCC",
substr $self->{buffer}, 0, HEADER_LENGTH
];
# type must be correct
($self->{header}->[VERSION] == FCGI_VERSION_1)
or die "FastCGI protocol error";
# expect data
$self->{state} = WAIT_DATA;
$self->{min_length} = (HEADER_LENGTH +
$self->{header}->[LENGTH] +
$self->{header}->[PAD_LEN]);
} elsif ( $self->{state} == WAIT_DATA ) {
# got the data, eat a packet
$self->{data} = substr ($self->{buffer}, HEADER_LENGTH,
$self->{header}->[LENGTH], "");
# throw away the padding
substr $self->{buffer}, 0, $self->{header}->[PAD_LEN], "";
# go back to initial state
$self->{state} = WAIT_HEADER;
$self->{min_length} = HEADER_LENGTH;
# create a new FastCGI record
push @{ $self->{records} },
FastCGI::Record->new
(
RequestId => $self->{header}->[REQUESTID],
Type => $self->{header}->[TYPE],
Data => $self->{data},
);
}
}
}
sub put {
my $self = shift;
my $records = shift;
return [ map { $_->Chunks } @$records ];
}
sub get_pending {
my $self = shift;
return $self->{buffer};
}
