diff options
Diffstat (limited to '')
| -rwxr-xr-x | web/server/h2o/libh2o/misc/p5-net-fastcgi/eg/server.pl | 164 |
1 files changed, 164 insertions, 0 deletions
diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/eg/server.pl b/web/server/h2o/libh2o/misc/p5-net-fastcgi/eg/server.pl new file mode 100755 index 00000000..74a8db7e --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/eg/server.pl @@ -0,0 +1,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; +} + |