diff options
Diffstat (limited to '')
| -rwxr-xr-x | web/server/h2o/libh2o/misc/p5-net-fastcgi/eg/runfcgi.pl | 226 |
1 files changed, 226 insertions, 0 deletions
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"; + } +} |