diff options
Diffstat (limited to '')
38 files changed, 5198 insertions, 0 deletions
diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/Changes b/web/server/h2o/libh2o/misc/p5-net-fastcgi/Changes new file mode 100644 index 00000000..e8a0c6a0 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/Changes @@ -0,0 +1,102 @@ +0.14 2012-03-26 + - No functional changes in this release + - Don't rely on hash keys being ordered in tests, Perl 5.18 introduces a + per process randomization. + +0.13 2011-02-12 + - No functional changes in this release + - Added eg/runfcgi.pl, contributed by Paul Evans (LeoNerd) + - Added eg/server.pl + +0.12 2010-07-14 + - Added Net::FastCGI::IO + +0.11 2010-04-09 + - Documented the goals with this project/distribution + - Net::FastCGI::Protocol + - Fixed dump_record() to properly escape FCGI_NameValuePair header + - Added tests for this + - Added get_record_length() + - Added documentation and tests + - Changed parse_record() to return a list in list context, this makes it + more consistent with parse_header() + - Added documentation and tests this change + - Changed dump_record() to accept a string of octets (old behavior is + still supported but deprecated, please change function call to dump_record_body()) + This change makes it more consistent with parse_record_body(). + - Added documentation and tests this change + +0.10 2010-04-02 + - Minor optimizations to avoid unnecessary copying of '$content' strings + - Fixed dump_record() to properly insert ellipsis when truncating stream content + - added tests for this + - Added more tests for dump_record() + +0.09 2010-03-31 + - Added check_params() and dump_record() + - added documentation + - added test for check_params() and dump_record() (incomplete) + - Minor optimizations to build_stream() and build_record() + +0.08 2010-02-16 + - Documented return value of get_type_name(), get_role_name() + and get_protocol_status_name(). + - Changed test prerequisite from Test::BinaryData to Test::HexString. + - Corrected note about AnyEvent::FCGI, it's capable of multiplexing. + +0.07 2010-02-10 + - Added notes about existing Perl implementations. + - Added references to specifications and white papers. + - Minor internal "cosmetic" changes + - Added more tests for build_begin_request() and build_end_request() + +0.06 2010-02-09 + - NOTE: Changed application_status to app_status, this affects users of + parse_record() or parse_record_body(). Former was unnecessarily verbose. + Latter also matches the component name of FCGI_BeginRequestBody struct. + - Added build_begin_request() and build_end_request() + - added documentation and tests for these + +0.05 2010-02-06 + - Net::FastCGI::Constant + - Improved documentation + - Added @FCGI_TYPE_NAME, @FCGI_ROLE_NAME and @FCGI_PROTOCOL_STATUS_NAME + - Re-factored Net::FastCGI::Protocol to use these. + - Renamed FCGI_MAX_LEN to FCGI_MAX_CONTENT_LEN + - FCGI_MAX_LEN is deprecated and will be removed in a future version. + - Net::FastCGI::Protocol + - Fixed parse_record() and parse_record_body() to properly detect malformed + stream records. + - Added tests for this. + - Increased segment size in build_stream() from 8192 to 32760 to reflect modern + socket buffers. + - Updated tests + - Documented segment size + - Documented scalar return value of parse_header() + - Minor documentation updates + +0.04 2010-01-30 + - Added parse_record() and parse_record_body() + - Added tests for these + - Added docs (incomplete) + - Cleaned up exception messages. Protocol exceptions now have a FastCGI prefix + - Fixed parse_params() to correctly detect incomplete FCGI_NameValuePair's + - added tests for this + - Added tests for build_stream() + - Changed parse_header() to return a hash reference in scalar context + - added tests for this + - Coverage ~90% (stmt:100.0 bran:96.9 cond:92.9) + - More tests (and docs) needed to cover all cases + +0.03 2010-01-23 + - Fixed package loading in Net::FastCGI::Protocol + +0.02 2010-01-23 + - Removed object oriented implementation, it will eventually be released as + a separate distribution with different prerequisites. + - Removed unnecessary functions from Net::FastCGI::Protocol + - Re-factored internals of Net::FastCGI::Protocol to be more performant. + - No major changes planned for existing API in Net::FastCGI::Protocol + +0.01_01 2009-10-17 + - Initial release. diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/MANIFEST.SKIP b/web/server/h2o/libh2o/misc/p5-net-fastcgi/MANIFEST.SKIP new file mode 100644 index 00000000..b6d0b82f --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/MANIFEST.SKIP @@ -0,0 +1,25 @@ +^_build +^Build$ +^blib +~$ +\.bak$ +CVS +\.svn +\.DS_Store +cover_db +\..*\.sw.?$ +^Makefile$ +^pm_to_blib$ +^MakeMaker-\d +^blibdirs$ +\.old$ +^#.*#$ +^\.# +^TODO$ +^PLANS$ +^doc/ +^dev/ +^benchmarks +^\._.*$ +\.shipit +\.git.* diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/Makefile.PL b/web/server/h2o/libh2o/misc/p5-net-fastcgi/Makefile.PL new file mode 100644 index 00000000..0b1d1f48 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/Makefile.PL @@ -0,0 +1,19 @@ +use strict; +use inc::Module::Install; + +name 'Net-FastCGI'; +perl_version '5.006'; +all_from 'lib/Net/FastCGI.pm'; +repository 'http://github.com/chansen/p5-net-fastcgi'; + +requires 'Carp' => '0'; +requires 'Exporter' => '0'; + +test_requires 'Test::More' => '0.47'; +test_requires 'Test::Exception' => '0'; +test_requires 'Test::HexString' => '0'; + +tests 't/*.t t/*/*.t'; + +WriteAll; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/README b/web/server/h2o/libh2o/misc/p5-net-fastcgi/README new file mode 100644 index 00000000..4eea9d55 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/README @@ -0,0 +1,113 @@ +NAME + Net::FastCGI - FastCGI Toolkit + +DESCRIPTION + This distribution aims to provide a complete API for working with the + FastCGI protocol. + + The primary goal is to provide a function oriented and object oriented + API which are not tied to a specific I/O model or framework. + + Secondary goal is to provide higher level tools/API which can be used + for debugging and interoperability testing. + +PROGRESS + The function oriented API is considered feature complete. + Net::FastCGI::Protocol provides functions to build and parse all FastCGI + v1.0 messages, also provided is a few convenient higher level functions + such as "build_begin_request()", "build_end_request()", "parse_record()" + and "dump_record()". + + Work has begun on object oriented implementation and a simple blocking + I/O class which is intended for testing and debugging. + +PACKAGES + Net::FastCGI::Constant + FastCGI protocol constants. + + Net::FastCGI::IO + Provides functions to read and write FastCGI messages. + + Net::FastCGI::Protocol + Provides functions to build and parse FastCGI messages. + +ENVIRONMENT + Environment variable "NET_FASTCGI_PP" can be set to a true value before + loading this package to disable usage of XS implementation. + +PREREQUISITES + Run-Time + perl 5.6 or greater. + Carp, core module. + Exporter, core module. + + Build-Time + In addition to Run-Time: + + Test::More 0.47 or greater, core module since 5.6.2. + Test::Exception. + Test::HexString. + +SEE ALSO + Community + Official FastCGI site + <http://www.fastcgi.com/> + + Standards + FastCGI Specification Version 1.0 + <http://www.fastcgi.com/devkit/doc/fcgi-spec.html> + + RFC 3875 - The Common Gateway Interface (CGI) Version 1.1 + <http://tools.ietf.org/html/rfc3875> + + White papers + FastCGI: A High-Performance Web Server Interface + <http://www.fastcgi.com/devkit/doc/fastcgi-whitepaper/fastcgi.htm> + + FastCGI - The Forgotten Treasure + <http://cryp.to/publications/fastcgi/> + + Perl implementations + AnyEvent::FCGI + Application server implementation, built on top of AnyEvent. + Supports Responder role. Capable of multiplexing. + + FCGI + Application server implementation, built on top of "libfcgi" + (reference implementation). Supports all FastCGI roles. Responds to + management records. Processes requests synchronously. + + FCGI::Async + Application server implementation, built on top of IO::Async. + Supports Responder role. Responds to management records. Capable of + multiplexing. + + FCGI::Client + Client (Web server) implementation. Supports Responder role. + + FCGI::EV + Application server implementation, built on top of EV. Supports + Responder role. + + Mojo::Server::FastCGI + Application server implementation. Supports Responder role. + Processes requests synchronously. + + POE::Component::FastCGI + Application server implementation, built on top of POE. Supports + Responder role. Capable of multiplexing. + +SUPPORT + Please report any bugs or feature requests to + "bug-net-fastcgi@rt.cpan.org", or through the web interface at + <http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-FastCGI> + +AUTHOR + Christian Hansen "chansen@cpan.org" + +COPYRIGHT + Copyright 2008-2010 by Christian Hansen. + + This library is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/eg/runfcgi.pl b/web/server/h2o/libh2o/misc/p5-net-fastcgi/eg/runfcgi.pl new file mode 100755 index 00000000..7ee01a9f --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/eg/runfcgi.pl @@ -0,0 +1,226 @@ +#!/usr/bin/perl +# This program is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# (C) Paul Evans, 2010 -- leonerd@leonerd.org.uk + +use strict; +use warnings; + +use Getopt::Long; + +use Net::FastCGI::IO qw( read_record ); +use Net::FastCGI::Constant qw( :common :type :role ); +use Net::FastCGI::Protocol qw( + build_begin_request_body + build_params + parse_end_request_body +); + +sub write_record +{ + Net::FastCGI::IO::write_record(@_) or + die "Cannot write_record - $!"; +} + +my %env = ( + REQUEST_METHOD => "GET", + SCRIPT_NAME => "", + SERVER_NAME => "server", + SERVER_PORT => 80, + SERVER_PROTOCOL => "HTTP/1.1", +); + +my $stdin_from; +my $filter_stdout; + +sub usage +{ + print <<"EOF"; +$0 [options] CONNECT URL + +Runs the FastCGI found at CONNECT, as if it had received the URL + +CONNECT may be any of + + exec:PATH Execute as a child process with socket on STDIN + unix:PATH Find a UNIX socket on the given path + tcp:HOST:PORT Connect to the given port on the given host + HOST:PORT as above + +options may be: + + --body Print just the HTTP response body + --no-body Print just the HTTP response headers without the body + -m, --method METHOD Use the specified method (default "GET") + -p, --post Method is POST, pass STDIN + --put Method is PUT, pass STDIN + --stdin PATH Read STDIN from specified path, "-" means real script + +EOF +} + +GetOptions( + 'body' => sub { + defined $filter_stdout and die "Cannot --no-body and --body\n"; + $filter_stdout = "body"; + }, + 'no-body' => sub { + defined $filter_stdout and die "Cannot --no-body and --body\n"; + $filter_stdout = "headers"; + }, + 'm|method=s' => \$env{REQUEST_METHOD}, + 'p|post' => sub { + $env{REQUEST_METHOD} = "POST"; + $stdin_from = "-"; + }, + 'put' => sub { + $env{REQUEST_METHOD} = "PUT"; + $stdin_from = "-"; + }, + 'stdin=s' => \$stdin_from, + 'help' => sub { usage; exit(0) }, +) or exit(1); + +my $connect = shift @ARGV or + die "Require connection string\n"; + +my $url = shift @ARGV or + die "Require a URL"; + +if( $url =~ s{^http(s?)://([^/:]+)(?::([^/]+))?}{} ) { + $env{HTTPS} = "on" if $1; + $env{SERVER_NAME} = $2; + $env{SERVER_PORT} = $3 || ( $1 ? 443 : 80 ); +} + +$env{REQUEST_URI} = $url; + +my ( $path, $query ) = $url =~ m/^(.*)(?:\?(.*))$/; + +$env{PATH_INFO} = $path; +$env{QUERY_STRING} = $query; + +my $socket; + +if( $connect =~ m/^unix:(.*)$/ ) { + my $path = $1; + + require IO::Socket::UNIX; + + $socket = IO::Socket::UNIX->new( + Peer => $path, + ) or die "Cannot connect - $!\n"; +} +elsif( $connect =~ m/^exec:(.*)$/ ) { + my $script = $1; + + require IO::Socket::INET; + + my $listener = IO::Socket::INET->new( + LocalHost => "localhost", + Listen => 1, + ) or die "Cannot listen - $@"; + + defined( my $kid = fork ) or die "Cannot fork - $!"; + END { defined $kid and kill TERM => $kid } + + if( $kid == 0 ) { + close STDIN; + open STDIN, "<&", $listener or die "Cannot dup $listener to STDIN - $!"; + + close $listener; + + exec { $script } $script or die "Cannot exec $script - $!"; + } + + $socket = IO::Socket::INET->new( + PeerHost => $listener->sockhost, + PeerPort => $listener->sockport, + ) or die "Cannot connect - $@"; + + close $listener; +} +elsif( $connect =~ m/^(?:tcp:)?(.*):(.+?)$/ ) { + my $host = $1 || "localhost"; + my $port = $2; + + my $class = eval { require IO::Socket::IP and "IO::Socket::IP" } || + do { require IO::Socket::INET and "IO::Socket::INET" }; + + $socket = $class->new( + PeerHost => $host, + PeerPort => $port, + ) or die "Cannot connect - $@\n"; +} +else { + die "Cannot recognise connection string '$connect'\n"; +} + +write_record( $socket, FCGI_BEGIN_REQUEST, 1, + build_begin_request_body( FCGI_RESPONDER, 0 ) ); + +write_record( $socket, FCGI_PARAMS, 1, + build_params( \%env ) ); + +write_record( $socket, FCGI_PARAMS, 1, "" ); + +if( defined $stdin_from ) { + my $stdin; + + if( $stdin_from eq "-" ) { + $stdin = \*STDIN; + } + else { + open $stdin, "<", $stdin_from or die "Cannot open $stdin_from for input - $!"; + } + + while( read( $stdin, my $buffer, 8192 ) ) { + write_record( $socket, FCGI_STDIN, 1, $buffer ); + } +} + +write_record( $socket, FCGI_STDIN, 1, "" ); + +my $stdout = ""; + +while(1) { + my ( $type, $id, $content ) = read_record( $socket ) + or $! and die "Cannot read_record - $!" + or last; + + if( $type == FCGI_STDOUT ) { + if( !defined $filter_stdout ) { + print STDOUT $content; + } + elsif( $filter_stdout eq "headers" ) { + my $oldlen = length $stdout; + $stdout .= $content; + if( $stdout =~ m/\r\n\r\n/ ) { + # Print only the bit we haven't done yet + print STDOUT substr( $stdout, $oldlen, $+[0] - $oldlen ); + $filter_stdout = 1; # I.e. suppress the lot + } + else { + print STDOUT $content; + } + } + elsif( $filter_stdout eq "body" ) { + $stdout .= $content; + if( $stdout =~ m/\r\n\r\n/ ) { + print STDOUT substr( $stdout, $+[0] ); + $filter_stdout = undef; + } + } + } + elsif( $type == FCGI_STDERR ) { + print STDERR $content; + } + elsif( $type == FCGI_END_REQUEST ) { + my ( $app_status, $protocol_status ) = parse_end_request_body( $content ); + exit $app_status; + } + else { + die "Unrecognised FastCGI request type $type\n"; + } +} 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; +} + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI.pm b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI.pm new file mode 100644 index 00000000..4126b219 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI.pm @@ -0,0 +1,12 @@ +package Net::FastCGI; + +use strict; +use warnings; + +our $VERSION = '0.14'; + +use Net::FastCGI::Constant; +use Net::FastCGI::Protocol; + +1; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI.pod b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI.pod new file mode 100644 index 00000000..65725b95 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI.pod @@ -0,0 +1,170 @@ +=head1 NAME + +Net::FastCGI - FastCGI Toolkit + +=head1 DESCRIPTION + +This distribution aims to provide a complete API for working with the FastCGI +protocol. + +The primary goal is to provide a function oriented and object oriented API which +are not tied to a specific I/O model or framework. + +Secondary goal is to provide higher level tools/API which can be used for debugging +and interoperability testing. + +=head1 PROGRESS + +The function oriented API is considered feature complete. L<Net::FastCGI::Protocol> +provides functions to build and parse all FastCGI v1.0 messages, also provided is a +few convenient higher level functions such as C<build_begin_request()>, +C<build_end_request()>, C<parse_record()> and C<dump_record()>. + +Work has begun on object oriented implementation and a simple blocking I/O class which is +intended for testing and debugging. + +=head1 PACKAGES + +=over 4 + +=item L<Net::FastCGI::Constant> + +FastCGI protocol constants. + +=item L<Net::FastCGI::IO> + +Provides functions to read and write FastCGI messages. + +=item L<Net::FastCGI::Protocol> + +Provides functions to build and parse FastCGI messages. + +=back + +=head1 ENVIRONMENT + +Environment variable C<NET_FASTCGI_PP> can be set to a true value before loading +this package to disable usage of XS implementation. + +=head1 PREREQUISITES + +=head2 Run-Time + +=over 4 + +=item L<perl> 5.6 or greater. + +=item L<Carp>, core module. + +=item L<Exporter>, core module. + +=back + +=head2 Build-Time + +In addition to Run-Time: + +=over 4 + +=item L<Test::More> 0.47 or greater, core module since 5.6.2. + +=item L<Test::Exception>. + +=item L<Test::HexString>. + +=back + +=head1 SEE ALSO + +=head2 Community + +=over 4 + +=item Official FastCGI site + +L<http://www.fastcgi.com/> + +=back + +=head2 Standards + +=over 4 + +=item FastCGI Specification Version 1.0 + +L<http://www.fastcgi.com/devkit/doc/fcgi-spec.html> + +=item RFC 3875 - The Common Gateway Interface (CGI) Version 1.1 + +L<http://tools.ietf.org/html/rfc3875> + +=back + +=head2 White papers + +=over 4 + +=item FastCGI: A High-Performance Web Server Interface + +L<http://www.fastcgi.com/devkit/doc/fastcgi-whitepaper/fastcgi.htm> + +=item FastCGI - The Forgotten Treasure + +L<http://cryp.to/publications/fastcgi/> + +=back + +=head2 Perl implementations + +=over 4 + +=item L<AnyEvent::FCGI> + +Application server implementation, built on top of L<AnyEvent>. Supports Responder role. +Capable of multiplexing. + +=item L<FCGI> + +Application server implementation, built on top of C<libfcgi> (reference implementation). +Supports all FastCGI roles. Responds to management records. Processes requests synchronously. + +=item L<FCGI::Async> + +Application server implementation, built on top of L<IO::Async>. Supports Responder role. +Responds to management records. Capable of multiplexing. + +=item L<FCGI::Client> + +Client (Web server) implementation. Supports Responder role. + +=item L<FCGI::EV> + +Application server implementation, built on top of L<EV>. Supports Responder role. + +=item L<Mojo::Server::FastCGI> + +Application server implementation. Supports Responder role. Processes requests synchronously. + +=item L<POE::Component::FastCGI> + +Application server implementation, built on top of L<POE>. Supports Responder role. +Capable of multiplexing. + +=back + +=head1 SUPPORT + +Please report any bugs or feature requests to C<bug-net-fastcgi@rt.cpan.org>, or through +the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-FastCGI> + +=head1 AUTHOR + +Christian Hansen C<chansen@cpan.org> + +=head1 COPYRIGHT + +Copyright 2008-2010 by Christian Hansen. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Constant.pm b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Constant.pm new file mode 100644 index 00000000..1e86dbf1 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Constant.pm @@ -0,0 +1,179 @@ +package Net::FastCGI::Constant; + +use strict; +use warnings; + +BEGIN { + our $VERSION = '0.14'; + my @common = qw[ FCGI_MAX_CONTENT_LEN + FCGI_MAX_LEN + FCGI_HEADER_LEN + FCGI_VERSION_1 + FCGI_NULL_REQUEST_ID ]; + + my @type = qw[ FCGI_BEGIN_REQUEST + FCGI_ABORT_REQUEST + FCGI_END_REQUEST + FCGI_PARAMS + FCGI_STDIN + FCGI_STDOUT + FCGI_STDERR + FCGI_DATA + FCGI_GET_VALUES + FCGI_GET_VALUES_RESULT + FCGI_UNKNOWN_TYPE + FCGI_MAXTYPE ]; + + my @role = qw[ FCGI_RESPONDER + FCGI_AUTHORIZER + FCGI_FILTER ]; + + my @flag = qw[ FCGI_KEEP_CONN ]; + + my @protocol_status = qw[ FCGI_REQUEST_COMPLETE + FCGI_CANT_MPX_CONN + FCGI_OVERLOADED + FCGI_UNKNOWN_ROLE ]; + + my @value = qw[ FCGI_MAX_CONNS + FCGI_MAX_REQS + FCGI_MPXS_CONNS ]; + + my @pack = qw[ FCGI_Header + FCGI_BeginRequestBody + FCGI_EndRequestBody + FCGI_UnknownTypeBody ]; + + my @name = qw[ @FCGI_TYPE_NAME + @FCGI_RECORD_NAME + @FCGI_ROLE_NAME + @FCGI_PROTOCOL_STATUS_NAME ]; + + our @EXPORT_OK = ( @common, + @type, + @role, + @flag, + @protocol_status, + @value, + @pack, + @name ); + + our %EXPORT_TAGS = ( all => \@EXPORT_OK, + common => \@common, + type => \@type, + role => \@role, + flag => \@flag, + protocol_status => \@protocol_status, + value => \@value, + pack => \@pack ); + + our @FCGI_TYPE_NAME = ( + undef, # 0 + 'FCGI_BEGIN_REQUEST', # 1 + 'FCGI_ABORT_REQUEST', # 2 + 'FCGI_END_REQUEST', # 3 + 'FCGI_PARAMS', # 4 + 'FCGI_STDIN', # 5 + 'FCGI_STDOUT', # 6 + 'FCGI_STDERR', # 7 + 'FCGI_DATA', # 8 + 'FCGI_GET_VALUES', # 9 + 'FCGI_GET_VALUES_RESULT', # 10 + 'FCGI_UNKNOWN_TYPE' # 11 + ); + + our @FCGI_RECORD_NAME = ( + undef, # 0 + 'FCGI_BeginRequestRecord', # 1 + 'FCGI_AbortRequestRecord', # 2 + 'FCGI_EndRequestRecord', # 3 + 'FCGI_ParamsRecord', # 4 + 'FCGI_StdinRecord', # 5 + 'FCGI_StdoutRecord', # 6 + 'FCGI_StderrRecord', # 7 + 'FCGI_DataRecord', # 8 + 'FCGI_GetValuesRecord', # 9 + 'FCGI_GetValuesResultRecord', # 10 + 'FCGI_UnknownTypeRecord', # 11 + ); + + our @FCGI_ROLE_NAME = ( + undef, # 0 + 'FCGI_RESPONDER', # 1 + 'FCGI_AUTHORIZER', # 2 + 'FCGI_FILTER', # 3 + ); + + our @FCGI_PROTOCOL_STATUS_NAME = ( + 'FCGI_REQUEST_COMPLETE', # 0 + 'FCGI_CANT_MPX_CONN', # 1 + 'FCGI_OVERLOADED', # 2 + 'FCGI_UNKNOWN_ROLE', # 3 + ); + + if (Internals->can('SvREADONLY')) { # 5.8 + Internals::SvREADONLY(@FCGI_TYPE_NAME, 1); + Internals::SvREADONLY(@FCGI_RECORD_NAME, 1); + Internals::SvREADONLY(@FCGI_ROLE_NAME, 1); + Internals::SvREADONLY(@FCGI_PROTOCOL_STATUS_NAME, 1); + Internals::SvREADONLY($_, 1) for @FCGI_TYPE_NAME, + @FCGI_RECORD_NAME, + @FCGI_ROLE_NAME, + @FCGI_PROTOCOL_STATUS_NAME; + } + + require Exporter; + *import = \&Exporter::import; +} + + +sub FCGI_LISTENSOCK_FILENO () { 0 } + +# common +sub FCGI_MAX_CONTENT_LEN () { 0xFFFF } +sub FCGI_MAX_LEN () { 0xFFFF } # deprecated +sub FCGI_HEADER_LEN () { 8 } +sub FCGI_VERSION_1 () { 1 } +sub FCGI_NULL_REQUEST_ID () { 0 } + +# type +sub FCGI_BEGIN_REQUEST () { 1 } +sub FCGI_ABORT_REQUEST () { 2 } +sub FCGI_END_REQUEST () { 3 } +sub FCGI_PARAMS () { 4 } +sub FCGI_STDIN () { 5 } +sub FCGI_STDOUT () { 6 } +sub FCGI_STDERR () { 7 } +sub FCGI_DATA () { 8 } +sub FCGI_GET_VALUES () { 9 } +sub FCGI_GET_VALUES_RESULT () { 10 } +sub FCGI_UNKNOWN_TYPE () { 11 } +sub FCGI_MAXTYPE () { FCGI_UNKNOWN_TYPE } + +# role +sub FCGI_RESPONDER () { 1 } +sub FCGI_AUTHORIZER () { 2 } +sub FCGI_FILTER () { 3 } + +# flags +sub FCGI_KEEP_CONN () { 1 } + +# protocol status +sub FCGI_REQUEST_COMPLETE () { 0 } +sub FCGI_CANT_MPX_CONN () { 1 } +sub FCGI_OVERLOADED () { 2 } +sub FCGI_UNKNOWN_ROLE () { 3 } + +# value +sub FCGI_MAX_CONNS () { 'FCGI_MAX_CONNS' } +sub FCGI_MAX_REQS () { 'FCGI_MAX_REQS' } +sub FCGI_MPXS_CONNS () { 'FCGI_MPXS_CONNS' } + +# pack +sub FCGI_Header () { 'CCnnCx' } +sub FCGI_BeginRequestBody () { 'nCx5' } +sub FCGI_EndRequestBody () { 'NCx3' } +sub FCGI_UnknownTypeBody () { 'Cx7' } + +1; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Constant.pod b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Constant.pod new file mode 100644 index 00000000..d0ca04c1 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Constant.pod @@ -0,0 +1,264 @@ +=head1 NAME + +Net::FastCGI::Constant - FastCGI protocol constants. + +=head1 DESCRIPTION + +FastCGI protocol constants. + +=head1 CONSTANTS + +Constants can either be imported individually or in sets grouped by tag names. +The tag names are: + +=head2 C<:common> + +=over 4 + +=item C<FCGI_MAX_CONTENT_LEN> + +Maximum number of octets that the content component of the record can hold. (C<65535>) + +=item C<FCGI_HEADER_LEN> + +Number of octets in C<FCGI_Header>. (C<8>) + +=item C<FCGI_VERSION_1> + +Value for C<version> component of C<FCGI_Header>. (C<1>) + +=item C<FCGI_NULL_REQUEST_ID> + +Value for C<request_id> component of C<FCGI_Header>. (C<0>) + +=back + +=head2 C<:type> + +Values for C<type> component of C<FCGI_Header>. + +=over 4 + +=item C<FCGI_BEGIN_REQUEST> + +=item C<FCGI_ABORT_REQUEST> + +=item C<FCGI_END_REQUEST> + +=item C<FCGI_PARAMS> + +=item C<FCGI_STDIN> + +=item C<FCGI_STDOUT> + +=item C<FCGI_STDERR> + +=item C<FCGI_DATA> + +=item C<FCGI_GET_VALUES> + +=item C<FCGI_GET_VALUES_RESULT> + +=item C<FCGI_UNKNOWN_TYPE> + +=item C<FCGI_MAXTYPE> + +=back + +=head2 C<:flag> + +Mask for C<flags> component of C<FCGI_BeginRequestBody>. + +=over 4 + +=item C<FCGI_KEEP_CONN> + +=back + +=head2 C<:role> + +Values for C<role> component of C<FCGI_BeginRequestBody>. + +=over 4 + +=item C<FCGI_RESPONDER> + +=item C<FCGI_AUTHORIZER> + +=item C<FCGI_FILTER> + +=back + +=head2 C<:protocol_status> + +Values for C<protocol_status> component of C<FCGI_EndRequestBody>. + +=over 4 + +=item C<FCGI_REQUEST_COMPLETE> + +=item C<FCGI_CANT_MPX_CONN> + +=item C<FCGI_OVERLOADED> + +=item C<FCGI_UNKNOWN_ROLE> + +=back + +=head2 C<:value> + +Variable names for C<FCGI_GET_VALUES> / C<FCGI_GET_VALUES_RESULT> records. + +=over 4 + +=item C<FCGI_MAX_CONNS> + +=item C<FCGI_MAX_REQS> + +=item C<FCGI_MPXS_CONNS> + +=back + +=head2 C<:pack> + +C<pack()> / C<unpack()> templates + +=over 4 + +=item C<FCGI_Header> + + Octet/ 0 | 1 | + / | | + | 0 1 2 3 4 5 6 7 | 0 1 2 3 4 5 6 7 | + +-----------------+-----------------+ + 0 | Version | Type | + +-----------------+-----------------+ + 2 | Request ID | + +-----------------+-----------------+ + 4 | Content Length | + +-----------------+-----------------+ + 6 | Padding Length | Reserved | + +-----------------+-----------------+ + Total 8 octets + + Template: CCnnCx + + my ($version, $type, $request_id, $content_length, $padding_length) + = unpack(FCGI_Header, $octets); + +=item C<FCGI_BeginRequestBody> + + Octet/ 0 | 1 | + / | | + | 0 1 2 3 4 5 6 7 | 0 1 2 3 4 5 6 7 | + +-----------------+-----------------+ + 0 | Role | + +-----------------+-----------------+ + 2 | Flags | | + +-----------------+ + + 4 | | + + Reserved + + 6 | | + +-----------------+-----------------+ + Total 8 octets + + Template: nCx5 + + my ($role, $flags) = unpack(FCGI_BeginRequestBody, $octets); + +=item C<FCGI_EndRequestBody> + + Octet/ 0 | 1 | + / | | + | 0 1 2 3 4 5 6 7 | 0 1 2 3 4 5 6 7 | + +-----------------+-----------------+ + 0 | | + + Application Status + + 2 | | + +-----------------+-----------------+ + 4 | Protocol Status | | + +-----------------+ Reserved + + 6 | | + +-----------------+-----------------+ + Total 8 octets + + Template: NCx3 + + my ($app_status, $protocol_status) + = unpack(FCGI_EndRequestBody, $octets); + +=item C<FCGI_UnknownTypeBody> + + Octet/ 0 | 1 | + / | | + | 0 1 2 3 4 5 6 7 | 0 1 2 3 4 5 6 7 | + +-----------------+-----------------+ + 0 | Unknown Type | | + +-----------------+ + + 2 | | + + + + 4 | Reserved | + + + + 6 | | + +-----------------+-----------------+ + Total 8 octets + + Template: Cx7 + + my $unknown_type = unpack(FCGI_UnknownTypeBody, $octets); + +=back + +=head2 C<:name> + +Arrays containing names of value components. These are read-only. + +=over 4 + +=item C<@FCGI_TYPE_NAME> + + print $FCGI_TYPE_NAME[FCGI_BEGIN_REQUEST]; # FCGI_BEGIN_REQUEST + +=item C<@FCGI_ROLE_NAME> + + print $FCGI_ROLE_NAME[FCGI_RESPONDER]; # FCGI_RESPONDER + +=item C<@FCGI_PROTOCOL_STATUS_NAME> + + print $FCGI_PROTOCOL_STATUS_NAME[FCGI_OVERLOADED]; # FCGI_OVERLOADED + +=back + +I<Note> + +It's not safe to assume that C<exists> works for validation purposes, index C<0> +might be C<undef>. + +Use boolean context instead: + + ($FCGI_TYPE_NAME[$type]) + || die; + +=head1 EXPORTS + +None by default. All functions can be exported using the C<:all> tag or individually. + +=head1 SEE ALSO + +=over 4 + +=item L<http://www.fastcgi.com/devkit/doc/fcgi-spec.html> + +=back + +=head1 AUTHOR + +Christian Hansen C<chansen@cpan.org> + +=head1 COPYRIGHT + +Copyright 2008-2010 by Christian Hansen. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/IO.pm b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/IO.pm new file mode 100644 index 00000000..15583fb5 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/IO.pm @@ -0,0 +1,227 @@ +package Net::FastCGI::IO; +use strict; +use warnings; +use warnings::register; + +use Carp qw[]; +use Errno qw[EBADF EINTR EPIPE]; +use Net::FastCGI::Constant qw[FCGI_HEADER_LEN]; +use Net::FastCGI::Protocol qw[build_header build_record build_stream + parse_header parse_record]; + +BEGIN { + our $VERSION = '0.14'; + our @EXPORT_OK = qw[ can_read + can_write + read_header + read_record + write_header + write_record + write_stream ]; + + our %EXPORT_TAGS = ( all => \@EXPORT_OK ); + + require Exporter; + *import = \&Exporter::import; + + eval q<use Time::HiRes 'time'>; +} + +*throw = \&Carp::croak; + +sub read_header { + @_ == 1 || throw(q/Usage: read_header(fh)/); + my ($fh) = @_; + + my $len = FCGI_HEADER_LEN; + my $off = 0; + my $buf; + + while ($len) { + my $r = sysread($fh, $buf, $len, $off); + if (defined $r) { + last unless $r; + $len -= $r; + $off += $r; + } + elsif ($! != EINTR) { + warnings::warn(qq<FastCGI: Could not read FCGI_Header: '$!'>) + if warnings::enabled; + return; + } + } + if ($len) { + $! = $off ? EPIPE : 0; + warnings::warn(q<FastCGI: Could not read FCGI_Header: Unexpected end of stream>) + if $off && warnings::enabled; + return; + } + return parse_header($buf); +} + +sub write_header { + @_ == 5 || throw(q/Usage: write_header(fh, type, request_id, content_length, padding_length)/); + my $fh = shift; + + my $buf = &build_header; + my $len = FCGI_HEADER_LEN; + my $off = 0; + + while () { + my $r = syswrite($fh, $buf, $len, $off); + if (defined $r) { + $len -= $r; + $off += $r; + last unless $len; + } + elsif ($! != EINTR) { + warnings::warn(qq<FastCGI: Could not write FCGI_Header: '$!'>) + if warnings::enabled; + return undef; + } + } + return $off; +} + +sub read_record { + @_ == 1 || throw(q/Usage: read_record(fh)/); + my ($fh) = @_; + + my $len = FCGI_HEADER_LEN; + my $off = 0; + my $buf; + + while ($len) { + my $r = sysread($fh, $buf, $len, $off); + if (defined $r) { + last unless $r; + $len -= $r; + $off += $r; + if (!$len && $off == FCGI_HEADER_LEN) { + $len = vec($buf, 2, 16) # Content Length + + vec($buf, 6, 8); # Padding Length + } + } + elsif ($! != EINTR) { + warnings::warn(qq<FastCGI: Could not read FCGI_Record: '$!'>) + if warnings::enabled; + return; + } + } + if ($len) { + $! = $off ? EPIPE : 0; + warnings::warn(q<FastCGI: Could not read FCGI_Record: Unexpected end of stream>) + if $off && warnings::enabled; + return; + } + return parse_record($buf); +} + +sub write_record { + @_ == 4 || @_ == 5 || throw(q/Usage: write_record(fh, type, request_id [, content])/); + my $fh = shift; + + my $buf = &build_record; + my $len = length $buf; + my $off = 0; + + while () { + my $r = syswrite($fh, $buf, $len, $off); + if (defined $r) { + $len -= $r; + $off += $r; + last unless $len; + } + elsif ($! != EINTR) { + warnings::warn(qq<FastCGI: Could not write FCGI_Record: '$!'>) + if warnings::enabled; + return undef; + } + } + return $off; +} + +sub write_stream { + @_ == 4 || @_ == 5 || throw(q/Usage: write_stream(fh, type, request_id, content [, terminate])/); + my $fh = shift; + + my $buf = &build_stream; + my $len = length $buf; + my $off = 0; + + while () { + my $r = syswrite($fh, $buf, $len, $off); + if (defined $r) { + $len -= $r; + $off += $r; + last unless $len; + } + elsif ($! != EINTR) { + warnings::warn(qq<FastCGI: Could not write FCGI_Record stream: '$!'>) + if warnings::enabled; + return undef; + } + } + return $off; +} + +sub can_read (*$) { + @_ == 2 || throw(q/Usage: can_read(fh, timeout)/); + my ($fh, $timeout) = @_; + + my $fd = fileno($fh); + unless (defined $fd && $fd >= 0) { + $! = EBADF; + return undef; + } + + my $initial = time; + my $pending = $timeout; + my $nfound; + + vec(my $fdset = '', $fd, 1) = 1; + + while () { + $nfound = select($fdset, undef, undef, $pending); + if ($nfound == -1) { + return undef unless $! == EINTR; + redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0; + $nfound = 0; + } + last; + } + $! = 0; + return $nfound; +} + +sub can_write (*$) { + @_ == 2 || throw(q/Usage: can_write(fh, timeout)/); + my ($fh, $timeout) = @_; + + my $fd = fileno($fh); + unless (defined $fd && $fd >= 0) { + $! = EBADF; + return undef; + } + + my $initial = time; + my $pending = $timeout; + my $nfound; + + vec(my $fdset = '', $fd, 1) = 1; + + while () { + $nfound = select(undef, $fdset, undef, $pending); + if ($nfound == -1) { + return undef unless $! == EINTR; + redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0; + $nfound = 0; + } + last; + } + $! = 0; + return $nfound; +} + +1; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/IO.pod b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/IO.pod new file mode 100644 index 00000000..84a9f097 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/IO.pod @@ -0,0 +1,391 @@ +=head1 NAME + +Net::FastCGI::IO - Provides functions to read and write FastCGI messages. + +=head1 SYNOPSIS + + # FCGI_Header + @values = read_header($fh); + $header = read_header($fh); + $result = write_header($fh, $type, $request_id, $content_length, $padding_length); + + # FCGI_Record + @values = read_record($fh); + $record = read_record($fh); + $result = write_record($fh, $type, $request_id); + $result = write_record($fh, $type, $request_id, $content); + + # FCGI_Record Stream + $result = write_stream($fh, $type, $request_id, $content); + $result = write_stream($fh, $type, $request_id, $content, $terminate); + + # I/O ready + $result = can_read($fh, $timeout); + $result = can_write($fh, $timeout); + +=head1 DESCRIPTION + +Provides unbuffered blocking I/O functions to read and write FastCGI messages. + +=head1 FUNCTIONS + +=head2 read_header + +Attempts to read a C<FCGI_Header> from file handle C<$fh>. + +I<Usage> + + ($type, $request_id, $content_length, $padding_length) + = read_header($fh); + + $header = read_header($fh); + say $header->{type}; + say $header->{request_id}; + say $header->{content_length}; + say $header->{padding_length}; + +I<Arguments> + +=over 4 + +=item C<$fh> + +The file handle to read from. Must be a file handle with a file descriptor. File handle +mode should be set to binary. + +=back + +I<Returns> + +Upon successful completion, the return value of L<Net::FastCGI::Protocol/parse_header>. +Otherwise, a false value (C<undef> in scalar context and an empty list in list context). + +If C<read_header> reaches end-of-file before reading any octets, it returns a +false value. If unsuccessful, C<read_header> returns a false value and C<$!> +contains the error from the C<sysread> call. If C<read_header> encounters +end-of-file after some but not all of the needed octets, the function returns +a false value and sets C<$!> to C<EPIPE>. + +I<Implementation> + +The implementation calls C<sysread> in a loop, restarting if C<sysread> +returns C<undef> with C<$!> set to C<EINTR>. If C<sysread> does not provide +all the requested octets, C<read_header> continues to call C<sysread> until +either all the octets have been read, reaches end-of-file or an error occurs. + +=head2 read_record + +Attempts to read a C<FCGI_Record> from file handle C<$fh>. + +I<Usage> + + ($type, $request_id, $content) + = read_record($fh); + + $record = read_record($fh); + say $record->{type}; + say $record->{request_id}; + +I<Arguments> + +=over 4 + +=item C<$fh> + +The file handle to read from. Must be a file handle with a file descriptor. +File handle mode should be set to binary. + +=back + +I<Returns> + +Upon successful completion, the return value of L<Net::FastCGI::Protocol/parse_record>. +Otherwise, a false value (C<undef> in scalar context and an empty list in list context). + +If C<read_record> reaches end-of-file before reading any octets, it returns a +false value. If unsuccessful, C<read_record> returns a false value and C<$!> +contains the error from the C<sysread> call. If C<read_record> encounters +end-of-file after some but not all of the needed octets, the function returns +a false value and sets C<$!> to C<EPIPE>. + +I<Implementation> + +The implementation calls C<sysread> in a loop, restarting if C<sysread> +returns C<undef> with C<$!> set to C<EINTR>. If C<sysread> does not provide +all the requested octets, C<read_record> continues to call C<sysread> until +either all the octets have been read, reaches end-of-file or an error occurs. + +=head2 write_header + +Attempts to write a C<FCGI_Header> to file handle C<$fh>. + +I<Usage> + + $result = write_header($fh, $type, $request_id, $content_length, $padding_length); + +I<Arguments> + +=over 4 + +=item C<$fh> + +The file handle to write to. Must be a file handle with a file descriptor. File handle +mode should be set to binary. + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content_length> + +An unsigned 16-bit integer. + +=item C<$padding_length> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$result> + +Upon successful completion, the number of octets actually written. Otherwise, +C<undef> and C<$!> contains the error from the C<syswrite> call. + +=back + +I<Implementation> + +The implementation calls C<syswrite> in a loop, restarting if C<syswrite> +returns C<undef> with C<$!> set to C<EINTR>. If C<syswrite> does not output +all the requested octets, C<write_header> continues to call C<syswrite> until +all the octets have been written or an error occurs. + +=head2 write_record + +Attempts to write a C<FCGI_Record> to file handle C<$fh>. + +I<Usage> + + $result = write_record($fh, $type, $request_id); + $result = write_record($fh, $type, $request_id, $content); + +I<Arguments> + +=over 4 + +=item C<$fh> + +The file handle to write to. Must be a file handle with a file descriptor. File handle +mode should be set to binary. + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content> (optional) + +A string of octets containing the content, cannot exceed 65535 octets in length. + +=back + +I<Returns> + +=over 4 + +=item C<$result> + +Upon successful completion, the number of octets actually written. Otherwise, +C<undef> and C<$!> contains the error from the C<syswrite> call. + +=back + +I<Implementation> + +The implementation calls C<syswrite> in a loop, restarting if C<syswrite> +returns C<undef> with C<$!> set to C<EINTR>. If C<syswrite> does not output +all the requested octets, C<write_record> continues to call C<syswrite> until +all the octets have been written or an error occurs. + +=head2 write_stream + +Attempts to write a C<FCGI_Record> stream to file handle C<$fh>. + +I<Usage> + + $result = write_stream($fh, $type, $request_id, $content); + $result = write_stream($fh, $type, $request_id, $content, $terminate); + +I<Arguments> + +=over 4 + +=item C<$fh> + +The file handle to write to. Must be a file handle with a file descriptor. File handle +mode should be set to binary. + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content> + +A string of octets containing the stream content. + +=item C<$terminate> (optional) + +A boolean indicating whether or not the stream should be terminated. +Defaults to false. + +=back + +I<Returns> + +=over 4 + +=item C<$result> + +Upon successful completion, the number of octets actually written. Otherwise, +C<undef> and C<$!> contains the error from the C<syswrite> call. + +=back + +I<Implementation> + +The implementation calls C<syswrite> in a loop, restarting if C<syswrite> +returns C<undef> with C<$!> set to C<EINTR>. If C<syswrite> does not output +all the requested octets, C<write_stream> continues to call C<syswrite> until +all the octets have been written or an error occurs. + +=head2 can_read + +Determines wheter or not the given file handle C<$fh> is ready for reading +within the given timeout C<$timeout>. + +I<Usage> + + $result = can_read($fh, $timeout); + +I<Arguments> + +=over 4 + +=item C<$fh> + +The file handle to test for readiness. Must be a file handle with a file descriptor. + +=item C<$timeout> + +Maximum interval to wait. Can be set to either a non-negative numeric value or +C<undef> for infinite wait. + +=back + +I<Returns> + +Upon successful completion, C<0> or C<1>. Otherwise, C<undef> and C<$!> contains +the C<select> error. + +I<Implementation> + +The implementation calls C<select> in a loop, restarting if C<select> returns +C<-1> with C<$!> set to C<EINTR> and C<$timeout> has not elapsed. + +=head2 can_write + +Determines wheter or not the given file handle C<$fh> is ready for writing +within the given timeout C<$timeout>. + +I<Usage> + + $result = can_write($fh, $timeout); + +I<Arguments> + +=over 4 + +=item C<$fh> + +The file handle to test for readiness. Must be a file handle with a file descriptor. + +=item C<$timeout> + +Maximum interval to wait. Can be set to either a non-negative numeric value or +C<undef> for infinite wait. + +=back + +I<Returns> + +Upon successful completion, C<0> or C<1>. Otherwise, C<undef> and C<$!> contains +the C<select> error. + +I<Implementation> + +The implementation calls C<select> in a loop, restarting if C<select> returns +C<-1> with C<$!> set to C<EINTR> and C<$timeout> has not elapsed. + +=head1 EXPORTS + +None by default. All functions can be exported using the C<:all> tag or individually. + +=head1 DIAGNOSTICS + +=over 4 + +=item B<(F)> Usage: %s + +Subroutine called with wrong number of arguments. + +=item B<(W Net::FastCGI::IO)> FastCGI: Could not read %s + +=item B<(W Net::FastCGI::IO)> FastCGI: Could not write %s + +=back + +=head1 SEE ALSO + +=over 4 + +=item FastCGI Specification Version 1.0 + +L<http://www.fastcgi.com/devkit/doc/fcgi-spec.html> + +=item The Common Gateway Interface (CGI) Version 1.1 + +L<http://tools.ietf.org/html/rfc3875> + +=item L<Net::FastCGI::Constant> + +=item L<Net::FastCGI::Protocol> + +=back + +=head1 AUTHOR + +Christian Hansen C<chansen@cpan.org> + +=head1 COPYRIGHT + +Copyright 2008-2010 by Christian Hansen. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol.pm b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol.pm new file mode 100644 index 00000000..0c4210e9 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol.pm @@ -0,0 +1,203 @@ +package Net::FastCGI::Protocol; + +use strict; +use warnings; + +use Carp qw[croak]; +use Net::FastCGI qw[]; +use Net::FastCGI::Constant qw[:type :common FCGI_KEEP_CONN]; + +BEGIN { + our $VERSION = '0.14'; + our @EXPORT_OK = qw[ build_begin_request + build_begin_request_body + build_begin_request_record + build_end_request + build_end_request_body + build_end_request_record + build_header + build_params + build_record + build_stream + build_unknown_type_body + build_unknown_type_record + check_params + parse_begin_request_body + parse_end_request_body + parse_header + parse_params + parse_record + parse_record_body + parse_unknown_type_body + get_record_length + get_type_name + get_role_name + get_protocol_status_name + is_known_type + is_management_type + is_discrete_type + is_stream_type ]; + + our %EXPORT_TAGS = ( all => \@EXPORT_OK ); + + my $use_pp = $ENV{NET_FASTCGI_PP} || $ENV{NET_FASTCGI_PROTOCOL_PP}; + + if (!$use_pp) { + eval { + require Net::FastCGI::Protocol::XS; + }; + $use_pp = !!$@; + } + + if ($use_pp) { + require Net::FastCGI::Protocol::PP; + Net::FastCGI::Protocol::PP->import(@EXPORT_OK); + } + else { + Net::FastCGI::Protocol::XS->import(@EXPORT_OK); + } + + # shared between XS and PP implementation + push @EXPORT_OK, 'dump_record', 'dump_record_body'; + + require Exporter; + *import = \&Exporter::import; +} + +our $DUMP_RECORD_MAX = 78; # undocumented +our $DUMP_RECORD_ALIGN = !!0; # undocumented + +my %ESCAPES = ( + "\a" => "\\a", + "\b" => "\\b", + "\t" => "\\t", + "\n" => "\\n", + "\f" => "\\f", + "\r" => "\\r", +); + +sub dump_record { + goto \&dump_record_body if (@_ == 2 || @_ == 3); # deprecated + @_ == 1 || croak(q/Usage: dump_record(octets)/); + + my $len = &get_record_length; + ($len && $len <= length $_[0] && vec($_[0], 0, 8) == FCGI_VERSION_1) + || return '{Malformed FCGI_Record}'; + + return dump_record_body(&parse_record); +} + +sub dump_record_body { + @_ == 2 || @_ == 3 || croak(q/Usage: dump_record_body(type, request_id [, content])/); + my ($type, $request_id) = @_; + + my $content_length = defined $_[2] ? length $_[2] : 0; + + my $max = $DUMP_RECORD_MAX > 0 ? $DUMP_RECORD_MAX : FCGI_MAX_CONTENT_LEN; + my $out = ''; + + if ( $type == FCGI_PARAMS + || $type == FCGI_GET_VALUES + || $type == FCGI_GET_VALUES_RESULT) { + if ($content_length == 0) { + $out = q[""]; + } + elsif (check_params($_[2])) { + my ($off, $klen, $vlen) = (0); + while ($off < $content_length) { + my $pos = $off; + for ($klen, $vlen) { + $_ = vec($_[2], $off, 8); + $_ = vec(substr($_[2], $off, 4), 0, 32) & 0x7FFF_FFFF + if $_ > 0x7F; + $off += $_ > 0x7F ? 4 : 1; + } + + my $head = substr($_[2], $pos, $off - $pos); + $head =~ s/(.)/sprintf('\\%.3o',ord($1))/egs; + $out .= $head; + + my $body = substr($_[2], $off, $klen + $vlen); + for ($body) { + s/([\\\"])/\\$1/g; + s/([\a\b\t\n\f\r])/$ESCAPES{$1}/g; + s/([^\x20-\x7E])/sprintf('\\x%.2X',ord($1))/eg; + } + $out .= $body; + $off += $klen + $vlen; + last if $off > $max; + } + substr($out, $max - 5) = ' ... ' + if length $out > $max; + $out = qq["$out"]; + } + else { + $out = 'Malformed FCGI_NameValuePair(s)'; + } + } + elsif ( $type == FCGI_BEGIN_REQUEST + || $type == FCGI_END_REQUEST + || $type == FCGI_UNKNOWN_TYPE) { + if ($content_length != 8) { + my $name = $type == FCGI_BEGIN_REQUEST ? 'FCGI_BeginRequestBody' + : $type == FCGI_END_REQUEST ? 'FCGI_EndRequestBody' + : 'FCGI_UnknownTypeBody'; + $out = sprintf '{Malformed %s (expected 8 octets got %d)}', $name, $content_length; + } + elsif ($type == FCGI_BEGIN_REQUEST) { + my ($role, $flags) = parse_begin_request_body($_[2]); + if ($flags != 0) { + my @set; + if ($flags & FCGI_KEEP_CONN) { + $flags &= ~FCGI_KEEP_CONN; + push @set, 'FCGI_KEEP_CONN'; + } + if ($flags) { + push @set, sprintf '0x%.2X', $flags; + } + $flags = join '|', @set; + } + $out = sprintf '{%s, %s}', get_role_name($role), $flags; + } + elsif($type == FCGI_END_REQUEST) { + my ($astatus, $pstatus) = parse_end_request_body($_[2]); + $out = sprintf '{%d, %s}', $astatus, get_protocol_status_name($pstatus); + } + else { + my $unknown_type = parse_unknown_type_body($_[2]); + $out = sprintf '{%s}', get_type_name($unknown_type); + } + } + elsif ($content_length) { + my $looks_like_binary = do { + my $count = () = $_[2] =~ /[\r\n\t\x20-\x7E]/g; + ($count / $content_length) < 0.7; + }; + $out = substr($_[2], 0, $max + 1); + for ($out) { + if ($looks_like_binary) { + s/(.)/sprintf('\\x%.2X',ord($1))/egs; + } + else { + s/([\\\"])/\\$1/g; + s/([\a\b\t\n\f\r])/$ESCAPES{$1}/g; + s/([^\x20-\x7E])/sprintf('\\x%.2X',ord($1))/eg; + } + } + substr($out, $max - 5) = ' ... ' + if length $out > $max; + $out = qq["$out"]; + } + else { + $out = q[""]; + } + + my $name = get_type_name($type); + my $width = 0; + $width = 27 - length $name # length("FCGI_GET_VALUES_RESULT") == 22 + if $DUMP_RECORD_ALIGN; # + length(0xFFFF) == 5 + return sprintf '{%s, %*d, %s}', $name, $width, $request_id, $out; +} + +1; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol.pod b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol.pod new file mode 100644 index 00000000..64f6a7e6 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol.pod @@ -0,0 +1,1227 @@ +=head1 NAME + +Net::FastCGI::Protocol - Provides functions to build and parse FastCGI messages. + +=head1 SYNOPSIS + + # FCGI_Header + $octets = build_header($type, $request_id, $content_length, $padding_length); + @values = parse_header($octets); + $header = parse_header($octets); + + # FCGI_BeginRequestBody + $octets = build_begin_request_body($role, $flags); + @values = parse_begin_request_body($octets); + + # FCGI_EndRequestBody + $octets = build_end_request_body($app_status, $protocol_status); + @values = parse_end_request_body($octets); + + # FCGI_UnknownTypeBody + $octets = build_unknown_type_body($type); + @values = parse_unknown_type_body($octets); + + # FCGI_BeginRequestRecord + $octets = build_begin_request_record($request_id, $role, $flags); + + # FCGI_EndRequestRecord + $octets = build_end_request_record($request_id, $app_status, $protocol_status); + + # FCGI_UnknownTypeRecord + $octets = build_unknown_type_record($type); + + # FCGI_NameValuePair's + $octets = build_params($params); + $params = parse_params($octets); + $bool = check_params($octets); + + # FCGI_Record + $octets = build_record($type, $request_id); + $octets = build_record($type, $request_id, $content); + @values = parse_record($octets); + $record = parse_record($octets); + $record = parse_record_body($type, $request_id, $content); + + # FCGI_Record Debugging / Tracing + $string = dump_record($octets); + $string = dump_record_body($type, $request_id, $content); + + # FCGI_Record Stream + $octets = build_stream($type, $request_id, $content); + $octets = build_stream($type, $request_id, $content, $terminate); + + # Begin Request + $octets = build_begin_request($request_id, $role, $flags, $params); + $octets = build_begin_request($request_id, $role, $flags, $params, $stdin); + $octets = build_begin_request($request_id, $role, $flags, $params, $stdin, $data); + + # End Request + $octets = build_end_request($request_id, $app_status, $protocol_status); + $octets = build_end_request($request_id, $app_status, $protocol_status, $stdout); + $octets = build_end_request($request_id, $app_status, $protocol_status, $stdout, $stderr); + +=head1 DESCRIPTION + +Provides functions to build and parse FastCGI messages. + +=head1 FUNCTIONS + +Please note that all functions in this package expects octets, not unicode strings. +It's the callers responsibility to ensure this. If any of theese functions is called +with unicode strings containing code points above 255, they will most likely produce +malformed messages. + +=head2 build_begin_request + +Builds a Begin Request message. + +I<Usage> + + $octets = build_begin_request($request_id, $role, $flags, $params); + $octets = build_begin_request($request_id, $role, $flags, $params, $stdin); + $octets = build_begin_request($request_id, $role, $flags, $params, $stdin, $data); + +I<Arguments> + +=over 4 + +=item C<$request_id> + +An unsigned 16-bit integer. Identifier of the request. + +=item C<$role> + +An unsigned 16-bit integer. This should be set to either C<FCGI_RESPONDER>, +C<FCGI_AUTHORIZER> or C<FCGI_FILTER>. + +=item C<$flags> + +An unsigned 8-bit integer. This should be set to either C<0> or contain the +mask C<FCGI_KEEP_CONN> if a persistent connection is desired. + +=item C<$params> + +A hash reference containing name-value pairs. This is the CGI environ that the +application expects. + +=item C<$stdin> (optional) + +A string of octets containing the C<FCGI_STDIN> content. This should only be +provided if C<$role> is set to either C<FCGI_RESPONDER> or C<FCGI_FILTER>. The +C<FCGI_STDIN> stream is terminated if provided. + +=item C<$data> (optional) + +A string of octets containing the C<FCGI_DATA> content. This should only be +provided if C<$role> is set to C<FCGI_FILTER>. The C<FCGI_DATA> stream is +terminated if provided. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the message. + +=back + +=head2 build_begin_request_body + +Builds a C<FCGI_BeginRequestBody>. + +I<Usage> + + $octets = build_begin_request_body($role, $flags); + +I<Arguments> + +=over 4 + +=item C<$role> + +An unsigned 16-bit integer. + +=item C<$flags> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the body. String is 8 octets in length. + +=back + +=head2 build_begin_request_record + +Builds a C<FCGI_BeginRequestRecord>. + +I<Usage> + + $octets = build_begin_request_record($request_id, $role, $flags); + +I<Arguments> + +=over 4 + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$role> + +An unsigned 16-bit integer. + +=item C<$flags> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the record. String is 16 octets in length. + +=back + +=head2 build_end_request + +Builds a End Request message + +I<Usage> + + $octets = build_end_request($request_id, $app_status, $protocol_status); + $octets = build_end_request($request_id, $app_status, $protocol_status, $stdout); + $octets = build_end_request($request_id, $app_status, $protocol_status, $stdout, $stderr); + +I<Arguments> + +=over 4 + +=item C<$request_id> + +An unsigned 16-bit integer. Identifier of the request. + +=item C<$app_status> + +An unsigned 32-bit integer. Application status code of the request. + +=item C<$protocol_status> + +An unsigned 8-bit integer. This should be set to either C<FCGI_REQUEST_COMPLETE>, +C<FCGI_CANT_MPX_CONN>, C<FCGI_OVERLOADED> or C<FCGI_UNKNOWN_ROLE>. + +=item C<$stdout> (optional) + +A string of octets containing the C<FCGI_STDOUT> content. The C<FCGI_STDOUT> +stream is terminated if provided. + +=item C<$stderr> (optional) + +A string of octets containing the C<FCGI_STDERR> content. The C<FCGI_STDERR> +stream is terminated if provided. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the message. + +=back + +I<Note> + +This function is equivalent to C<build_end_request_record()> if called without +C<$stdout> and C<$stderr>. + +=head2 build_end_request_body + +Builds a C<FCGI_EndRequestBody>. + +I<Usage> + + $octets = build_end_request_body($app_status, $protocol_status); + +I<Arguments> + +=over 4 + +=item C<$app_status> + +An unsigned 32-bit integer. + +=item C<$protocol_status> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the body. String is 8 octets in length. + +=back + +=head2 build_end_request_record + +Builds a C<FCGI_EndRequestRecord>. + +I<Usage> + + $octets = build_end_request_record($request_id, $app_status, $protocol_status); + +I<Arguments> + +=over 4 + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$app_status> + +An unsigned 32-bit integer. + +=item C<$protocol_status> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the record. String is 16 octets in length. + +=back + +=head2 build_header + +Builds a C<FCGI_Header>. + +I<Usage> + + $octets = build_header($type, $request_id, $content_length, $padding_length); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content_length> + +An unsigned 16-bit integer. + +=item C<$padding_length> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the header. String is 8 octets in length. + +=back + +=head2 build_params + +Builds C<FCGI_NameValuePair>'s. + +I<Usage> + + $octets = build_params($params); + +I<Arguments> + +=over 4 + +=item C<$params> + +A hash reference containing name-value pairs. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +=back + +=head2 build_record + +Builds a C<FCGI_Record>. + +I<Usage> + + $octets = build_record($type, $request_id); + $octets = build_record($type, $request_id, $content); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content> (optional) + +A string of octets containing the content, cannot exceed 65535 octets in length. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the record. + +=back + +I<Note> + +Follows the recommendation in specification and pads the record by +8-(content_length mod 8) zero-octets. + +=head2 build_stream + +Builds a series of stream records. + +I<Usage> + + $octets = build_stream($type, $request_id, $content); + $octets = build_stream($type, $request_id, $content, $terminate); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content> + +A string of octets containing the stream content. + +=item C<$terminate> (optional) + +A boolean indicating whether or not the stream should be terminated. +Defaults to false. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the stream. + +=back + +I<Note> + +Stream is not terminated if C<$content> is empty unless C<$terminate> is set. + +C<$content> is split in segment sizes of 32760 octets (32768 - FCGI_HEADER_LEN). + +=head2 build_unknown_type_body + +Builds a C<FCGI_UnknownTypeBody>. + +I<Usage> + + $octets = build_unknown_type_body($type); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the body. String is 8 octets in length. + +=back + +=head2 build_unknown_type_record + +Builds a C<FCGI_UnknownTypRecord>. + +I<Usage> + + $octets = build_unknown_type_record($type); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$octets> + +A string of octets containing the record. String is 16 octets in length. + +=back + +=head2 check_params + +Determine wheter or not params is well-formed. + +I<Usage> + + $boolean = check_params($octets); + +I<Arguments> + +=over 4 + +=item C<$octets> + +A string of octets containing C<FCGI_NameValuePair>'s. + +=back + +I<Returns> + +=over 4 + +=item C<$boolean> + +A boolean indicating whether or not C<$octets> consist of well-formed C<FCGI_NameValuePair>'s. + +=back + +=head2 dump_record + +Dump a C<FCGI_Record>. + +I<Usage> + + $string = dump_record($octets); + +I<Arguments> + +=over 4 + +=item C<$octets> + +A string of octets containing at least one record. + +=back + +I<Returns> + +=over 4 + +=item C<$string> + +A short (less than 100 characters) string representation of the record in printable US-ASCII. + +=back + +=head2 dump_record_body + +Dump a C<FCGI_Record>. + +I<Usage> + + $string = dump_record_body($type, $request_id); + $string = dump_record_body($type, $request_id, $content); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content> (optional) + +A string of octets containing the content. + +=back + +I<Returns> + +=over 4 + +=item C<$string> + +A short (less than 100 characters) string representation of the record in printable US-ASCII. + +=back + +=head2 parse_begin_request_body + +Parses a C<FCGI_BeginRequestBody>. + +I<Usage> + + ($role, $flags) = parse_begin_request_body($octets); + +I<Arguments> + +=over 4 + +=item C<$octets> + +A string of octets containing the body, must be greater than or equal to 8 octets in length. + +=back + +I<Returns> + +=over 4 + +=item C<$role> + +An unsigned 16-bit integer. + +=item C<$flags> + +An unsigned 8-bit integer. + +=back + +=head2 parse_end_request_body + +Parses a C<FCGI_EndRequestBody>. + +I<Usage> + + ($app_status, $protocol_status) = parse_end_request_body($octets); + +I<Arguments> + +=over 4 + +=item C<$octets> + +A string of octets containing the body, must be greater than or equal to 8 octets in length. + +=back + +I<Returns> + +=over 4 + +=item C<$app_status> + +An unsigned 32-bit integer. + +=item C<$flags> + +An unsigned 8-bit integer. + +=back + +=head2 parse_header + +Parses a C<FCGI_Header>. + +I<Usage> + + ($type, $request_id, $content_length, $padding_length) + = parse_header($octets); + + $header = parse_header($octets); + say $header->{type}; + say $header->{request_id}; + say $header->{content_length}; + say $header->{padding_length}; + +I<Arguments> + +=over 4 + +=item C<$octets> + +A string of octets containing the header, must be greater than or equal to 8 octets in length. + +=back + +I<Returns> + +In list context: + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content_length> + +An unsigned 16-bit integer. + +=item C<$padding_length> + +An unsigned 8-bit integer. + +=back + +In scalar context a hash reference containing above variable names as keys. + +=head2 parse_params + +Parses C<FCGI_NameValuePair>'s. + +I<Usage> + + $params = parse_params($octets); + +I<Arguments> + +=over 4 + +=item C<$octets> + +A string of octets containing C<FCGI_NameValuePair>'s. + +=back + +I<Returns> + +=over 4 + +=item C<$params> + +A hash reference containing name-value pairs. + +=back + +=head2 parse_record + +Parses a C<FCGI_Record>. + +I<Usage> + + ($type, $request_id, $content) + = parse_record($octets); + + $record = parse_record($octets); + say $record->{type}; + say $record->{request_id}; + +I<Arguments> + +=over 4 + +=item C<$octets> + +A string of octets containing at least one record. + +=back + +I<Returns> + +In list context: + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content> + +A string of octets containing the record content. + +=back + +In scalar context a hash reference containing the C<FCGI_Record> components. +See L</parse_record_body>. + +=head2 parse_record_body + +Parses a C<FCGI_Record>. + +I<Usage> + + $record = parse_record_body($type, $request_id, $content); + say $record->{type}; + say $record->{request_id}; + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=item C<$request_id> + +An unsigned 16-bit integer. + +=item C<$content> + +A string of octets containing the record content. + +=back + +I<Returns> + +A hash reference which represents the C<FCGI_Record>. The content depends on the +type of record. All record types have the keys: C<type> and C<request_id>. + +=over 4 + +=item C<FCGI_BEGIN_REQUEST> + +=over 8 + +=item C<role> + +An unsigned 16-bit integer. + +=item C<flags> + +An unsigned 8-bit integer. + +=back + +=item C<FCGI_END_REQUEST> + +=over 8 + +=item C<app_status> + +An unsigned 32-bit integer. + +=item C<protocol_status> + +An unsigned 8-bit integer. + +=back + +=item C<FCGI_PARAMS> + +=item C<FCGI_STDIN> + +=item C<FCGI_DATA> + +=item C<FCGI_STDOUT> + +=item C<FCGI_STDERR> + +=over 8 + +=item C<content> + +A string of octets containing the content of the stream. + +=back + +=item C<FCGI_GET_VALUES> + +=item C<FCGI_GET_VALUES_RESULT> + +=over 8 + +=item C<values> + +A hash reference containing name-value pairs. + +=back + +=item C<FCGI_UNKNOWN_TYPE> + +=over 8 + +=item C<unknown_type> + +An unsigned 8-bit integer. + +=back + +=back + +=head2 parse_unknown_type_body + +Parses a C<FCGI_UnknownTypeBody>. + +I<Usage> + + $type = parse_unknown_type_body($octets); + +I<Arguments> + +=over 4 + +=item C<$octets> + +C<$octets> must be greater than or equal to 8 octets in length. + +=back + +I<Returns> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=back + +=head2 get_record_length + +I<Usage> + + $length = get_record_length($octets); + +I<Arguments> + +=over 4 + +=item C<$octets> + +A string of octets containing at least one C<FCGI_Header>. + +=back + +I<Returns> + +=over 4 + +=item C<$length> + +An unsigned integer containing the length of record in octets. If C<$octets> +contains insufficient octets C<(< FCGI_HEADER_LEN)> C<0> is returned. + +=back + +=head2 get_type_name + +I<Usage> + + $name = get_type_name($type); + $name = get_type_name(FCGI_BEGIN_REQUEST); # 'FCGI_BEGIN_REQUEST' + $name = get_type_name(255); # '0xFF' + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$name> + +A string containing the name of the type. If C<$type> is not a known v1.0 type, +a hexadecimal value is returned. + +=back + +I<Note> + +See also L<Net::FastCGI::Constant/":name">. + +=head2 get_role_name + +I<Usage> + + $name = get_role_name($type); + $name = get_role_name(FCGI_RESPONDER); # 'FCGI_RESPONDER' + $name = get_role_name(65535); # '0xFFFF' + +I<Arguments> + +=over 4 + +=item C<$role> + +An unsigned 16-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$name> + +A string containing the name of the role. If C<$role> is not a known v1.0 role, +a hexadecimal value is returned. + +=back + +I<Note> + +See also L<Net::FastCGI::Constant/":name">. + +=head2 get_protocol_status_name + +I<Usage> + + $name = get_protocol_status_name($protocol_status); + $name = get_protocol_status_name(FCGI_REQUEST_COMPLETE); # 'FCGI_REQUEST_COMPLETE' + $name = get_protocol_status_name(255); # '0xFF' + +I<Arguments> + +=over 4 + +=item C<$protocol_status> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$name> + +A string containing the name of the protocol status. If C<$protocol_status> is +not a known v1.0 protocol status code, a hexadecimal value is returned. + +=back + +I<Note> + +See also L<Net::FastCGI::Constant/:name>. + +=head2 is_known_type + +I<Usage> + + $boolean = is_known_type($type); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$boolean> + +A boolean indicating whether or not C<$type> is a known FastCGI v1.0 type. + +=back + +=head2 is_management_type + +I<Usage> + + $boolean = is_management_type($type); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$boolean> + +A boolean indicating whether or not C<$type> is a management type. + +=back + +=head2 is_discrete_type + +I<Usage> + + $boolean = is_discrete_type($type); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$boolean> + +A boolean indicating whether or not C<$type> is a discrete type. + +=back + +=head2 is_stream_type + +I<Usage> + + $boolean = is_stream_type($type); + +I<Arguments> + +=over 4 + +=item C<$type> + +An unsigned 8-bit integer. + +=back + +I<Returns> + +=over 4 + +=item C<$boolean> + +A boolean indicating whether or not C<$type> is a stream type. + +=back + +=head1 EXPORTS + +None by default. All functions can be exported using the C<:all> tag or individually. + +=head1 DIAGNOSTICS + +=over 4 + +=item B<(F)> Usage: %s + +Subroutine called with wrong number of arguments. + +=item B<(F)> Invalid Argument: %s + +=item B<(F)> FastCGI: Insufficient number of octets to parse %s + +=item B<(F)> FastCGI: Malformed record %s + +=item B<(F)> FastCGI: Protocol version mismatch (0x%.2X) + +=back + +=head1 SEE ALSO + +=over 4 + +=item FastCGI Specification Version 1.0 + +L<http://www.fastcgi.com/devkit/doc/fcgi-spec.html> + +=item The Common Gateway Interface (CGI) Version 1.1 + +L<http://tools.ietf.org/html/rfc3875> + +=item L<Net::FastCGI::Constant> + + +=back + +=head1 AUTHOR + +Christian Hansen C<chansen@cpan.org> + +=head1 COPYRIGHT + +Copyright 2008-2010 by Christian Hansen. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol/PP.pm b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol/PP.pm new file mode 100644 index 00000000..bfba2579 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/lib/Net/FastCGI/Protocol/PP.pm @@ -0,0 +1,429 @@ +package Net::FastCGI::Protocol::PP; +use strict; +use warnings; + +use Carp qw[]; +use Net::FastCGI::Constant qw[:all]; + +BEGIN { + our $VERSION = '0.14'; + our @EXPORT_OK = qw[ build_begin_request + build_begin_request_body + build_begin_request_record + build_end_request + build_end_request_body + build_end_request_record + build_header + build_params + build_record + build_stream + build_unknown_type_body + build_unknown_type_record + check_params + parse_begin_request_body + parse_end_request_body + parse_header + parse_params + parse_record + parse_record_body + parse_unknown_type_body + is_known_type + is_management_type + is_discrete_type + is_stream_type + get_record_length + get_role_name + get_type_name + get_protocol_status_name ]; + + our %EXPORT_TAGS = ( all => \@EXPORT_OK ); + + require Exporter; + *import = \&Exporter::import; +} + +sub TRUE () { !!1 } +sub FALSE () { !!0 } + +sub ERRMSG_OCTETS () { q/FastCGI: Insufficient number of octets to parse %s/ } +sub ERRMSG_MALFORMED () { q/FastCGI: Malformed record %s/ } +sub ERRMSG_VERSION () { q/FastCGI: Protocol version mismatch (0x%.2X)/ } +sub ERRMSG_OCTETS_LE () { q/Invalid Argument: '%s' cannot exceed %u octets in length/ } + +sub throw { + @_ = ( sprintf($_[0], @_[1..$#_]) ) if @_ > 1; + goto \&Carp::croak; +} + +# FCGI_Header + +sub build_header { + @_ == 4 || throw(q/Usage: build_header(type, request_id, content_length, padding_length)/); + return pack(FCGI_Header, FCGI_VERSION_1, @_); +} + +sub parse_header { + @_ == 1 || throw(q/Usage: parse_header(octets)/); + (defined $_[0] && length $_[0] >= 8) + || throw(ERRMSG_OCTETS, q/FCGI_Header/); + (vec($_[0], 0, 8) == FCGI_VERSION_1) + || throw(ERRMSG_VERSION, unpack('C', $_[0])); + return unpack('xCnnCx', $_[0]) + if wantarray; + my %header; + @header{qw(type request_id content_length padding_length)} + = unpack('xCnnCx', $_[0]); + return \%header; +} + +# FCGI_BeginRequestBody + +sub build_begin_request_body { + @_ == 2 || throw(q/Usage: build_begin_request_body(role, flags)/); + return pack(FCGI_BeginRequestBody, @_); +} + +sub parse_begin_request_body { + @_ == 1 || throw(q/Usage: parse_begin_request_body(octets)/); + (defined $_[0] && length $_[0] >= 8) + || throw(ERRMSG_OCTETS, q/FCGI_BeginRequestBody/); + return unpack(FCGI_BeginRequestBody, $_[0]); +} + +# FCGI_EndRequestBody + +sub build_end_request_body { + @_ == 2 || throw(q/Usage: build_end_request_body(app_status, protocol_status)/); + return pack(FCGI_EndRequestBody, @_); +} + +sub parse_end_request_body { + @_ == 1 || throw(q/Usage: parse_end_request_body(octets)/); + (defined $_[0] && length $_[0] >= 8) + || throw(ERRMSG_OCTETS, q/FCGI_EndRequestBody/); + return unpack(FCGI_EndRequestBody, $_[0]); +} + +# FCGI_UnknownTypeBody + +sub build_unknown_type_body { + @_ == 1 || throw(q/Usage: build_unknown_type_body(type)/); + return pack(FCGI_UnknownTypeBody, @_); +} + +sub parse_unknown_type_body { + @_ == 1 || throw(q/Usage: parse_unknown_type_body(octets)/); + (defined $_[0] && length $_[0] >= 8) + || throw(ERRMSG_OCTETS, q/FCGI_UnknownTypeBody/); + return unpack(FCGI_UnknownTypeBody, $_[0]); +} + +# FCGI_BeginRequestRecord + +sub build_begin_request_record { + @_ == 3 || throw(q/Usage: build_begin_request_record(request_id, role, flags)/); + my ($request_id, $role, $flags) = @_; + return build_record(FCGI_BEGIN_REQUEST, $request_id, + build_begin_request_body($role, $flags)); +} + +# FCGI_EndRequestRecord + +sub build_end_request_record { + @_ == 3 || throw(q/Usage: build_end_request_record(request_id, app_status, protocol_status)/); + my ($request_id, $app_status, $protocol_status) = @_; + return build_record(FCGI_END_REQUEST, $request_id, + build_end_request_body($app_status, $protocol_status)); +} + +# FCGI_UnknownTypeRecord + +sub build_unknown_type_record { + @_ == 1 || throw(q/Usage: build_unknown_type_record(type)/); + my ($type) = @_; + return build_record(FCGI_UNKNOWN_TYPE, FCGI_NULL_REQUEST_ID, + build_unknown_type_body($type)); +} + +sub build_record { + @_ == 2 || @_ == 3 || throw(q/Usage: build_record(type, request_id [, content])/); + my ($type, $request_id) = @_; + + my $content_length = defined $_[2] ? length $_[2] : 0; + my $padding_length = (8 - ($content_length % 8)) % 8; + + ($content_length <= FCGI_MAX_CONTENT_LEN) + || throw(ERRMSG_OCTETS_LE, q/content/, FCGI_MAX_CONTENT_LEN); + + my $res = build_header($type, $request_id, $content_length, $padding_length); + + if ($content_length) { + $res .= $_[2]; + } + + if ($padding_length) { + $res .= "\x00" x $padding_length; + } + + return $res; +} + +sub parse_record { + @_ == 1 || throw(q/Usage: parse_record(octets)/); + my ($type, $request_id, $content_length) = &parse_header; + + (length $_[0] >= FCGI_HEADER_LEN + $content_length) + || throw(ERRMSG_OCTETS, q/FCGI_Record/); + + return wantarray + ? ($type, $request_id, substr($_[0], FCGI_HEADER_LEN, $content_length)) + : parse_record_body($type, $request_id, + substr($_[0], FCGI_HEADER_LEN, $content_length)); +} + +sub parse_record_body { + @_ == 3 || throw(q/Usage: parse_record_body(type, request_id, content)/); + my ($type, $request_id) = @_; + + my $content_length = defined $_[2] ? length $_[2] : 0; + + ($content_length <= FCGI_MAX_CONTENT_LEN) + || throw(ERRMSG_OCTETS_LE, q/content/, FCGI_MAX_CONTENT_LEN); + + my %record = (type => $type, request_id => $request_id); + if ($type == FCGI_BEGIN_REQUEST) { + ($request_id != FCGI_NULL_REQUEST_ID && $content_length == 8) + || throw(ERRMSG_MALFORMED, q/FCGI_BeginRequestRecord/); + @record{ qw(role flags) } = parse_begin_request_body($_[2]); + } + elsif ($type == FCGI_ABORT_REQUEST) { + ($request_id != FCGI_NULL_REQUEST_ID && $content_length == 0) + || throw(ERRMSG_MALFORMED, q/FCGI_AbortRequestRecord/); + } + elsif ($type == FCGI_END_REQUEST) { + ($request_id != FCGI_NULL_REQUEST_ID && $content_length == 8) + || throw(ERRMSG_MALFORMED, q/FCGI_EndRequestRecord/); + @record{ qw(app_status protocol_status) } + = parse_end_request_body($_[2]); + } + elsif ( $type == FCGI_PARAMS + || $type == FCGI_STDIN + || $type == FCGI_STDOUT + || $type == FCGI_STDERR + || $type == FCGI_DATA) { + ($request_id != FCGI_NULL_REQUEST_ID) + || throw(ERRMSG_MALFORMED, $FCGI_RECORD_NAME[$type]); + $record{content} = $content_length ? $_[2] : ''; + } + elsif ( $type == FCGI_GET_VALUES + || $type == FCGI_GET_VALUES_RESULT) { + ($request_id == FCGI_NULL_REQUEST_ID) + || throw(ERRMSG_MALFORMED, $FCGI_RECORD_NAME[$type]); + $record{values} = parse_params($_[2]); + } + elsif ($type == FCGI_UNKNOWN_TYPE) { + ($request_id == FCGI_NULL_REQUEST_ID && $content_length == 8) + || throw(ERRMSG_MALFORMED, q/FCGI_UnknownTypeRecord/); + $record{unknown_type} = parse_unknown_type_body($_[2]); + } + else { + # unknown record type, pass content so caller can decide appropriate action + $record{content} = $_[2] if $content_length; + } + + return \%record; +} + +# Reference implementation use 8192 (libfcgi) +sub FCGI_SEGMENT_LEN () { 32768 - FCGI_HEADER_LEN } + +sub build_stream { + @_ == 3 || @_ == 4 || throw(q/Usage: build_stream(type, request_id, content [, terminate])/); + my ($type, $request_id, undef, $terminate) = @_; + + my $len = defined $_[2] ? length $_[2] : 0; + my $res = ''; + + if ($len) { + if ($len < FCGI_SEGMENT_LEN) { + $res = build_record($type, $request_id, $_[2]); + } + else { + my $header = build_header($type, $request_id, FCGI_SEGMENT_LEN, 0); + my $off = 0; + while ($len >= FCGI_SEGMENT_LEN) { + $res .= $header; + $res .= substr($_[2], $off, FCGI_SEGMENT_LEN); + $len -= FCGI_SEGMENT_LEN; + $off += FCGI_SEGMENT_LEN; + } + if ($len) { + $res .= build_record($type, $request_id, substr($_[2], $off, $len)); + } + } + } + + if ($terminate) { + $res .= build_header($type, $request_id, 0, 0); + } + + return $res; +} + +sub build_params { + @_ == 1 || throw(q/Usage: build_params(params)/); + my ($params) = @_; + my $res = ''; + while (my ($key, $val) = each(%$params)) { + for ($key, $val) { + my $len = defined $_ ? length : 0; + $res .= $len < 0x80 ? pack('C', $len) : pack('N', $len | 0x8000_0000); + } + $res .= $key; + $res .= $val if defined $val; + } + return $res; +} + +sub parse_params { + @_ == 1 || throw(q/Usage: parse_params(octets)/); + my ($octets) = @_; + + (defined $octets) + || return +{}; + + my ($params, $klen, $vlen) = ({}, 0, 0); + while (length $octets) { + for ($klen, $vlen) { + (1 <= length $octets) + || throw(ERRMSG_OCTETS, q/FCGI_NameValuePair/); + $_ = vec(substr($octets, 0, 1, ''), 0, 8); + next if $_ < 0x80; + (3 <= length $octets) + || throw(ERRMSG_OCTETS, q/FCGI_NameValuePair/); + $_ = vec(pack('C', $_ & 0x7F) . substr($octets, 0, 3, ''), 0, 32); + } + ($klen + $vlen <= length $octets) + || throw(ERRMSG_OCTETS, q/FCGI_NameValuePair/); + my $key = substr($octets, 0, $klen, ''); + $params->{$key} = substr($octets, 0, $vlen, ''); + } + return $params; +} + +sub check_params { + @_ == 1 || throw(q/Usage: check_params(octets)/); + (defined $_[0]) + || return FALSE; + + my ($len, $off, $klen, $vlen) = (length $_[0], 0, 0, 0); + while ($off < $len) { + for ($klen, $vlen) { + (($off += 1) <= $len) + || return FALSE; + $_ = vec($_[0], $off - 1, 8); + next if $_ < 0x80; + (($off += 3) <= $len) + || return FALSE; + $_ = vec(substr($_[0], $off - 4, 4), 0, 32) & 0x7FFF_FFFF; + } + (($off += $klen + $vlen) <= $len) + || return FALSE; + } + return TRUE; +} + +sub build_begin_request { + (@_ >= 4 && @_ <= 6) || throw(q/Usage: build_begin_request(request_id, role, flags, params [, stdin [, data]])/); + my ($request_id, $role, $flags, $params) = @_; + + my $r = build_begin_request_record($request_id, $role, $flags) + . build_stream(FCGI_PARAMS, $request_id, build_params($params), TRUE); + + if (@_ > 4) { + $r .= build_stream(FCGI_STDIN, $request_id, $_[4], TRUE); + if (@_ > 5) { + $r .= build_stream(FCGI_DATA, $request_id, $_[5], TRUE); + } + } + return $r; +} + +sub build_end_request { + (@_ >= 3 && @_ <= 5) || throw(q/Usage: build_end_request(request_id, app_status, protocol_status [, stdout [, stderr]])/); + my ($request_id, $app_status, $protocol_status) = @_; + + my $r; + if (@_ > 3) { + $r .= build_stream(FCGI_STDOUT, $request_id, $_[3], TRUE); + if (@_ > 4) { + $r .= build_stream(FCGI_STDERR, $request_id, $_[4], TRUE); + } + } + $r .= build_end_request_record($request_id, $app_status, $protocol_status); + return $r; +} + +sub get_record_length { + @_ == 1 || throw(q/Usage: get_record_length(octets)/); + (defined $_[0] && length $_[0] >= FCGI_HEADER_LEN) + || return 0; + return FCGI_HEADER_LEN + vec($_[0], 2, 16) # contentLength + + vec($_[0], 6, 8); # paddingLength +} + +sub is_known_type { + @_ == 1 || throw(q/Usage: is_known_type(type)/); + my ($type) = @_; + return ($type > 0 && $type <= FCGI_MAXTYPE); +} + +sub is_discrete_type { + @_ == 1 || throw(q/Usage: is_discrete_type(type)/); + my ($type) = @_; + return ( $type == FCGI_BEGIN_REQUEST + || $type == FCGI_ABORT_REQUEST + || $type == FCGI_END_REQUEST + || $type == FCGI_GET_VALUES + || $type == FCGI_GET_VALUES_RESULT + || $type == FCGI_UNKNOWN_TYPE ); +} + +sub is_management_type { + @_ == 1 || throw(q/Usage: is_management_type(type)/); + my ($type) = @_; + return ( $type == FCGI_GET_VALUES + || $type == FCGI_GET_VALUES_RESULT + || $type == FCGI_UNKNOWN_TYPE ); +} + +sub is_stream_type { + @_ == 1 || throw(q/Usage: is_stream_type(type)/); + my ($type) = @_; + return ( $type == FCGI_PARAMS + || $type == FCGI_STDIN + || $type == FCGI_STDOUT + || $type == FCGI_STDERR + || $type == FCGI_DATA ); +} + +sub get_type_name { + @_ == 1 || throw(q/Usage: get_type_name(type)/); + my ($type) = @_; + return $FCGI_TYPE_NAME[$type] || sprintf('0x%.2X', $type); +} + +sub get_role_name { + @_ == 1 || throw(q/Usage: get_role_name(role)/); + my ($role) = @_; + return $FCGI_ROLE_NAME[$role] || sprintf('0x%.4X', $role); +} + +sub get_protocol_status_name { + @_ == 1 || throw(q/Usage: get_protocol_status_name(protocol_status)/); + my ($status) = @_; + return $FCGI_PROTOCOL_STATUS_NAME[$status] || sprintf('0x%.2X', $status); +} + +1; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/000_load.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/000_load.t new file mode 100644 index 00000000..1436a558 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/000_load.t @@ -0,0 +1,29 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 5; + +BEGIN { + use_ok('Net::FastCGI'); + use_ok('Net::FastCGI::Constant'); + use_ok('Net::FastCGI::IO'); + use_ok('Net::FastCGI::Protocol'); + + if ( $ENV{NET_FASTCGI_PP} ) { + use_ok('Net::FastCGI::Protocol::PP'); + } + else { + use_ok('Net::FastCGI::Protocol::XS'); + } +} + +diag("Net::FastCGI $Net::FastCGI::VERSION, Perl $], $^X"); +diag("NET_FASTCGI_PP=$ENV{NET_FASTCGI_PP}"); + + + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/001_header.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/001_header.t new file mode 100644 index 00000000..8e1476b5 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/001_header.t @@ -0,0 +1,51 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 13; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_header + parse_header ]); +} + +my @tests = ( + # octets type request_id content_length padding_length + ["\x01\x00\x00\x00\x00\x00\x00\x00", 0, 0, 0, 0 ], + ["\x01\xFF\xFF\xFF\xFF\xFF\xFF\x00", 0xFF, 0xFFFF, 0xFFFF, 0xFF ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_header(@$test[1..4]); + is_hexstr($got, $expected, 'build_header()'); +} + +foreach my $test (@tests) { + my @expected = @$test[1..4]; + my @got = parse_header($test->[0]); + is_deeply(\@got, \@expected, "parse_header() in list context"); +} + +my @components = qw(type request_id content_length padding_length); +foreach my $test (@tests) { + my $expected; @$expected{@components} = @$test[1..4]; + my $got = parse_header($test->[0]); + is_deeply($got, $expected, "parse_header() in scalar context"); +} + + +throws_ok { parse_header("") } qr/FastCGI: Insufficient .* FCGI_Header/; +throws_ok { parse_header(undef) } qr/FastCGI: Insufficient .* FCGI_Header/; +throws_ok { parse_header("\x00\x00\x00\x00\x00\x00\x00\x00") } qr/^FastCGI: Protocol version mismatch/; +throws_ok { parse_header("\xFF\x00\x00\x00\x00\x00\x00\x00") } qr/^FastCGI: Protocol version mismatch/; + +throws_ok { build_header() } qr/^Usage: /; +throws_ok { parse_header() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/005_record_length.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/005_record_length.t new file mode 100644 index 00000000..1d238198 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/005_record_length.t @@ -0,0 +1,44 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 18; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Constant', qw[:all]); + use_ok('Net::FastCGI::Protocol', qw[ build_header + build_record + get_record_length ]); +} + + +is get_record_length(undef), 0, 'get_record_length(undef)'; + +{ + for my $len (0..7) { + is get_record_length("\x00" x $len), 0, qq<get_record_length("\\x00" x $len)>; + } +} + +{ + for my $len (8, 16, 32, 64) { + my $record = build_record(0, 0, "\x00" x $len); + is get_record_length($record), FCGI_HEADER_LEN + $len; + } +} + +{ + my $header = build_header(0, 0, 8192, 250); + is get_record_length($header), FCGI_HEADER_LEN + 8192 + 250; +} + +# get_record_length(octets) +for (0, 2) { + throws_ok { get_record_length((1) x $_) } qr/^Usage: /; +} + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/010_build_record.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/010_build_record.t new file mode 100644 index 00000000..9f321261 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/010_build_record.t @@ -0,0 +1,44 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 11; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_record ]); +} + +my @tests = ( + # octets type request_id content + [ "\x01\x00\x00\x00\x00\x00\x00\x00", 0, 0, undef ], + [ "\x01\xFF\xFF\xFF\x00\x00\x00\x00", 0xFF, 0xFFFF, undef ], + [ "\x01\x01\x00\x01\x00\x01\x07\x00\x01\x00\x00\x00\x00\x00\x00\x00", 1, 1, "\x01" ], + [ "\x01\x01\x00\x01\x00\x05\x03\x00\x01\x01\x01\x01\x01\x00\x00\x00", 1, 1, "\x01\x01\x01\x01\x01" ], + [ "\x01\x01\x00\x01\x00\x08\x00\x00\x01\x01\x01\x01\x01\x01\x01\x01", 1, 1, "\x01\x01\x01\x01\x01\x01\x01\x01" ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_record(@$test[1..3]); + is_hexstr($got, $expected, 'build_record()'); +} + +{ + my $exp = "\x01\x01\x00\x02\x00\x00\x00\x00"; + my $got = build_record(1, 2); + is_hexstr($got, $exp, 'build_record(1, 2)'); +} + +throws_ok { build_record( 0, 0, "\x00" x (0xFFFF + 1) ) } qr/^Invalid Argument: 'content' cannot exceed/; + +# build_record(type, request_id [, content]) +for (0..1, 4) { + throws_ok { build_record((1) x $_) } qr/^Usage: /; +} + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/015_build_stream.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/015_build_stream.t new file mode 100644 index 00000000..233f225f --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/015_build_stream.t @@ -0,0 +1,82 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 12; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_stream ]); +} + +sub TRUE () { !!1 } +sub FALSE () { !!0 } + +my @tests = ( + # expected, type, request_id, content, terminate + [ "", 1, 1, '', FALSE ], + [ "", 1, 1, undef, FALSE ], + [ "\x01\x01\x00\x01\x00\x00\x00\x00", 1, 1, '', TRUE ], + [ "\x01\x01\x00\x01\x00\x00\x00\x00", 1, 1, undef, TRUE ], + + [ "\x01\x01\x00\x01\x00\x03\x05\x00" + . "FOO\x00\x00\x00\x00\x00", 1, 1, 'FOO', FALSE ], + + [ "\x01\x01\x00\x01\x00\x03\x05\x00" + . "FOO\x00\x00\x00\x00\x00" + . "\x01\x01\x00\x01\x00\x00\x00\x00", 1, 1, 'FOO', TRUE ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_stream(@$test[1..4]); + is_hexstr($got, $expected, 'build_stream()'); +} + +{ + my $header = "\x01\x01\x00\x01\x7F\xF8\x00\x00"; + my $content = "x" x 32760; + my $trailer = "\x01\x01\x00\x01\x00\x00\x00\x00"; + + { + my $expected = $header . $content; + my $got = build_stream(1,1, $content); + is_hexstr($got, $expected, 'build_stream(content_length: 32760 terminate:false)'); + } + + { + my $expected = $header . $content . $trailer; + my $got = build_stream(1,1, $content, 1); + is_hexstr($got, $expected, 'build_stream(content_length: 32760 terminate:true)'); + } +} + +{ + my $records = "\x01\x01\x00\x01\x7F\xF8\x00\x00" # H1 + . "x" x 32760 # C1 + . "\x01\x01\x00\x01\x00\x08\x00\x00" # H2 + . "x" x 8 # C2 + ; + my $content = "x" x 32768; + my $trailer = "\x01\x01\x00\x01\x00\x00\x00\x00"; + + { + my $expected = $records; + my $got = build_stream(1,1, $content); + is_hexstr($got, $records, 'build_stream(content_length: 32768 terminate:false)'); + } + + { + my $expected = $records . $trailer; + my $got = build_stream(1,1, $content, 1); + is_hexstr($got, $expected, 'build_stream(content_length: 32768 terminate:true)'); + } +} + +throws_ok { build_stream() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/020_begin_request_body.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/020_begin_request_body.t new file mode 100644 index 00000000..031a7d17 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/020_begin_request_body.t @@ -0,0 +1,41 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 9; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_begin_request_body + parse_begin_request_body ]); +} + +my @tests = ( + # octets role flags + [ "\x00\x00\x00\x00\x00\x00\x00\x00", 0, 0 ], + [ "\xFF\xFF\xFF\x00\x00\x00\x00\x00", 0xFFFF, 0xFF ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_begin_request_body(@$test[1..2]); + is_hexstr($got, $expected, 'build_begin_request_body()'); +} + +foreach my $test (@tests) { + my @expected = @$test[1..2]; + my @got = parse_begin_request_body($test->[0]); + is_deeply(\@got, \@expected, "parse_begin_request_body()"); +} + +throws_ok { parse_begin_request_body("") } qr/^FastCGI: Insufficient .* FCGI_BeginRequestBody/; +throws_ok { parse_begin_request_body(undef) } qr/^FastCGI: Insufficient .* FCGI_BeginRequestBody/; + +throws_ok { build_begin_request_body() } qr/^Usage: /; +throws_ok { parse_begin_request_body() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/025_begin_request_record.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/025_begin_request_record.t new file mode 100644 index 00000000..50f94432 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/025_begin_request_record.t @@ -0,0 +1,30 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 4; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_begin_request_record ]); +} + +my @tests = ( + # octets request_id role flags + [ "\x01\x01\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", 0, 0, 0 ], + [ "\x01\x01\xFF\xFF\x00\x08\x00\x00\xFF\xFF\xFF\x00\x00\x00\x00\x00", 0xFFFF, 0xFFFF, 0xFF ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_begin_request_record(@$test[1..3]); + is_hexstr($got, $expected, 'build_begin_request_record()'); +} + +throws_ok { build_begin_request_record() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/027_begin_request.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/027_begin_request.t new file mode 100644 index 00000000..e5d6c91f --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/027_begin_request.t @@ -0,0 +1,97 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 15; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_begin_request ]); + use_ok('Net::FastCGI::Constant', qw[ :type :role ]); +} + +{ + my $begin = "\x01\x01\x00\x01\x00\x08\x00\x00" # FCGI_Header id=1 + . "\x00\x01\x00\x00\x00\x00\x00\x00"; # FCGI_BeginRequestBody role=FCGI_RESPONDER + + my $params = "\x01\x04\x00\x01\x00\x00\x00\x00"; # FCGI_Header type=FCGI_PARAMS + + { + my $exp = $begin . $params; + my $got = build_begin_request(1, FCGI_RESPONDER, 0, {}); + is_hexstr($got, $exp, q<build_begin_request(1, FCGI_RESPONDER, 0, {})>); + } + + my $stdin = "\x01\x05\x00\x01\x00\x00\x00\x00"; # FCGI_Header type=FCGI_STDIN + + { + my $exp = $begin . $params . $stdin; + my $got = build_begin_request(1, FCGI_RESPONDER, 0, {}, ''); + is_hexstr($got, $exp, q<build_begin_request(1, FCGI_RESPONDER, 0, {}, '')>); + } + + { + my $exp = $begin . $params . $stdin; + my $got = build_begin_request(1, FCGI_RESPONDER, 0, {}, undef); + is_hexstr($got, $exp, q<build_begin_request(1, FCGI_RESPONDER, 0, {}, undef)>); + } + + my $data = "\x01\x08\x00\x01\x00\x00\x00\x00"; # FCGI_Header type=FCGI_DATA + + { + my $exp = $begin . $params . $stdin . $data; + my $got = build_begin_request(1, FCGI_RESPONDER, 0, {}, '', undef); + is_hexstr($got, $exp, q<build_begin_request(1, FCGI_RESPONDER, 0, {}, '', undef)>); + } + + { + my $exp = $begin . $params . $stdin . $data; + my $got = build_begin_request(1, FCGI_RESPONDER, 0, {}, undef, ''); + is_hexstr($got, $exp, q<build_begin_request(1, FCGI_RESPONDER, 0, {}, undef, '')>); + } +} + +{ + my $begin = "\x01\x01\x00\x01\x00\x08\x00\x00" # FCGI_Header id=1 + . "\x00\x01\x00\x00\x00\x00\x00\x00"; # FCGI_BeginRequestBody role=FCGI_RESPONDER + + my $params = "\x01\x04\x00\x01\x00\x08\x00\x00" # FCGI_Header type=FCGI_PARAMS + . "\x03\x03FooBar" + . "\x01\x04\x00\x01\x00\x00\x00\x00"; + + { + my $exp = $begin . $params; + my $got = build_begin_request(1, FCGI_RESPONDER, 0, { Foo => 'Bar' }); + is_hexstr($got, $exp, q!build_begin_request(1, FCGI_RESPONDER, 0, { Foo => 'Bar' })!); + } + + my $stdin = "\x01\x05\x00\x01\x03\xFC\x04\x00" # FCGI_Header type=FCGI_STDIN + . "x" x 1020 . "\0" x 4 + . "\x01\x05\x00\x01\x00\x00\x00\x00"; + { + my $exp = $begin . $params . $stdin; + my $got = build_begin_request(1, FCGI_RESPONDER, 0, { Foo => 'Bar' }, 'x' x 1020); + is_hexstr($got, $exp, q!build_begin_request(1, FCGI_RESPONDER, 0, { Foo => 'Bar' }, 'x' x 1020)!); + } + + my $data = "\x01\x08\x00\x01\x04\x00\x00\x00" # FCGI_Header type=FCGI_DATA + . "y" x 1024 + . "\x01\x08\x00\x01\x00\x00\x00\x00"; + + { + my $exp = $begin . $params . $stdin . $data; + my $got = build_begin_request(1, FCGI_RESPONDER, 0, { Foo => 'Bar' }, 'x' x 1020, 'y' x 1024); + is_hexstr($got, $exp, q!build_begin_request(1, FCGI_RESPONDER, 0, { Foo => 'Bar' }, 'x' x 1020, 'y' x 1024)!); + } +} + +# build_begin_request(request_id, role, flags, params [, stdin [, data]]) +for (0..3, 7) { + throws_ok { build_begin_request((1) x $_) } qr/^Usage: /; +} + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/030_end_request_body.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/030_end_request_body.t new file mode 100644 index 00000000..783408d4 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/030_end_request_body.t @@ -0,0 +1,42 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 9; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_end_request_body + parse_end_request_body ]); +} + +my @tests = ( + # octets app_status protocol_status + [ "\x00\x00\x00\x00\x00\x00\x00\x00", 0, 0 ], + [ "\xFF\xFF\xFF\xFF\xFF\x00\x00\x00", 0xFFFFFFFF, 0xFF ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_end_request_body(@$test[1..2]); + is_hexstr($got, $expected, 'build_end_request_body()'); +} + +foreach my $test (@tests) { + my @expected = @$test[1..2]; + my @got = parse_end_request_body($test->[0]); + is_deeply(\@got, \@expected, "parse_end_request_body()"); +} + + +throws_ok { parse_end_request_body("") } qr/^FastCGI: Insufficient .* FCGI_EndRequestBody/; +throws_ok { parse_end_request_body(undef) } qr/^FastCGI: Insufficient .* FCGI_EndRequestBody/; + +throws_ok { build_end_request_body() } qr/^Usage: /; +throws_ok { parse_end_request_body() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/035_end_request_record.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/035_end_request_record.t new file mode 100644 index 00000000..f76dbd1f --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/035_end_request_record.t @@ -0,0 +1,30 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 4; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_end_request_record ]); +} + +my @tests = ( + # octets request_id app_status protocol_status + [ "\x01\x03\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", 0, 0, 0 ], + [ "\x01\x03\xFF\xFF\x00\x08\x00\x00\xFF\xFF\xFF\xFF\xFF\x00\x00\x00", 0xFFFF, 0xFFFFFFFF, 0xFF ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_end_request_record(@$test[1..3]); + is_hexstr($got, $expected, 'build_end_request_record()'); +} + +throws_ok { build_end_request_record() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/037_end_request.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/037_end_request.t new file mode 100644 index 00000000..c7c421c5 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/037_end_request.t @@ -0,0 +1,87 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 13; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_end_request ]); + use_ok('Net::FastCGI::Constant', qw[ :type :protocol_status ]); +} + +{ + my $end = "\x01\x03\x00\x01\x00\x08\x00\x00" # FCGI_Header id=1 + . "\x00\x00\x00\x00\x00\x00\x00\x00" # FCGI_EndRequestBody + ; + + { + my $got = build_end_request(1, 0, FCGI_REQUEST_COMPLETE); + is_hexstr($got, $end, q<build_end_request(1, 0, FCGI_REQUEST_COMPLETE)>); + } + + my $stdout = "\x01\x06\x00\x01\x00\x00\x00\x00"; # FCGI_Header type=FCGI_STDOUT + + { + my $exp = $stdout . $end; + my $got = build_end_request(1, 0, FCGI_REQUEST_COMPLETE, ''); + is_hexstr($got, $exp, q<build_end_request(1, 0, FCGI_REQUEST_COMPLETE, '')>); + } + + { + my $exp = $stdout . $end; + my $got = build_end_request(1, 0, FCGI_REQUEST_COMPLETE, undef); + is_hexstr($got, $exp, q<build_end_request(1, 0, FCGI_REQUEST_COMPLETE, undef)>); + } + + my $stderr = "\x01\x07\x00\x01\x00\x00\x00\x00"; # FCGI_Header type=FCGI_STDERR + + { + my $exp = $stdout . $stderr . $end; + my $got = build_end_request(1, 0, FCGI_REQUEST_COMPLETE, '', undef); + is_hexstr($got, $exp, q<build_end_request(1, 0, FCGI_REQUEST_COMPLETE, '', undef)>); + } + + { + my $exp = $stdout . $stderr . $end; + my $got = build_end_request(1, 0, FCGI_REQUEST_COMPLETE, undef, ''); + is_hexstr($got, $exp, q<build_end_request(1, 0, FCGI_REQUEST_COMPLETE, undef, '')>); + } +} + +{ + my $end = "\x01\x03\x00\x01\x00\x08\x00\x00" # FCGI_Header id=1 + . "\x00\x00\x00\x00\x00\x00\x00\x00" # FCGI_EndRequestBody + ; + + my $stdout = "\x01\x06\x00\x01\x03\xFC\x04\x00" # FCGI_Header type=FCGI_STDOUT + . "x" x 1020 . "\0" x 4 + . "\x01\x06\x00\x01\x00\x00\x00\x00"; + + { + my $exp = $stdout . $end; + my $got = build_end_request(1, 0, FCGI_REQUEST_COMPLETE, 'x' x 1020); + is_hexstr($got, $exp, q<build_end_request(1, 0, FCGI_REQUEST_COMPLETE, 'x' x 1020)>); + } + + my $stderr = "\x01\x07\x00\x01\x04\x00\x00\x00" # FCGI_Header type=FCGI_STDERR + . "y" x 1024 + . "\x01\x07\x00\x01\x00\x00\x00\x00"; + + { + my $exp = $stdout . $stderr . $end; + my $got = build_end_request(1, 0, FCGI_REQUEST_COMPLETE, 'x' x 1020, 'y' x 1024); + is_hexstr($got, $exp, q<build_end_request(1, 0, FCGI_REQUEST_COMPLETE, 'x' x 1020, 'y' x 1024)>); + } +} + +# build_end_request(request_id, app_status, protocol_status [, stdout [, stderr]]) +for (0..2, 6) { + throws_ok { build_end_request((1) x $_) } qr/^Usage: /; +} + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/040_unknown_type_body.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/040_unknown_type_body.t new file mode 100644 index 00000000..27e0d379 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/040_unknown_type_body.t @@ -0,0 +1,42 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 9; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_unknown_type_body + parse_unknown_type_body ]); +} + +my @tests = ( + # octets type + [ "\x00\x00\x00\x00\x00\x00\x00\x00", 0 ], + [ "\xFF\x00\x00\x00\x00\x00\x00\x00", 0xFF ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_unknown_type_body($test->[1]); + is_hexstr($got, $expected, 'build_unknown_type_body()'); +} + +foreach my $test (@tests) { + my @expected = $test->[1]; + my @got = parse_unknown_type_body($test->[0]); + is_deeply(\@got, \@expected, "parse_unknown_type_body()"); +} + + +throws_ok { parse_unknown_type_body("") } qr/^^FastCGI: Insufficient .* FCGI_UnknownTypeBody/; +throws_ok { parse_unknown_type_body(undef) } qr/^^FastCGI: Insufficient .* FCGI_UnknownTypeBody/; + +throws_ok { build_unknown_type_body() } qr/^Usage: /; +throws_ok { parse_unknown_type_body() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/045_unknown_type_record.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/045_unknown_type_record.t new file mode 100644 index 00000000..8ee053ab --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/045_unknown_type_record.t @@ -0,0 +1,30 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 4; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_unknown_type_record ]); +} + +my @tests = ( + # octets type + [ "\x01\x0B\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", 0 ], + [ "\x01\x0B\x00\x00\x00\x08\x00\x00\xFF\x00\x00\x00\x00\x00\x00\x00", 0xFF ], +); + +foreach my $test (@tests) { + my $expected = $test->[0]; + my $got = build_unknown_type_record($test->[1]); + is_hexstr($got, $expected, 'build_unknown_type_record()'); +} + +throws_ok { build_unknown_type_record() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/050_parse_record.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/050_parse_record.t new file mode 100644 index 00000000..34c5fb92 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/050_parse_record.t @@ -0,0 +1,180 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 54; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Constant', qw[:all]); + use_ok('Net::FastCGI::Protocol', qw[ build_header + build_record + build_stream + parse_record ]); +} + +my @records_ok = ( + [ + "\x01\x01\x00\x01\x00\x08\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", + "\x00\x01\x00\x00\x00\x00\x00\x00", + { type => FCGI_BEGIN_REQUEST, + request_id => 1, + role => FCGI_RESPONDER, + flags => 0 } + ], + [ + "\x01\x02\x00\x01\x00\x00\x00\x00", + "", + { type => FCGI_ABORT_REQUEST, + request_id => 1 } + ], + [ + "\x01\x03\x00\x01\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", + "\x00\x00\x00\x00\x00\x00\x00\x00", + { type => FCGI_END_REQUEST, + request_id => 1, + protocol_status => 0, + app_status => 0 } + ], + [ + "\x01\x04\x00d\x00\x0B\x05\x00FCGI_PARAMS\x00\x00\x00\x00\x00", + "FCGI_PARAMS", + { type => FCGI_PARAMS, + request_id => 100, + content => 'FCGI_PARAMS' } + ], + [ + "\x01\x05\x00\xC8\x00\x0A\x06\x00FCGI_STDIN\x00\x00\x00\x00\x00\x00", + "FCGI_STDIN", + { type => FCGI_STDIN, + request_id => 200, + content => 'FCGI_STDIN' } + ], + [ + "\x01\x06\x01\x2C\x00\x0B\x05\x00FCGI_STDOUT\x00\x00\x00\x00\x00", + "FCGI_STDOUT", + { type => FCGI_STDOUT, + request_id => 300, + content => 'FCGI_STDOUT' } + ], + [ + "\x01\x07\x01\x90\x00\x0B\x05\x00FCGI_STDERR\x00\x00\x00\x00\x00", + "FCGI_STDERR", + { type => FCGI_STDERR, + request_id => 400, + content => 'FCGI_STDERR' } + ], + [ + "\x01\x08\x01\xF4\x00\x09\x07\x00FCGI_DATA\x00\x00\x00\x00\x00\x00\x00", + "FCGI_DATA", + { type => FCGI_DATA, + request_id => 500, + content => 'FCGI_DATA' } + ], + [ + "\x01\x09\x00\x00\x00\x0D\x03\x00\x03\x03BarBaZ\x03\x00FOO\x00\x00\x00", + "\x03\x03BarBaZ\x03\x00FOO", + { type => FCGI_GET_VALUES, + request_id => FCGI_NULL_REQUEST_ID, + values => { FOO => '', Bar => 'BaZ' } + } + ], + [ + "\x01\x0A\x00\x00\x00\x17\x01\x00\x04\x01BETA2\x05\x01ALPHA1\x05\x01GAMMA3\x00", + "\x04\x01BETA2\x05\x01ALPHA1\x05\x01GAMMA3", + { type => FCGI_GET_VALUES_RESULT, + request_id => FCGI_NULL_REQUEST_ID, + values => { ALPHA => 1, BETA => 2, GAMMA => 3 } + } + ], + [ + "\x01\x0B\x00\x00\x00\x08\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00", + "\x64\x00\x00\x00\x00\x00\x00\x00", + { type => FCGI_UNKNOWN_TYPE, + request_id => FCGI_NULL_REQUEST_ID, + unknown_type => 100 } + ], + [ + "\x01\x6F\x00\xDE\x00\x04\x04\x00oops\x00\x00\x00\x00", + "oops", + { type => 111, + request_id => 222, + content => 'oops' } + ], + [ + "\x01\xFF\xFF\xFF\x00\x00\x00\x00", + "", + { type => 0xFF, + request_id => 0xFFFF } + ], +); + +foreach my $test (@records_ok) { + my $expected = $test->[2]; + my $got = parse_record($test->[0]); + is_deeply($got, $expected, "parse_record() in scalar context"); +} + +foreach my $test (@records_ok) { + my @expected = ($test->[2]->{type}, $test->[2]->{request_id}, $test->[1]); + my @got = parse_record($test->[0]); + is_deeply(\@got, \@expected, "parse_record() in list context"); +} + +my @headers_malformed = ( + # type, request_id, content_length, padding_length + [ FCGI_BEGIN_REQUEST, 0, 0, 0 ], + [ FCGI_BEGIN_REQUEST, 1, 0, 0 ], + [ FCGI_ABORT_REQUEST, 0, 0, 0 ], + [ FCGI_END_REQUEST, 0, 0, 0 ], + [ FCGI_END_REQUEST, 1, 0, 0 ], + [ FCGI_PARAMS, 0, 0, 0 ], + [ FCGI_STDIN, 0, 0, 0 ], + [ FCGI_STDOUT, 0, 0, 0 ], + [ FCGI_STDERR, 0, 0, 0 ], + [ FCGI_DATA, 0, 0, 0 ], + [ FCGI_GET_VALUES, 1, 0, 0 ], + [ FCGI_GET_VALUES_RESULT, 1, 0, 0 ], + [ FCGI_UNKNOWN_TYPE, 0, 0, 0 ], + [ FCGI_UNKNOWN_TYPE, 1, 0, 0 ] +); + +foreach my $test (@headers_malformed) { + my $octets = build_header(@$test); + throws_ok { parse_record($octets) } qr/^FastCGI: Malformed/; +} + +{ + my $octets = build_header(FCGI_ABORT_REQUEST, 1, 8, 0) . "\x00" x 8; + throws_ok { parse_record($octets) } qr/^FastCGI: Malformed/; +} + +my @stream_types = ( + FCGI_PARAMS, + FCGI_STDIN, + FCGI_STDOUT, + FCGI_STDERR, + FCGI_DATA +); + +foreach my $type (@stream_types) { + my $expected = { type => $type, request_id => 1, content => '' }; + my $octets = build_record($type, 1, ''); + my $got = parse_record($octets); + is_deeply($got, $expected, "parse_record(stream record) in scalar context"); +} + +foreach my $type (@stream_types) { + my @expected = ($type, 1, ''); + my $octets = build_record($type, 1, ''); + my @got = parse_record($octets); + is_deeply(\@got, \@expected, "parse_record(stream record) in list context"); +} + +throws_ok { parse_record() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/055_parse_record_body.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/055_parse_record_body.t new file mode 100644 index 00000000..35f3793c --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/055_parse_record_body.t @@ -0,0 +1,98 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 33; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Constant', qw[:all]); + use_ok('Net::FastCGI::Protocol', qw[ build_header + build_record + build_stream + parse_record_body ]); +} + +my @ok = ( + [ + "\x00\x01\x01\x00\x00\x00\x00\x00", + { type => FCGI_BEGIN_REQUEST, + request_id => 1, + role => 1, + flags => 1 } + ], + [ + "\x00\x00\x00\x01\x01\x00\x00\x00", + { type => FCGI_END_REQUEST, + request_id => 1, + app_status => 1, + protocol_status => 1 } + ], + [ + undef, + { type => FCGI_STDIN, + request_id => 1, + content => '' } + ], + [ + "", + { type => FCGI_PARAMS, + request_id => 1, + content => '' } + ], + [ + "\x01\x01A1\x01\x01B2", + { type => FCGI_GET_VALUES, + request_id => FCGI_NULL_REQUEST_ID, + values => { A => 1, B => 2 } } + ], + [ + undef, + { type => FCGI_GET_VALUES_RESULT, + request_id => FCGI_NULL_REQUEST_ID, + values => {} } + ] +); + +foreach my $test (@ok) { + my $exp = $test->[1]; + my $got = parse_record_body($exp->{type}, $exp->{request_id}, $test->[0]); + is_deeply($got, $exp, "parse_record_body()"); +} + +my @malformed = ( + # type, request_id + [ FCGI_BEGIN_REQUEST, 0 ], + [ FCGI_END_REQUEST, 0 ], + [ FCGI_PARAMS, 0 ], + [ FCGI_STDIN, 0 ], + [ FCGI_STDOUT, 0 ], + [ FCGI_STDERR, 0 ], + [ FCGI_DATA, 0 ], + [ FCGI_GET_VALUES, 1 ], + [ FCGI_GET_VALUES_RESULT, 1 ], + [ FCGI_UNKNOWN_TYPE, 1 ] +); + +foreach my $test (@malformed) { + my ($type, $request_id) = @$test; + throws_ok { parse_record_body($type, $request_id, '') } qr/^FastCGI: Malformed/; +} + +{ + my $content = "\x00" x (FCGI_MAX_CONTENT_LEN + 1); + foreach my $type (0..12) { + throws_ok { parse_record_body($type, 0, $content) } qr/^Invalid Argument: 'content' cannot exceed/; + } +} + +# parse_record_body(type, request_id, content) +for (0, 4) { + throws_ok { parse_record_body((1) x $_) } qr/^Usage: /; +} + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/060_params.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/060_params.t new file mode 100644 index 00000000..92d9a64c --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/060_params.t @@ -0,0 +1,79 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 38; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[ build_params + check_params + parse_params ]); +} + +sub TRUE () { !!1 } +sub FALSE () { !!0 } + +my @tests = ( + # octets params + [ "", { } ], + [ "\x00\x00", { '' => '' }, ], + [ "\x01\x01\x31\x31", { 1 => 1 }, ], + [ "\x01\x01\x41\x42\x01\x01\x43\x44\x01\x01\x45\x46", { A => 'B', C => 'D', E => 'F' } ], +); + +foreach my $test (@tests) { + my ($expected, $params) = @$test; + my $got = join '', map { + build_params({ $_ => $params->{$_} }) + } sort keys %$params; + is_hexstr($got, $expected, 'build_params()'); +} + +is_hexstr("\x03\x00foo", build_params({foo => undef}), 'build_params({foo => undef})'); +is_hexstr("\x7F\x00" . "x" x 127, build_params({ "x" x 127 => '' })); +is_hexstr("\x00\x7F" . "x" x 127, build_params({ '' => "x" x 127 })); +is_hexstr("\x80\x00\x00\x80\x00" . "x" x 128, build_params({ "x" x 128 => '' })); +is_hexstr("\x00\x80\x00\x00\x80" . "x" x 128, build_params({ '' => "x" x 128 })); + +foreach my $test (@tests) { + my $expected = $test->[1]; + my $got = parse_params($test->[0]); + is_deeply($got, $expected, 'parse_params()'); +} + +foreach my $test (@tests) { + my $octets = $test->[0]; + is(check_params($octets), TRUE, 'check_params(octets) eq TRUE'); +} + +my @insufficient = ( + "\x00", + "\x01", + "\x00\x01", + "\x01\x00", + "\x00\xFF", + "\x01\xFF\x00", + "\x00\x80\x00\x00\x80", + "\x80\x00\x00\x80\x00", +); + +foreach my $test (@insufficient) { + throws_ok { parse_params($test) } qr/^FastCGI: Insufficient .* FCGI_NameValuePair/; +} + +foreach my $test (@insufficient) { + is(check_params($test), FALSE, 'check_params(octets) eq FALSE'); +} + +is(check_params(undef), FALSE, 'check_params(undef) eq FALSE'); + +throws_ok { check_params() } qr/^Usage: /; +throws_ok { build_params() } qr/^Usage: /; +throws_ok { parse_params() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/065_record_type.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/065_record_type.t new file mode 100644 index 00000000..5836a05b --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/065_record_type.t @@ -0,0 +1,105 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 55; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Constant', qw[ :type ] ); + use_ok('Net::FastCGI::Protocol', qw[ is_discrete_type + is_known_type + is_management_type + is_stream_type ] ); +} + +sub TRUE () { !!1 } +sub FALSE () { !!0 } + +{ + my @known = ( + FCGI_BEGIN_REQUEST, + FCGI_ABORT_REQUEST, + FCGI_END_REQUEST, + FCGI_PARAMS, + FCGI_STDIN, + FCGI_STDOUT, + FCGI_STDERR, + FCGI_DATA, + FCGI_GET_VALUES, + FCGI_GET_VALUES_RESULT, + FCGI_UNKNOWN_TYPE, + FCGI_MAXTYPE, + ); + + foreach my $type (@known) { + is( is_known_type($type), TRUE, qq/is_known_type($type) = true/ ); + } +} + +{ + my @discrete = ( + FCGI_BEGIN_REQUEST, + FCGI_ABORT_REQUEST, + FCGI_END_REQUEST, + FCGI_GET_VALUES, + FCGI_GET_VALUES_RESULT, + FCGI_UNKNOWN_TYPE, + ); + + foreach my $type ( @discrete ) { + is( is_stream_type($type), FALSE, qq/is_stream_type($type) = false/ ); + is( is_discrete_type($type), TRUE, qq/is_discrete_type($type) = true/ ); + } +} + +{ + my @management = ( + FCGI_GET_VALUES, + FCGI_GET_VALUES_RESULT, + FCGI_UNKNOWN_TYPE, + ); + + foreach my $type (@management) { + is( is_management_type($type), TRUE, qq/is_management_type($type) = true/ ); + } +} + +{ + my @stream = ( + FCGI_PARAMS, + FCGI_STDIN, + FCGI_STDOUT, + FCGI_STDERR, + FCGI_DATA, + ); + + foreach my $type (@stream) { + is( is_stream_type($type), TRUE, qq/is_stream_type($type) = true/ ); + is( is_discrete_type($type), FALSE, qq/is_discrete_type($type) = false/ ); + } +} + +{ + my @subnames = qw( + is_known_type + is_discrete_type + is_management_type + is_stream_type + ); + + foreach my $name (@subnames) { + my $sub = __PACKAGE__->can($name); + is($sub->($_), FALSE, qq/$name($_) = false/) for (-10, 0, 12); + } +} + +throws_ok { is_known_type() } qr/^Usage: /; +throws_ok { is_discrete_type() } qr/^Usage: /; +throws_ok { is_management_type() } qr/^Usage: /; +throws_ok { is_stream_type() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/070_names.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/070_names.t new file mode 100644 index 00000000..86af502d --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/070_names.t @@ -0,0 +1,80 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 29; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Constant', qw[ :type :role :protocol_status ] ); + use_ok('Net::FastCGI::Protocol', qw[ get_type_name + get_role_name + get_protocol_status_name ] ); +} + +{ + my @tests = ( + [ FCGI_BEGIN_REQUEST, 'FCGI_BEGIN_REQUEST' ], + [ FCGI_ABORT_REQUEST, 'FCGI_ABORT_REQUEST' ], + [ FCGI_END_REQUEST, 'FCGI_END_REQUEST' ], + [ FCGI_PARAMS, 'FCGI_PARAMS' ], + [ FCGI_STDIN, 'FCGI_STDIN' ], + [ FCGI_STDOUT, 'FCGI_STDOUT' ], + [ FCGI_STDERR, 'FCGI_STDERR' ], + [ FCGI_DATA, 'FCGI_DATA' ], + [ FCGI_GET_VALUES, 'FCGI_GET_VALUES' ], + [ FCGI_GET_VALUES_RESULT, 'FCGI_GET_VALUES_RESULT' ], + [ FCGI_UNKNOWN_TYPE, 'FCGI_UNKNOWN_TYPE' ], + ); + + foreach my $test ( @tests ) { + my ( $type, $name ) = @$test; + is( get_type_name($type), $name, qq/get_type_name($type) = $name/ ); + } + + foreach my $type ( 0, 0xFF ) { + is(get_type_name($type), sprintf('0x%.2X', $type)); + } +} + +{ + my @tests = ( + [ FCGI_RESPONDER, 'FCGI_RESPONDER' ], + [ FCGI_AUTHORIZER, 'FCGI_AUTHORIZER' ], + [ FCGI_FILTER, 'FCGI_FILTER' ], + ); + + foreach my $test ( @tests ) { + my ( $role, $name ) = @$test; + is( get_role_name($role), $name, qq/get_role_name($role) = $name/ ); + } + + foreach my $role ( 0, 0xFF, 0xFFFF ) { + is(get_role_name($role), sprintf('0x%.4X', $role)); + } +} + +{ + my @tests = ( + [ FCGI_REQUEST_COMPLETE, 'FCGI_REQUEST_COMPLETE' ], + [ FCGI_CANT_MPX_CONN, 'FCGI_CANT_MPX_CONN' ], + [ FCGI_OVERLOADED, 'FCGI_OVERLOADED' ], + [ FCGI_UNKNOWN_ROLE, 'FCGI_UNKNOWN_ROLE' ], + ); + + foreach my $test ( @tests ) { + my ( $status, $name ) = @$test; + is( get_protocol_status_name($status), $name, qq/get_protocol_status_name($status) = $name/ ); + } + + is(get_protocol_status_name(0xFF), '0xFF'); +} + +throws_ok { get_type_name() } qr/^Usage: /; +throws_ok { get_role_name() } qr/^Usage: /; +throws_ok { get_protocol_status_name() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/080_dump_record.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/080_dump_record.t new file mode 100644 index 00000000..0e0bb5de --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/080_dump_record.t @@ -0,0 +1,51 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 9; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Protocol', qw[build_record dump_record]); +} + +{ + my $record = build_record(0, 0, "\x00\x01\x02\x03\x04\x05\x06\x07"); + my $dump = dump_record($record); + like $dump, qr/\A \{0x00, \s 0, \s "\\x00\\x01\\x02\\x03\\x04\\x05\\x06\\x07"\}/x; +} + +{ + my $record = build_record(0, 0, "\x00\x01\x02\x03\x04\x05\x06\x07"); + + for my $len (0, 8) { + my $dump = dump_record(substr($record, 0, $len)); + like $dump, qr/\A \{ Malformed \s FCGI_Record }/x, "Insufficient octets"; + } +} + +{ + for my $header ("\x00\x00\x00\x00\x00\x00\x00\x00", + "\xFF\x00\x00\x00\x00\x00\x00\x00") { + my $dump = dump_record($header); + like $dump, qr/\A \{ Malformed \s FCGI_Record }/x, "Protocol version mismatch"; + } +} + +# dump_record(type, request_id [, content]) deprecated +{ + my $dump = dump_record(0, 0); + like $dump, qr/\A \{0x00, \s 0, \s ""\}/x; +} +{ + my $dump = dump_record(0, 0, "\x00\x01\x02\x03\x04\x05\x06\x07"); + like $dump, qr/\A \{0x00, \s 0, \s "\\x00\\x01\\x02\\x03\\x04\\x05\\x06\\x07"\}/x; +} + +# dump_record(octets) +throws_ok { dump_record() } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/085_dump_record_body.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/085_dump_record_body.t new file mode 100644 index 00000000..af00d7a3 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/020_protocol/085_dump_record_body.t @@ -0,0 +1,150 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; +use myconfig; + +use Test::More tests => 64; +use Test::HexString; +use Test::Exception; + +BEGIN { + use_ok('Net::FastCGI::Constant', qw[:all]); + use_ok('Net::FastCGI::Protocol', qw[:all]); +} + +my @KNOWN_TYPES = ( + FCGI_BEGIN_REQUEST, + FCGI_ABORT_REQUEST, + FCGI_END_REQUEST, + FCGI_PARAMS, + FCGI_STDIN, + FCGI_STDOUT, + FCGI_STDERR, + FCGI_DATA, + FCGI_GET_VALUES, + FCGI_GET_VALUES_RESULT, + FCGI_UNKNOWN_TYPE, +); + +foreach my $type (@KNOWN_TYPES) { + like dump_record_body($type, 0), qr/\A\{ $FCGI_TYPE_NAME[$type]\, \s+ 0/x; +} + +foreach my $type (FCGI_PARAMS, FCGI_GET_VALUES, FCGI_GET_VALUES_RESULT) { + my $name = $FCGI_TYPE_NAME[$type]; + { + my $dump = dump_record_body($type, 1, ''); + like $dump, qr/\A \{ $name\, \s+ 1\, \s ""/x; + } + { + my $dump = dump_record_body($type, 1, build_params({ '' => '' })); + like $dump, qr/\A \{ $name\, \s+ 1\, \s "\\000\\000"/x; + } + { + my $dump = dump_record_body($type, 1, build_params({ 'Foo' => '' })); + like $dump, qr/\A \{ $name\, \s+ 1\, \s "\\003\\000Foo"/x; + } + { + my $dump = dump_record_body($type, 1, build_params({ "Foo\r\n" => "\x01\x02" })); + like $dump, qr/\A \{ $name\, \s+ 1\, \s "\\005\\002Foo\\r\\n\\x01\\x02/x; + } + { + my $dump = dump_record_body($type, 1, build_params({ 'x' => 'y' x 128 })); + like $dump, qr/\A \{ $name\, \s+ 1\, \s "\\001\\200\\000\\000\\200 x y+/x; + } + { + my $dump = dump_record_body($type, 1, "\001\001"); + like $dump, qr/\A \{ $name\, \s+ 1\, \s Malformed \s FCGI_NameValuePair/x; + } +} + +# Streams +{ + my @tests = ( + [ FCGI_STDIN, 1, "Foo\r\n\t", + qr/\A \{ FCGI_STDIN\, \s+ 1\, \s \"Foo\\r\\n\\t/x ], + [ FCGI_STDOUT, 1, "\x00\x01\x02\x03\x04\x05\x06\x07", + qr/\A \{ FCGI_STDOUT\, \s+ 1\, \s \"\\x00\\x01\\x02\\x03\\x04\\x05\\x06\\x07/x ], + [ FCGI_STDERR, 1, "Foo \x01\x02 Bar\n", + qr/\A \{ FCGI_STDERR\, \s+ 1\, \s \"Foo\x20\\x01\\x02\x20Bar\\n/x ], + [ FCGI_DATA, 1, 'x' x 80, + qr/\A \{ FCGI_DATA\, \s+ 1\, \s \" x+ \s \.\.\./x ], + ); + + foreach my $test (@tests) { + my ($type, $request_id, $content, $expected) = @$test; + my $dump = dump_record_body($type, $request_id, $content); + like $dump, $expected; + } +} + +# FCGI_BEGIN_REQUEST +{ + my @tests = ( + [ build_begin_request_body(FCGI_RESPONDER, FCGI_KEEP_CONN), + qr/\A \{ FCGI_BEGIN_REQUEST\, \s+ 1\, \s \{ FCGI_RESPONDER\, \s+ FCGI_KEEP_CONN\}/x ], + [ build_begin_request_body(FCGI_FILTER, FCGI_KEEP_CONN | 0x10), + qr/\A \{ FCGI_BEGIN_REQUEST\, \s+ 1\, \s \{ FCGI_FILTER\, \s+ FCGI_KEEP_CONN|0x10\}/x ], + [ build_begin_request_body(FCGI_AUTHORIZER, 0), + qr/\A \{ FCGI_BEGIN_REQUEST\, \s+ 1\, \s \{ FCGI_AUTHORIZER\, \s+ 0\}/x ], + [ build_begin_request_body(0, 0x80), + qr/\A \{ FCGI_BEGIN_REQUEST\, \s+ 1\, \s \{ 0x0000\, \s+ 0x80\}/x ], + map([ $_, + qr/\A \{ FCGI_BEGIN_REQUEST\, \s+ 1\, \s \{ Malformed \s FCGI_BeginRequestBody/x ], + ('', "\x00" x 10)), + ); + + foreach my $test (@tests) { + my ($content, $expected) = @$test; + my $dump = dump_record_body(FCGI_BEGIN_REQUEST, 1, $content); + like $dump, $expected; + } +} + +# FCGI_END_REQUEST +{ + my @tests = ( + [ build_end_request_body(10, 0x80), + qr/\A \{ FCGI_END_REQUEST\, \s+ 1\, \s \{ 10\, \s+ 0x80\}/x ], + map([ $_, + qr/\A \{ FCGI_END_REQUEST\, \s+ 1\, \s \{ Malformed \s FCGI_EndRequestBody/x ], + ('', "\x00" x 10)), + map([ build_end_request_body(0, $_), + qr/\A \{ FCGI_END_REQUEST\, \s+ 1\, \s \{ 0\, \s+ $FCGI_PROTOCOL_STATUS_NAME[$_]\}/x ], + (0..3)), + ); + + foreach my $test (@tests) { + my ($content, $expected) = @$test; + my $dump = dump_record_body(FCGI_END_REQUEST, 1, $content); + like $dump, $expected; + } +} + +# FCGI_UNKNOWN_TYPE +{ + my @tests = ( + [ build_unknown_type_body(0), + qr/\A \{ FCGI_UNKNOWN_TYPE\, \s+ 0\, \s \{ 0/x ], + map([ build_unknown_type_body($_), + qr/\A \{ FCGI_UNKNOWN_TYPE\, \s+ 0\, \s \{ $FCGI_TYPE_NAME[$_]/x ], + @KNOWN_TYPES), + map([ $_, + qr/\A \{ FCGI_UNKNOWN_TYPE\, \s+ 0\, \s \{ Malformed \s FCGI_UnknownTypeBody/x ], + ('', "\x00" x 10)), + ); + + foreach my $test (@tests) { + my ($content, $expected) = @$test; + my $dump = dump_record_body(FCGI_UNKNOWN_TYPE, 0, $content); + like $dump, $expected; + } +} + + +throws_ok { dump_record_body() } qr/^Usage: /; +throws_ok { dump_record_body(0, 0, undef, 0) } qr/^Usage: /; + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/lib/myconfig.pm b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/lib/myconfig.pm new file mode 100644 index 00000000..1d4f6348 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/t/lib/myconfig.pm @@ -0,0 +1,9 @@ +package myconfig; + +use strict; + +BEGIN { + $ENV{NET_FASTCGI_PP} = 0 + !(-e "XS.xs" || -e "../XS.xs"); +} + +1; diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/xt/000_pod.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/xt/000_pod.t new file mode 100644 index 00000000..95dd65ae --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/xt/000_pod.t @@ -0,0 +1,17 @@ +#!perl + +use strict; +use warnings; + +use Test::More; + +BEGIN { + eval 'use Test::Pod'; + + if ($@) { + plan skip_all => 'Needs Test::Pod'; + } +} + +all_pod_files_ok(); + diff --git a/web/server/h2o/libh2o/misc/p5-net-fastcgi/xt/010_pod_coverage.t b/web/server/h2o/libh2o/misc/p5-net-fastcgi/xt/010_pod_coverage.t new file mode 100644 index 00000000..bd4e3d22 --- /dev/null +++ b/web/server/h2o/libh2o/misc/p5-net-fastcgi/xt/010_pod_coverage.t @@ -0,0 +1,29 @@ +#!perl + +use strict; +use warnings; + +use Test::More; + +BEGIN { + eval 'use Test::Pod::Coverage'; + + if ($@) { + plan skip_all => 'Needs Test::Pod::Coverage'; + } +} + +my @modules = sort grep { !/::(?:PP|XS)$/ } all_modules(); + +plan tests => scalar(@modules); + +foreach my $module ( @modules ) { + my $params = {}; + + if ( $module =~ /^Net::FastCGI::Protocol$/ ) { + $params->{coverage_class} = 'Pod::Coverage::ExportOnly'; + } + + pod_coverage_ok( $module, $params ); +} + |