Commit fac36398 authored by Xavier Guimard's avatar Xavier Guimard

Import original source of FCGI-Async 0.22

parents
use strict;
use warnings;
use Module::Build;
my $build = Module::Build->new(
module_name => 'FCGI::Async',
requires => {
'Net::Async::FastCGI' => 0,
},
build_requires => {
'Test::HexString' => 0,
'Test::More' => 0,
'Test::Refcount' => 0,
},
license => 'perl',
create_makefile_pl => 'traditional',
create_license => 1,
create_readme => 1,
);
$build->create_build_script;
Revision history for FCGI-Async
0.21 CHANGES:
* Implement HTTP::Request/HTTP::Response gatewaying
* Implement PSGI gatewaying
* Provide Plack::Handler::FCGI::Async for plackup et.al.
* Implement ->stdin, ->stdout, ->stderr pseudo-filehandles
0.20 CHANGES:
* Use Net::FastCGI for low-level FastCGI constants and message
handling functions
* Ensure that ->set_encoding( undef ) actually works to disable the
encoding mechanism
BUGFIXES:
* Collect the entire PARAMS stream and only parse it when it's all
present, rather than piecewise
0.19 CHANGES:
* import Exporter::import instead of @ISAing it
* Respond with FCGI_UNKNOWN_TYPE or FCGI_UNKNOWN_ROLE when
appropriate (fixes RT 54480)
* Updated bundled example applications to a modern IO::Async style
0.18 CHANGES:
* Allow setting of per-request encoding for STDIN/STDOUT/STDERR
streams
* Code adjustment to make use of the new IO::Async::Listener class
* Deprecated ->listen( handle => IO ) in favour of ->new or
->configure instead.
0.17 CHANGES:
* Added 'use warnings'
* Documentation updates
* Various small updates to keep CPANTS happy
0.16 BUGFIXES:
* Support FCGI_GET_VALUES
(closes http://rt.cpan.org/Ticket/Display.html?id=43976)
* Use Test::HexString and wait_for_stream() during testing
0.15 BUGFIXES:
* Correctly handle webserver-aborted requests - silently discard
output.
0.14 CHANGES:
* Reworked constructor to use IO::Async::Loop->listen(). Allows
specifying a specific hostname.
* Added Request->stream_stdout_then_finish().
* Combine small stream writes into larger ones, to gain overhead
efficiences over the TCP socket.
BUGFIXES:
* Respect the FCGI_KEEP_CONN flag to close connections if required
0.13 CHANGES:
* Updated for IO::Async 0.11:
+ IO::Async::Set is now ::Loop
+ IO::Async::Buffer is now ::Stream
+ Use of $loop->watch_child() in examples rather than hand-coded
around watching SIGCHLD directly.
0.12 BUGFIXES:
* Updated to IO::Async::Buffer 0.10 (method/event renames)
0.11 CHANGES:
* Allow Request->finish() to take an exitcode
BUGFIXES:
* Cope with environment parameters longer than 127 bytes
* Small updates to included 'example' scripts
0.10 CHANGES:
* Added CGI->FastCGI gateway example
BUGFIXES:
* Better handling of ->read_stdin_line()
0.09: CHANGES:
* Added 'fortune' example
* Better testing of connection reuse
* Support printing to STDERR FastCGI stream
0.08: CHANGES:
* First version to be based on IO::Async
0.07: CHANGES:
* Changed build system from ExtUtils::MakeMaker to Module::Build
Versions before this did not appear on CPAN, and no 'Changes' notes are
provided for them.
This diff is collapsed.
Build.PL
Changes
examples/envtest.fcgi
examples/exec-cgi.fcgi
examples/fortune.fcgi
examples/mintest.fcgi
examples/sample.cgi
lib/FCGI/Async.pm
lib/FCGI/Async/PSGI.pm
lib/Plack/Handler/FCGI/Async.pm
LICENSE
Makefile.PL
MANIFEST This list of files
META.yml
README
t/00use.t
t/01test.t
t/02fcgi-async.t
t/03psgi.t
t/04psgi-streaming.t
t/99pod.t
t/lib/TestFCGI.pm
---
abstract: 'use FastCGI with L<IO::Async>'
author:
- 'Paul Evans <leonerd@leonerd.org.uk>'
build_requires:
Test::HexString: 0
Test::More: 0
Test::Refcount: 0
configure_requires:
Module::Build: 0.36
generated_by: 'Module::Build version 0.3607'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: FCGI-Async
provides:
FCGI::Async:
file: lib/FCGI/Async.pm
version: 0.22
FCGI::Async::PSGI:
file: lib/FCGI/Async/PSGI.pm
version: 0.22
Plack::Handler::FCGI::Async:
file: lib/Plack/Handler/FCGI/Async.pm
version: 0.22
requires:
Net::Async::FastCGI: 0
resources:
license: http://dev.perl.org/licenses/
version: 0.22
# Note: this file was auto-generated by Module::Build::Compat version 0.3607
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'FCGI::Async',
'VERSION_FROM' => 'lib/FCGI/Async.pm',
'PREREQ_PM' => {
'Net::Async::FastCGI' => 0,
'Test::HexString' => 0,
'Test::More' => 0,
'Test::Refcount' => 0
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [],
'PL_FILES' => {}
)
;
NAME
"FCGI::Async" - use FastCGI with IO::Async
SYNOPSIS
use FCGI::Async;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new();
my $fcgi = FCGI::Async->new(
loop => $loop
service => 1234,
on_request => sub {
my ( $fcgi, $req ) = @_;
# Handle the request here
}
);
$loop->loop_forever;
DESCRIPTION
This subclass of Net::Async::FastCGI provides a slightly different API;
where it can take an argument containing the IO::Async::Loop object,
rather than be added as "Notifier" object within one. It is provided
mostly as a backward-compatibility wrapper for older code using this
interface; newer code ought to use the "Net::Async::FastCGI" interface
directly.
CONSTRUCTOR
$fcgi = FCGI::Async->new( %args )
Returns a new instance of a "FCGI::Async" object.
If either a "handle" or "service" argument are passed to the
constructor, then the newly-created object is added to the given
"IO::Async::Loop", then the "listen" method is invoked, passing the
entire %args hash to it.
If either of the above arguments are given, then a "IO::Async::Loop"
must also be provided:
loop => IO::Async::Loop
A reference to the "IO::Async::Loop" which will contain the
listening sockets.
AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
#!/usr/bin/perl -w
use strict;
use FCGI::Async;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new();
sub on_request
{
my ( $fcgi, $req ) = @_;
my $env = $req->params();
my $page = "";
my $path = $env->{PATH_INFO} || "/";
my $qs = $env->{QUERY_STRING} || "";
my %queryparams = map { m/^(.*?)=(.*)$/ && ( $1, $2 ) } split( m/&/, $qs );
$page = "<h1>Request Variables</h1>\n";
$page .= "<h2>Basics</h2>\n" .
"<p>Path: <tt>$path</tt></p>\n";
if ( keys %queryparams ) {
$page .= "<h2>Query parameters</h2>\n" .
"<table border=\"1\">\n";
foreach my $key ( sort keys %queryparams ) {
$page .= "<tr><td>$key</td><td><tt>$queryparams{$key}</tt></td></tr>\n";
}
$page .= "</table>\n";
}
$page .= "<h2>Environment variables</h2>\n";
$page .= "<table>\n";
foreach my $key ( sort keys %$env ) {
$page .= "<tr><td>$key</td><td><tt>$env->{$key}</tt></td></tr>\n";
}
$page .= "</table>\n";
$req->print_stdout(
"Content-type: text/html\r\n" .
"Content-length: " . length( $page ) . "\r\n" .
"\r\n" .
$page . "\r\n"
);
$req->finish();
}
my $fcgi = FCGI::Async->new(
handle => \*STDIN,
loop => $loop,
on_request => \&on_request,
);
$loop->loop_forever();
#!/usr/bin/perl -w
use strict;
use FCGI::Async;
use IO::Async::Stream;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new();
sub on_request
{
my ( $fcgi, $req ) = @_;
my %req_env = %{ $req->params };
# Determine these however you like; perhaps examine $req
my $handler = "./sample.cgi";
my @handler_args = ();
my $stdin = "";
while( defined( my $line = $req->read_stdin_line ) ) {
$stdin .= $line;
}
$fcgi->get_loop->open_child(
command => [ $handler, @handler_args ],
setup => [
env => \%req_env,
],
stdin => {
from => $stdin,
},
stdout => {
on_read => sub {
my ( undef, $buffref ) = @_;
$req->print_stdout( $$buffref );
$$buffref = "";
return 0;
},
},
stderr => {
on_read => sub {
my ( undef, $buffref ) = @_;
$req->print_stderr( $$buffref );
$$buffref = "";
return 0;
},
},
on_finish => sub {
my ( undef, $exitcode ) = @_;
$req->finish( $exitcode );
},
);
}
my $fcgi = FCGI::Async->new(
handle => \*STDIN,
loop => $loop,
on_request => \&on_request,
);
$loop->loop_forever();
#!/usr/bin/perl -w
use strict;
use FCGI::Async;
use IO::Async::Stream;
use IO::Async::Loop;
my $FORTUNE = "/usr/games/fortune";
my $loop = IO::Async::Loop->new();
sub on_request
{
my ( $fcgi, $req ) = @_;
my $kid = $fcgi->get_loop->open_child(
command => [ $FORTUNE ],
stdout => {
on_read => sub {
my ( undef, $buffref, $closed ) = @_;
if( $$buffref =~ s{^(.*?)\n}{} ) {
$req->print_stdout( "<p>$1</p>" );
return 1;
}
if( $closed ) {
# Deal with a final partial line the child may have written
$req->print_stdout( "<p>$$buffref</p>" ) if length $$buffref;
$req->print_stdout( "</body></html>" );
}
return 0;
},
},
stderr => {
on_read => sub {
my ( undef, $buffref, $closed ) = @_;
if( $$buffref =~ s{^(.*?)\n}{} ) {
$req->print_stderr( $1 );
return 1;
}
if( $closed ) {
# Deal with a final partial line the child may have written
$req->print_stderr( "$$buffref\n" ) if length $$buffref;
}
return 0;
},
},
on_finish => sub {
my ( undef, $exitcode ) = @_;
$req->finish( $exitcode );
},
);
if( !defined $kid ) {
$req->print_stdout(
"Content-type: text/plain\r\n" .
"\r\n" .
"Could not run $FORTUNE - $!\r\n"
);
$req->finish;
return;
}
# Print CGI header
$req->print_stdout(
"Content-type: text/html\r\n" .
"\r\n" .
"<html>" .
" <head><title>Fortune</title></head>" .
" <body><h1>$FORTUNE says:</h1>"
);
}
my $fcgi = FCGI::Async->new(
handle => \*STDIN,
loop => $loop,
on_request => \&on_request,
);
$loop->loop_forever();
#!/usr/bin/perl -w
use strict;
use FCGI::Async;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new();
sub on_request
{
my ( $fcgi, $req ) = @_;
my $env = $req->params();
my $path = $env->{PATH_INFO} || "/";
my $qs = $env->{QUERY_STRING};
my $method = $env->{REQUEST_METHOD} || "GET";
my $page = <<EOF;
<html>
<head>
<title>FCGI::Async testing page</title>
</head>
<body>
<h1>Path</h1><pre>$path</pre>
<h2>Query String</h2><pre>$qs</pre>
<h2>Method</h2><pre>$method</pre>
</body>
</html>
EOF
$req->print_stdout(
"Content-type: text/html\r\n" .
"Content-length: " . length( $page ) . "\r\n" .
"\r\n" .
$page . "\r\n"
);
$req->finish();
}
my $fcgi = FCGI::Async->new(
handle => \*STDIN,
loop => $loop,
on_request => \&on_request,
);
$loop->loop_forever();
#!/usr/bin/perl
use strict; use warnings;
use CGI;
my $c = new CGI;
if(defined($c->param("foo"))) {
print $c->header,
$c->start_html("Thanks for submitting the Foobar Form!"),
$c->h1("Foobar Form Results"),
"<hr />",
"<strong>Foorbar Form Results: ", $c->param('foo'), "<br />",
"Thanks for submitting!</strong>",
$c->end_html();
} else {
print $c->header,
$c->start_html("It's the Foobar Form!"),
'<form method="POST">',
'<input type="text" name="foo" value="bar" /><br />',
'<input type="submit" value="Submit the Foobar Form!" />',
'</form>',
$c->end_html();
}
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2011 -- leonerd@leonerd.org.uk
package FCGI::Async;
use strict;
use warnings;
use base qw( Net::Async::FastCGI );
our $VERSION = '0.22';
use Carp;
# Back compat
*MAX_CONNS = \$Net::Async::FastCGI::MAX_CONNS;
*MAX_REQS = \$Net::Async::FastCGI::MAX_REQS;
=head1 NAME
C<FCGI::Async> - use FastCGI with L<IO::Async>
=head1 SYNOPSIS
use FCGI::Async;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new();
my $fcgi = FCGI::Async->new(
loop => $loop
service => 1234,
on_request => sub {
my ( $fcgi, $req ) = @_;
# Handle the request here
}
);
$loop->loop_forever;
=head1 DESCRIPTION
This subclass of L<Net::Async::FastCGI> provides a slightly different API;
where it can take an argument containing the L<IO::Async::Loop> object, rather
than be added as C<Notifier> object within one. It is provided mostly as a
backward-compatibility wrapper for older code using this interface; newer
code ought to use the C<Net::Async::FastCGI> interface directly.
=cut
=head1 CONSTRUCTOR
=cut
=head2 $fcgi = FCGI::Async->new( %args )
Returns a new instance of a C<FCGI::Async> object.
If either a C<handle> or C<service> argument are passed to the constructor,
then the newly-created object is added to the given C<IO::Async::Loop>, then
the C<listen> method is invoked, passing the entire C<%args> hash to it.
If either of the above arguments are given, then a C<IO::Async::Loop> must
also be provided:
=over 4
=item loop => IO::Async::Loop
A reference to the C<IO::Async::Loop> which will contain the listening
sockets.
=back
=cut
sub new
{
my $class = shift;
my %args = @_;
my $loop = delete $args{loop};
my $self = $class->SUPER::new( %args );
if( defined $args{handle} ) {
$loop or croak "Require a 'loop' argument";
$loop->add( $self );
my $handle = delete $args{handle};
# IO::Async version 0.27 requires this to support ->sockname method
bless $handle, "IO::Socket" if ref($handle) eq "GLOB" and defined getsockname($handle);
$self->configure( handle => $handle );
}
elsif( defined $args{service} ) {
$loop or croak "Require a 'loop' argument";
$loop->add( $self );
$self->listen(
%args,
# listen wants some error handling callbacks. Since this is a
# constructor it's reasonable to provide default 'croak' ones if
# they're not supplied
on_resolve_error => sub { croak "Resolve error $_[0] while constructing a " . __PACKAGE__ },
on_listen_error => sub { croak "Cannot listen while constructing a " . __PACKAGE__ },
);
}
return $self;
}
# Keep perl happy; keep Britain tidy
1;
__END__
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2010 -- leonerd@leonerd.org.uk
package FCGI::Async::PSGI;
use strict;
use warnings;
use Carp;
use base qw( FCGI::Async );
our $VERSION = '0.22';
my $CRLF = "\x0d\x0a";
=head1 NAME
C<FCGI::Async::PSGI> - use C<PSGI> applications with C<FCGI::Async>
=head1 SYNOPSIS
use FCGI::Async::PSGI;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new;
my $fcgi = FCGI::Async::PSGI->new(
port => 12345,
app => sub {
my $env = shift;
return [
200,
[ "Content-Type" => "text/plain" ],
[ "Hello, world!" ],
];
},
);
$loop->add( $fcgi );
$loop->loop_forever;
=head1 DESCRIPTION
This subclass of L<FCGI::Async> allows a FastCGI responder to use a L<PSGI>
application to respond to requests. It acts as a gateway between the FastCGI
connection from the webserver, and the C<PSGI> application. Aside from the use
of C<PSGI> instead of the C<on_request> callback, this class behaves similarly
to C<FCGI::Async>.
=cut
sub new
{
# FCGI::Async's constructor tries to pass on all the args to $loop->listen
# so we need to pull out app, if present
my $class = shift;
my %args = @_;
my $app = delete $args{app};
my $self = $class->SUPER::new(
%args,
on_request => sub {
my $self = shift;
my ( $req ) = @_;
$self->process_request( $req );
},
);
$self->configure( app => $app ) if defined $app;
return $self;
}
=head1 PARAMETERS
The following named parameters may be passed to C<new> or C<configure>:
=over 8
=item app => CODE
Reference to the actual C<PSGI> application to use for responding to requests
=back
=cut
sub configure
{
my $self = shift;
my %args = @_;
if( exists $args{app} ) {
$self->{app} = delete $args{app};