1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2005-2024 -- leonerd@leonerd.org.uk
package Net::Async::FastCGI::ServerProtocol 0.26;
use v5.14;
use warnings;
use base qw( Net::Async::FastCGI::Protocol );
use IO::Async::Stream 0.33;
use Net::FastCGI::Constant qw( FCGI_VERSION_1 :type :role :protocol_status );
use Net::FastCGI::Protocol qw(
build_params parse_params
parse_begin_request_body
build_end_request_body
);
use Net::Async::FastCGI::Request;
sub configure
{
my $self = shift;
my %params = @_;
foreach (qw( stream_stdin )) {
exists $params{$_} and
$self->{$_} = delete $params{$_};
}
$self->SUPER::configure( %params );
}
sub _init
{
my $self = shift;
my ( $params ) = @_;
$self->{fcgi} = delete $params->{fcgi};
$self->{reqs} = {}; # {$reqid} = $req
}
sub on_closed
{
my ( $self ) = @_;
$_->_abort for values %{ $self->{reqs} };
# TODO: This might want to live in IO::Async::Protocol
if( my $parent = $self->parent ) {
$parent->remove_child( $self );
}
}
sub on_mgmt_record
{
my $self = shift;
my ( $type, $rec ) = @_;
return $self->_get_values( $rec ) if $type == FCGI_GET_VALUES;
return $self->SUPER::on_mgmt_record( $type, $rec );
}
sub on_record
{
my $self = shift;
my ( $reqid, $rec ) = @_;
my $type = $rec->{type};
if( $type == FCGI_BEGIN_REQUEST ) {
( my $role, $rec->{flags} ) = parse_begin_request_body( $rec->{content} );
if( $role == FCGI_RESPONDER ) {
my $req = Net::Async::FastCGI::Request->new(
conn => $self,
fcgi => $self->{fcgi},
rec => $rec,
stream_stdin => $self->{stream_stdin},
);
$self->{reqs}->{$reqid} = $req;
}
else {
$self->write_record( { type => FCGI_END_REQUEST, reqid => $rec->{reqid} },
build_end_request_body( 0, FCGI_UNKNOWN_ROLE )
);
}
return;
}
# FastCGI spec says we're supposed to ignore any record apart from
# FCGI_BEGIN_REQUEST on unrecognised request IDs
my $req = $self->{reqs}->{$reqid} or return;
$req->incomingrecord( $rec );
}
sub _req_needs_flush
{
my $self = shift;
$self->{gensub_queued}++ or $self->write( sub {
my ( $self ) = @_;
undef $self->{gensub_queued};
my $want_more = 0;
foreach my $req ( values %{ $self->{reqs} } ) {
$req->_flush_streams;
$want_more = 1 if $req->_needs_flush;
}
$self->_req_needs_flush if $want_more;
return undef;
} );
}
sub _removereq
{
my $self = shift;
my ( $reqid ) = @_;
delete $self->{reqs}->{$reqid};
}
sub _get_values
{
my $self = shift;
my ( $rec ) = @_;
my $content = $rec->{content};
my $ret = "";
foreach my $name ( keys %{ parse_params( $content ) } ) {
my $value = $self->_get_value( $name );
if( defined $value ) {
$ret .= build_params( { $name => $value } );
}
}
$self->write_record(
{
type => FCGI_GET_VALUES_RESULT,
reqid => 0,
},
$ret
);
}
# This is a method so subclasses could hook extra values if they want
sub _get_value
{
my $self = shift;
my ( $name ) = @_;
return 1 if $name eq "FCGI_MPXS_CONNS";
return $Net::Async::FastCGI::MAX_CONNS if $name eq "FCGI_MAX_CONNS";
return $Net::Async::FastCGI::MAX_REQS if $name eq "FCGI_MAX_REQS";
return undef;
}
0x55AA;
|
