use Cro::TCP;
use Cro::FCGI::NameValuePairs;
use Cro::FCGI::ConnectionState;
use Cro::FCGI::Record;
use Cro::Transform;
use Cro;
sub a-sub-with-dashes() {
say "Dashy sub";
}
my @array = 1, 2, 3;
@array[1];
my %hash = <a 1 b 2>;
%hash{"a"};
%hash<a>;
class X::Cro::FCGI::UnsupportedVersion is Exception {
has $.version is required;
method message() { "Webserver sent unsupported version: $!version" }
}
class X::Cro::FCGI::InvalidLength is Exception {
method message() { 'Webserver \qq"Oh hello there!" sent a length \\value \'mismatching the expected length.' }
}
class X::Cro::FCGI::InvalidRole is Exception {
has $.role is required;
method message() { "Invalid role given: $!role" }
}
class X::Cro::FCGI::ManagementApplicationMismatch is Exception {
method message() { "A management record had a request-id or an application record had no request-id." }
}
class Cro::FCGI::RecordParser does Cro::Transform does Cro::ConnectionState[Cro::FCGI::ConnectionState] {
method consumes() { Cro::TCP::Message }
method produces() { Cro::FCGI::Record }
method transformer(Supply:D $in, Cro::FCGI::ConnectionState :$connection-state!) {
supply {
my enum Expecting <Header Payload>;
my Buf $buffer .= new;
my $request-id;
my $length;
my $type;
my $padding;
my Expecting $expecting = Header;
whenever $in -> Cro::TCP::Message $packet {
my $data = $buffer ~ $packet.data;
$buffer .= new;
loop {
$_ = $expecting;
when Header {
if $data.elems < 8 {
$buffer.append: $data;
last;
}
if $data[0] != 1 {
die X::Cro::FCGI::UnsupportedVersion.new: version => $data[0];
}
$type = $data[1];
$request-id = ($data[2] +< 8) +| $data[3];
$length = ($data[4] +< 8) +| $data[5];
$padding = $data[6];
$data .= subbuf(8);
$expecting = Payload;
}
when Payload {
if $data.elems < $length + $padding {
$buffer.append: $data;
last;
}
my Cro::FCGI::Record $record = payload($type, $data, $request-id, $length, :connection($packet.connection));
$data .= subbuf($padding);
$expecting = Header;
emit $record;
}
}
}
}
}
my multi sub payload(1, Buf $data is rw, $request-id, $length, :$connection) {
die X::Cro::FCGI::ManagementApplicationMismatch.new if $request-id == 0;
die X::Cro::FCGI::InvalidLength.new if $length != 8;
my $role = ($data[0] +< 8) +| $data[1];
die X::Cro::FCGI::InvalidRole.new(:$role) unless 1 <= $role <= 3;
my $flags = $data[2];
$data .= subbuf($length);
Cro::FCGI::Record::BeginRequest.new: :$request-id, role => Role($role), :$flags, :$connection;
}
my multi sub payload(2, Buf $data is rw, $request-id, $length, :$connection) {
die X::Cro::FCGI::ManagementApplicationMismatch.new if $request-id == 0;
die X::Cro::FCGI::InvalidLength.new if $length != 0;
$data .= subbuf($length);
Cro::FCGI::Record::AbortRequest.new: :$request-id;
}
my multi sub payload(4, Buf $data is rw, $request-id, $length, :$connection) {
die X::Cro::FCGI::ManagementApplicationMismatch.new if $request-id == 0;
if $length {
my $r = Cro::FCGI::Record::Params.new: :$request-id,
pair-bytes => Buf.new($data.subbuf(0, $length));
$data .= subbuf($length);
$r;
}
else {
Cro::FCGI::Record::Params.new: :$request-id, :ended;
}
}
my multi sub payload($type where 5|6|7|8, Buf $data is rw, $request-id, $length, :$connection) {
die X::Cro::FCGI::ManagementApplicationMismatch.new if $request-id == 0;
if $length {
my $r = Cro::FCGI::Record::ByteStream.new: :$request-id, stream => Stream($type),
data => Buf.new($data.subbuf(0, $length));
$data .= subbuf($length);
$r
}
else {
Cro::FCGI::Record::ByteStream.new: :$request-id, stream => Stream($type), :ended;
}
}
my multi sub payload(9, Buf $data is rw, $request-id, $length is copy, :$connection) {
die X::Cro::FCGI::ManagementApplicationMismatch.new if $request-id != 0;
my @pairs;
while $length > 0 {
my $consumed = Cro::FCGI::NameValuePairs::decode-single($data, @pairs, $length, True);
$length -= $consumed;
$data .= subbuf($consumed);
}
Cro::FCGI::Record::GetValues.new: :$request-id, :@pairs;
}
my multi sub payload($unknown, Buf $data is rw, $request-id, $length, :$connection) {
my $payload = Buf.new: $data.subbuf(0, $length);
$data .= subbuf($length);
Cro::FCGI::Record::Unknown.new: :$request-id, :$payload, type => $unknown;
}
}