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