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