AnyEvent-FCGI-0.04/t/AnyEvent-FCGI.t0000644000175100001670000000073511560242442016616 0ustar vkramskikhadmin# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl AnyEvent-FCGI.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 1; BEGIN { use_ok('AnyEvent::FCGI') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. AnyEvent-FCGI-0.04/t/0000755000175100001670000000000011560247133014167 5ustar vkramskikhadminAnyEvent-FCGI-0.04/lib/AnyEvent/FCGI/Request.pm0000644000175100001670000001657411560245503020735 0ustar vkramskikhadminpackage AnyEvent::FCGI::Request; =head1 NAME AnyEvent::FCGI::Request - a single FastCGI request handle for L =head1 SYNOPSIS use AnyEvent; use AnyEvent::FCGI; use CGI::Stateless; my $fcgi = new AnyEvent::FCGI( port => 9000, on_request => sub { my $request = shift; local *STDIN; open STDIN, '<', \$request->read_stdin; local %ENV = %{$request->params}; local $CGI::Q = new CGI::Stateless; $request->respond( 'Hello, ' . (CGI::param('name') || 'anonymous'), 'Content-Type' => 'text/html; charset=utf8', 'Set-Cookie' => 'cookie_a=1; path=/', 'Set-Cookie' => 'cookie_b=2; path=/', ); } ); AnyEvent->loop; =head1 DESCRIPTION This is the request object as generated by L. When given to the controlling program, each request will already have its parameters and STDIN data. The program can then write response data to the STDOUT stream, messages to the STDERR stream, and eventually finish it. This module would not be used directly by a program using C, but rather, objects in this class are passed into the C callback of the containing C object. =cut use strict; use warnings; use Scalar::Util qw/weaken/; sub new { my ($class, %params) = @_; my $self = bless { id => $params{id}, fcgi => $params{fcgi}, connection => $params{connection}, flags => $params{flags}, stdin => '', stdin_done => 0, params => {}, params_string => '', params_done => 0, used_stderr => 0, }, $class; weaken($self->{fcgi}); weaken($self->{connection}); return $self; } sub _ready_check { my $self = shift; if ($self->{stdin_done} && $self->{params_done} && $self->{fcgi}) { $self->{fcgi}->_request_ready($self); } } sub _process_stdin_record { my ($self, $record) = @_; if ($record->{length}) { $self->{stdin} .= $record->{content}; } else { $self->{stdin_done} = 1; } $self->_ready_check; } sub _process_params_record { my ($self, $record) = @_; if ($record->{length}) { $self->{params_string} .= $record->{content}; } else { $self->{params_done} = 1; my $data = $self->{params_string}; while (length $data) { my ($name_length, $value_length); foreach my $length ($name_length, $value_length) { ($length) = unpack('C', $data); if ($length & 0x80) { ($length) = unpack('N', $data); $length &= 0x7FFFFFFF; substr($data, 0, 4, ''); } else { substr($data, 0, 1, ''); } } my $name = substr($data, 0, $name_length, ''); my $value = substr($data, 0, $value_length, ''); $self->{params}->{$name} = $value; } $self->{params_string} = ''; } $self->_ready_check; } sub _send_record { my ($self, $record) = @_; if ($self->is_active) { $self->{connection}->send_record($record); } else { warn 'Cannot respond to inactive request'; } } sub _print_stream { my ($self, $data, $stream) = @_; while (length $data) { my $chunk = substr($data, 0, AnyEvent::FCGI::Connection->MAX_DATA_SIZE, ''); $self->_send_record({ request_id => $self->{id}, type => $stream, content => $chunk, }); } } =head1 METHODS =head2 is_active Returns false if the webserver has already closed the control connection. No further work on this request is necessary, as it will be discarded. This method can be used if response will not be sent immediately from C callback. =cut sub is_active { return defined shift->{connection}; } =head2 param($key) This method returns the value of a single request parameter, or C if no such key exists. =cut sub param { my ($self, $key) = @_; return $self->{params}->{$key}; } =head2 params This method returns a reference to a hash containing a copy of the request parameters that had been sent by the webserver as part of the request. =cut sub params { my ($self) = @_; return {%{$self->{params}}}; } =head2 read_stdin($size) This method works similarly to the C function. It returns the next block of up to $size bytes from the STDIN buffer. If no data is available any more, then C is returned instead. =cut sub read_stdin { my ($self, $size) = @_; $size ||= length $self->{stdin}; return length $self->{stdin} ? substr($self->{stdin}, 0, $size, '') : undef; } =head2 print_stdout($data) This method appends the given data to the STDOUT stream of the FastCGI request, sending it to the webserver to be sent to the client. =cut sub print_stdout { my ($self, $data) = @_; $self->_print_stream($data, AnyEvent::FCGI->FCGI_STDOUT); } =head2 print_stderr($data) This method appends the given data to the STDERR stream of the FastCGI request, sending it to the webserver. =cut sub print_stderr { my ($self, $data) = @_; $self->{used_stderr} = 1; $self->_print_stream($data, AnyEvent::FCGI->FCGI_STDERR); } =head2 finish When the request has been dealt with, this method should be called to indicate to the webserver that it is finished. After calling this method, no more data may be appended to the STDOUT stream. =cut sub finish { my ($self) = @_; if ($self->is_active) { $self->_send_record({ request_id => $self->{id}, type => AnyEvent::FCGI->FCGI_STDOUT, content => '', }); $self->_send_record({ request_id => $self->{id}, type => AnyEvent::FCGI->FCGI_STDERR, content => '', }) if $self->{used_stderr}; $self->_send_record({ request_id => $self->{id}, type => AnyEvent::FCGI->FCGI_END_REQUEST, content => pack('Ncccc', 0, AnyEvent::FCGI->FCGI_REQUEST_COMPLETE, 0, 0, 0), }); $self->{connection}->{io}->push_shutdown unless $self->{flags} & AnyEvent::FCGI->FCGI_KEEP_CONN; delete $self->{connection}->{requests}->{$self->{id}}; delete $self->{connection}; } else { warn 'Cannot finish inactive request'; } } =head2 respond($content, @headers) This method sends the response to the webserver and finishes the request. HTTP reply code can be specified in C header (200 by default). This method can be used instead of C and C. =cut sub respond { my ($self, $content, @headers) = @_; if ($self->is_active) { my $has_status; my $output = ''; while (scalar @headers) { my $header = shift @headers; $has_status = 1 if $header eq 'Status'; $output .= $header . ': ' . shift(@headers) . "\n"; } $output .= "Status: 200 OK\n" unless $has_status; $output .= "\n$content"; $self->print_stdout($output); $self->finish; } else { warn 'Cannot respond to inactive request'; } } 1; AnyEvent-FCGI-0.04/lib/AnyEvent/FCGI/Connection.pm0000644000175100001670000000725311307505427021401 0ustar vkramskikhadminpackage AnyEvent::FCGI::Connection; =head1 NAME AnyEvent::FCGI::Connection - a single connection handle for L =head1 DESCRIPTION This module represents a single connection for L This module would not be used directly by a program using C. =cut use strict; use warnings; use Scalar::Util qw/weaken refaddr/; use AnyEvent::Handle; use AnyEvent::FCGI::Request; use constant MAX_DATA_SIZE => 65535; sub new { my ($class, %params) = @_; my $self = bless { fcgi => $params{fcgi}, requests => {}, }, $class; $self->{io} = new AnyEvent::Handle( fh => $params{fh}, on_error => sub {$self->_on_error(@_)}, ); $self->{io}->push_read(chunk => 8, sub {$self->_on_read_header(@_)}); weaken($self->{fcgi}); return $self; } sub _on_error { my ($self, $io, $fatal, $message) = @_; if ($fatal) { $self->_shutdown; } } sub _shutdown { my ($self) = @_; $self->{requests} = {}; delete $self->{fcgi}->{connections}->{refaddr($self)}; } sub _on_read_header { my ($self, $io, $header) = @_; my %record; ( $record{version}, $record{type}, $record{request_id}, $record{length}, $record{padding}, undef ) = unpack('ccnncc', $header); $self->{record} = \%record; $io->push_read(chunk => ($record{length} + $record{padding}), sub {$self->_on_read_content(@_)}); } sub _on_read_content { my ($self, $io, $data) = @_; $self->{record}->{content} = substr($data, 0, $self->{record}->{length}); $self->_process_record($self->{record}); $io->push_read(chunk => 8, sub {$self->_on_read_header(@_)}); } sub _process_record { my ($self, $record) = @_; return unless $record->{version} == AnyEvent::FCGI->FCGI_VERSION_1; my $request = $self->{requests}->{$record->{request_id}}; if ($record->{type} == AnyEvent::FCGI->FCGI_BEGIN_REQUEST) { unless (defined $request) { my ($role, $flags) = unpack('nc', $record->{content}); if ($role == AnyEvent::FCGI->FCGI_RESPONDER) { $self->{requests}->{$record->{request_id}} = new AnyEvent::FCGI::Request( fcgi => $self->{fcgi}, connection => $self, flags => $flags, id => $record->{request_id}, ); } else { warn 'AnyEvent::FCGI supports only responder role'; } } else { warn "Request '$record->{request_id}' already running"; } } elsif ($record->{type} == AnyEvent::FCGI->FCGI_STDIN && defined $request) { $request->_process_stdin_record($record); } elsif ($record->{type} == AnyEvent::FCGI->FCGI_PARAMS && defined $request) { $request->_process_params_record($record); } elsif ($record->{type} == AnyEvent::FCGI->FCGI_ABORT_REQUEST && defined $request) { delete $request->{connection}; delete $self->{requests}->{$request->{id}}; } } sub send_record { my ($self, $record) = @_; if (length $record->{content} > MAX_DATA_SIZE) { warn 'Record content length > MAX_DATA_SIZE, truncating'; $record->{content} = substr($record->{content}, 0, MAX_DATA_SIZE); } $self->{io}->push_write( pack('ccnncc', AnyEvent::FCGI->FCGI_VERSION_1, $record->{type}, $record->{request_id}, length $record->{content}, 0, 0, ) . $record->{content} ); } sub DESTROY { my ($self) = @_; if ($self) { $self->_shutdown; } } 1; AnyEvent-FCGI-0.04/lib/AnyEvent/FCGI/0000755000175100001670000000000011560247133016733 5ustar vkramskikhadminAnyEvent-FCGI-0.04/lib/AnyEvent/FCGI.pm0000644000175100001670000000663011560242442017274 0ustar vkramskikhadminpackage AnyEvent::FCGI; =head1 NAME AnyEvent::FCGI - non-blocking FastCGI server =head1 SYNOPSIS use AnyEvent; use AnyEvent::FCGI; my $fcgi = new AnyEvent::FCGI( port => 9000, on_request => sub { my $request = shift; $request->respond( 'OH HAI! QUERY_STRING is ' . $request->param('QUERY_STRING'), 'Content-Type' => 'text/plain', ); } ); my $timer = AnyEvent->timer( after => 10, interval => 0, cb => sub { # shut down server after 10 seconds $fcgi = undef; } ); AnyEvent->loop; =head1 DESCRIPTION This module implements non-blocking FastCGI server for event based applications. =cut use strict; use warnings; our $VERSION = '0.04'; use Scalar::Util qw/weaken refaddr/; use AnyEvent; use AnyEvent::Socket; use AnyEvent::Handle; use AnyEvent::FCGI::Connection; use constant FCGI_VERSION_1 => 1; use constant FCGI_BEGIN_REQUEST => 1; use constant FCGI_ABORT_REQUEST => 2; use constant FCGI_END_REQUEST => 3; use constant FCGI_PARAMS => 4; use constant FCGI_STDIN => 5; use constant FCGI_STDOUT => 6; use constant FCGI_STDERR => 7; use constant FCGI_RESPONDER => 1; use constant FCGI_KEEP_CONN => 1; use constant FCGI_REQUEST_COMPLETE => 0; use constant FCGI_OVERLOADED => 2; use constant FCGI_UNKNOWN_ROLE => 3; =head1 METHODS =head2 new This function creates a new FastCGI server and returns a new instance of a C object. To shut down the server just remove all references to this object. =head3 PARAMETERS =over 4 =item port => $port The TCP port the FastCGI server will listen on. =item host => $host The TCP address of the FastCGI server will listen on. If undefined 0.0.0.0 will be used. =item socket => $path Path to UNIX domain socket to listen. If specified, C and C parameters ignored. =item on_request => sub { } Reference to a handler to call when a new FastCGI request is received. It will be invoked as $on_request->($request) where C<$request> will be a new L object. =item backlog => $backlog Optional. Integer number of socket backlog (listen queue) =back =cut sub new { my ($class, %params) = @_; my $self = bless { connections => {}, on_request_cb => $params{on_request}, }, $class; my $fcgi = $self; weaken($fcgi); $params{socket} ||= $params{unix}; $self->{server} = tcp_server( $params{socket} ? 'unix/' : $params{host}, $params{socket} || $params{port}, sub {$fcgi->_on_accept(shift)}, $params{backlog} ? sub {$params{backlog}} : undef ); return $self; } sub _on_accept { my ($self, $fh) = @_; if ($fh) { my $connection = new AnyEvent::FCGI::Connection(fcgi => $self, fh => $fh); $self->{connections}->{refaddr($connection)} = $connection; } } sub _request_ready { my ($self, $request) = @_; $self->{on_request_cb}->($request); } sub DESTROY { my ($self) = @_; if ($self) { $self->{connections} = {}; } } =head1 SEE ALSO L, L This module based on L and L. =head1 LICENSE This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 AUTHOR Vitaly Kramskikh, Evkramskih@cpan.orgE =cut 1; AnyEvent-FCGI-0.04/lib/AnyEvent/0000755000175100001670000000000011560247133016223 5ustar vkramskikhadminAnyEvent-FCGI-0.04/lib/0000755000175100001670000000000011560247133014472 5ustar vkramskikhadminAnyEvent-FCGI-0.04/Makefile.PL0000644000175100001670000000105211307505427015676 0ustar vkramskikhadminuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'AnyEvent::FCGI', VERSION_FROM => 'lib/AnyEvent/FCGI.pm', # finds $VERSION ABSTRACT_FROM => 'lib/AnyEvent/FCGI.pm', # retrieve abstract from module AUTHOR => 'Vitaly Kramskikh ', PREREQ_PM => { 'AnyEvent' => '5.2', 'Scalar::Util' => '1.21', 'Test::More' => 0 } ); AnyEvent-FCGI-0.04/MANIFEST0000644000175100001670000000020111560242442015044 0ustar vkramskikhadminChanges Makefile.PL MANIFEST t/AnyEvent-FCGI.t lib/AnyEvent/FCGI.pm lib/AnyEvent/FCGI/Connection.pm lib/AnyEvent/FCGI/Request.pm AnyEvent-FCGI-0.04/Changes0000644000175100001670000000054011560242442015214 0ustar vkramskikhadminRevision history for Perl extension AnyEvent::FCGI. 0.04 Wed May 4 15:45:31 YEKST 2011 - Added a backlog option to new method 0.03 Tue Dec 8 20:13:44 2009 - AnyEvent::FCGI::Request->respond can handle multiple headers with the same name 0.02 Fri Nov 13 13:42:11 2009 - minor pod fixes 0.01 Thu Nov 12 00:11:52 2009 - original version AnyEvent-FCGI-0.04/0000755000175100001670000000000011560243271013723 5ustar vkramskikhadmin