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
|
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket qw[];
use PerlIO::scalar qw[];
use Net::FastCGI::Constant qw[:type :role :flag :protocol_status FCGI_NULL_REQUEST_ID];
use Net::FastCGI::IO qw[read_record write_record write_stream];
use Net::FastCGI::Protocol qw[build_end_request_body
build_unknown_type_body
build_params
parse_begin_request_body
parse_params
dump_record_body ];
my %FCGI_VALUES = (
FCGI_MAX_CONNS => 1, # maximum number of concurrent transport connections this application will accept
FCGI_MAX_REQS => 1, # maximum number of concurrent requests this application will accept
FCGI_MPXS_CONNS => 0, # multiplex
);
sub handle_connection {
my ($socket, $on_request) = @_;
my ( $current_id, # id of the request we are currently processing
$stdin, # buffer for stdin
$stdout, # buffer for stdout
$stderr, # buffer for stderr
$params, # buffer for params (environ)
$keep_conn ); # more requests on this connection?
($current_id, $stdin, $stdout, $stderr, $params) = (0, '', '', '', '', '');
use warnings FATAL => 'Net::FastCGI::IO';
while () {
my ($type, $request_id, $content) = read_record($socket)
or last;
if ($request_id == FCGI_NULL_REQUEST_ID) {
if ($type == FCGI_GET_VALUES) {
my $values = parse_params($content);
my %params = map { $_ => $FCGI_VALUES{$_} }
grep { exists $FCGI_VALUES{$_} }
keys %{$values};
write_record($socket, FCGI_GET_VALUES_RESULT,
FCGI_NULL_REQUEST_ID, build_params(\%params));
}
else {
write_record($socket, FCGI_UNKNOWN_TYPE,
FCGI_NULL_REQUEST_ID, build_unknown_type_body($type));
}
}
elsif ($type == FCGI_BEGIN_REQUEST) {
my ($role, $flags) = parse_begin_request_body($content);
if ($current_id || $role != FCGI_RESPONDER) {
my $status = $current_id ? FCGI_CANT_MPX_CONN : FCGI_UNKNOWN_ROLE;
write_record($socket, FCGI_END_REQUEST, $request_id,
build_end_request_body(0, $status));
}
else {
$current_id = $request_id;
$keep_conn = ($flags & FCGI_KEEP_CONN);
}
}
elsif ($request_id != $current_id) {
# ignore inactive requests (FastCGI Specification 3.3)
}
elsif ($type == FCGI_ABORT_REQUEST) {
$current_id = 0;
($stdin, $stdout, $stderr, $params) = ('', '', '', '');
}
elsif ($type == FCGI_PARAMS) {
$params .= $content;
}
elsif ($type == FCGI_STDIN) {
$stdin .= $content;
unless (length $content) {
# process request
open(my $in, '<', \$stdin)
|| die(qq/Couldn't open scalar as a file handle: $!/);
open(my $out, '>', \$stdout)
|| die(qq/Couldn't open scalar as a file handle: $!/);
open(my $err, '>', \$stderr)
|| die(qq/Couldn't open scalar as a file handle: $!/);
my $environ = parse_params($params);
eval {
$on_request->($environ, $in, $out, $err);
};
if (my $e = $@) {
warn(qq/Caught an exception in request callback: '$e'/);
$stdout = "Status: 500 Internal Server Error\n\n";
}
write_stream($socket, FCGI_STDOUT, $current_id, $stdout, 1);
write_stream($socket, FCGI_STDERR, $current_id, $stderr, 1)
if length $stderr;
write_record($socket, FCGI_END_REQUEST, $current_id,
build_end_request_body(0, FCGI_REQUEST_COMPLETE));
# prepare for next request
$current_id = 0;
($stdin, $stdout, $stderr, $params) = ('', '', '', '');
last unless $keep_conn;
}
}
else {
warn(q/Received an unexpected record: / .
dump_record_body($type, $request_id, $content));
}
}
(!$current_id)
|| warn(q/Client prematurely closed connection/);
}
sub handle_request {
my ($env, $stdin, $stdout, $stderr) = @_;
$env->{GATEWAY_INTERFACE} ||= 'CGI/1.1';
local *ENV = $env;
local *STDIN = $stdin;
local *STDOUT = $stdout;
local *STDERR = $stderr;
print "Status: 200 OK\n";
print "Content-Type: text/plain\n\n";
print map { sprintf "%-25s => %s\n", $_, $ENV{$_} } sort keys %ENV;
}
my $addr = shift(@ARGV) || 'localhost:3000';
my $socket = IO::Socket::INET->new(
Listen => 5,
LocalAddr => $addr,
Reuse => 1,
) or die(qq/Couldn't create INET listener socket <$addr>: '$!'./);
print STDERR "Listening for connections on <$addr>\n";
while () {
my $connection = $socket->accept
or last;
eval {
handle_connection($connection, \&handle_request);
};
if (my $e = $@) {
warn(qq/Caught an exception in handle_connection(): '$e'/);
}
close $connection;
}
|
