Net-Async-FastCGI-0.25000755001750001750 012110012063 13162 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/Changes000444001750001750 762012110012063 14617 0ustar00leoleo000000000000Revision history for Net-Async-FastCGI 0.25 CHANGES: * Import PSGI support from FCGI::Async directly here * Add some convenience methods to get often-used fields from request without needing to use ->param 0.24 CHANGES: * Correct SYNOPSIS examples to use ->listen rather than 'service' param * Import Exporter's 'import' function rather than 'use base'ing on Exporter 0.23 CHANGES: * Implement on_request as a normal IO::Async::Notifier-style event, so it works as a subclass too 0.22 CHANGES: * Split out from FCGI-Async; most code renamed * Net::Async::FastCGI::Protocol directly built on top of IO::Async::Protocol::Stream rather than overriding ::Stream directly and replacing some methods 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. Net-Async-FastCGI-0.25/META.json000444001750001750 402212110012063 14736 0ustar00leoleo000000000000{ "abstract" : "use FastCGI with L", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4001, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Async-FastCGI", "prereqs" : { "build" : { "requires" : { "Test::HexString" : "0", "Test::More" : "0", "Test::Refcount" : "0" } }, "runtime" : { "requires" : { "Encode" : "0", "Exporter" : "5.57", "HTTP::Request" : "0", "HTTP::Response" : "0", "IO::Async::Listener" : "0.35", "IO::Async::Loop" : "0.16", "IO::Async::Protocol::Stream" : "0.33", "IO::Async::Test" : "0", "Net::FastCGI::Constant" : "0.10", "Net::FastCGI::Protocol" : "0.10", "Tie::Handle" : "0" } } }, "provides" : { "Net::Async::FastCGI" : { "file" : "lib/Net/Async/FastCGI.pm", "version" : "0.25" }, "Net::Async::FastCGI::PSGI" : { "file" : "lib/Net/Async/FastCGI/PSGI.pm", "version" : "0.25" }, "Net::Async::FastCGI::Protocol" : { "file" : "lib/Net/Async/FastCGI/Protocol.pm", "version" : "0.25" }, "Net::Async::FastCGI::Request" : { "file" : "lib/Net/Async/FastCGI/Request.pm", "version" : "0.25" }, "Net::Async::FastCGI::ServerProtocol" : { "file" : "lib/Net/Async/FastCGI/ServerProtocol.pm", "version" : 0 }, "Plack::Handler::Net::Async::FastCGI" : { "file" : "lib/Plack/Handler/Net/Async/FastCGI.pm", "version" : "0.25" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.25" } Net-Async-FastCGI-0.25/README000444001750001750 1060012110012063 14214 0ustar00leoleo000000000000NAME `Net::Async::FastCGI' - use FastCGI with IO::Async SYNOPSIS As an adapter: use Net::Async::FastCGI; use IO::Async::Loop; my $loop = IO::Async::Loop->new(); my $fastcgi = Net::Async::FastCGI->new( on_request => sub { my ( $fastcgi, $req ) = @_; # Handle the request here } ); $loop->add( $fastcgi ); $fastcgi->listen( service => 1234, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, on_listen_error => sub { die "Cannot listen - $_[-1]\n" }, ); $loop->run; As a subclass: package MyFastCGIResponder; use base qw( Net::Async::FastCGI ); sub on_request { my $self = shift; my ( $req ) = @_; # Handle the request here } ... use IO::Async::Loop; my $loop = IO::Async::Loop->new(); my $fastcgi; $loop->add( $fastcgi = MyFastCGIResponder->new( service => 1234 ) ); $fastcgi->listen( service => 1234, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, on_listen_error => sub { die "Cannot listen - $_[-1]\n" }, ); $loop->run; DESCRIPTION This module allows a program to respond asynchronously to FastCGI requests, as part of a program based on IO::Async. An object in this class represents a single FastCGI responder that the webserver is configured to communicate with. It can handle multiple outstanding requests at a time, responding to each as data is provided by the program. Individual outstanding requests that have been started but not yet finished, are represented by instances of Net::Async::FastCGI::Request. EVENTS The following events are invoked, either using subclass methods or CODE references in parameters: on_request $req Invoked when a new FastCGI request is received. It will be passed a new Net::Async::FastCGI::Request object. PARAMETERS The following named parameters may be passed to `new' or `configure': on_request => CODE CODE references for `on_request' event handler. default_encoding => STRING Sets the default encoding used by all new requests. If not supplied then `UTF-8' will apply. METHODS $fcgi->listen( %args ) Start listening for connections on a socket, creating it first if necessary. This method may be called in either of the following ways. To listen on an existing socket filehandle: handle => IO An IO handle referring to a listen-mode socket. This is now deprecated; use the `handle' key to the `new' or `configure' methods instead. Or, to create the listening socket or sockets: service => STRING Port number or service name to listen on. host => STRING Optional. If supplied, the hostname will be resolved into a set of addresses, and one listening socket will be created for each address. If not, then all available addresses will be used. This method may also require `on_listen_error' or `on_resolve_error' callbacks for error handling - see IO::Async::Listener for more detail. Limits in FCGI_GET_VALUES The `FCGI_GET_VALUES' FastCGI request can enquire of the responder the maximum number of connections or requests it can support. Because this module puts no fundamental limit on these values, it will return some arbitrary numbers. These are given in package variables: $Net::Async::FastCGI::MAX_CONNS = 1024; $Net::Async::FastCGI::MAX_REQS = 1024; These variables are provided in case the containing application wishes to make the library return different values in the request. These values are not actually used by the library, other than to fill in the values in response of `FCGI_GET_VALUES'. Using a socket on STDIN When running a local FastCGI responder, the webserver will create a new INET socket connected to the script's STDIN file handle. To use the socket in this case, it should be passed as the `handle' argument. SEE ALSO * CGI::Fast - Fast CGI drop-in replacement of CGI; single-threaded, blocking mode. * http://hoohoo.ncsa.uiuc.edu/cgi/interface.html - The Common Gateway Interface Specification * http://www.fastcgi.com/devkit/doc/fcgi-spec.html - FastCGI Specification AUTHOR Paul Evans Net-Async-FastCGI-0.25/Build.PL000444001750001750 151012110012063 14610 0ustar00leoleo000000000000use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Net::Async::FastCGI', requires => { 'Encode' => 0, 'Exporter' => '5.57', 'HTTP::Request' => 0, 'HTTP::Response' => 0, 'IO::Async::Listener' => '0.35', 'IO::Async::Loop' => '0.16', 'IO::Async::Protocol::Stream' => '0.33', 'IO::Async::Test' => 0, 'Net::FastCGI::Constant' => '0.10', 'Net::FastCGI::Protocol' => '0.10', 'Tie::Handle' => 0, }, build_requires => { 'Test::HexString' => 0, 'Test::More' => 0, 'Test::Refcount' => 0, }, auto_configure_requires => 0, # Don't add M::B to configure_requires license => 'perl', create_makefile_pl => 'traditional', create_license => 1, create_readme => 1, ); $build->create_build_script; Net-Async-FastCGI-0.25/LICENSE000444001750001750 4376012110012063 14356 0ustar00leoleo000000000000This software is copyright (c) 2013 by Paul Evans . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Paul Evans . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Paul Evans . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Net-Async-FastCGI-0.25/META.yml000444001750001750 242612110012063 14574 0ustar00leoleo000000000000--- abstract: 'use FastCGI with L' author: - 'Paul Evans ' build_requires: Test::HexString: 0 Test::More: 0 Test::Refcount: 0 dynamic_config: 1 generated_by: 'Module::Build version 0.4001, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-Async-FastCGI provides: Net::Async::FastCGI: file: lib/Net/Async/FastCGI.pm version: 0.25 Net::Async::FastCGI::PSGI: file: lib/Net/Async/FastCGI/PSGI.pm version: 0.25 Net::Async::FastCGI::Protocol: file: lib/Net/Async/FastCGI/Protocol.pm version: 0.25 Net::Async::FastCGI::Request: file: lib/Net/Async/FastCGI/Request.pm version: 0.25 Net::Async::FastCGI::ServerProtocol: file: lib/Net/Async/FastCGI/ServerProtocol.pm version: 0 Plack::Handler::Net::Async::FastCGI: file: lib/Plack/Handler/Net/Async/FastCGI.pm version: 0.25 requires: Encode: 0 Exporter: 5.57 HTTP::Request: 0 HTTP::Response: 0 IO::Async::Listener: 0.35 IO::Async::Loop: 0.16 IO::Async::Protocol::Stream: 0.33 IO::Async::Test: 0 Net::FastCGI::Constant: 0.10 Net::FastCGI::Protocol: 0.10 Tie::Handle: 0 resources: license: http://dev.perl.org/licenses/ version: 0.25 Net-Async-FastCGI-0.25/MANIFEST000444001750001750 156112110012063 14453 0ustar00leoleo000000000000Build.PL Changes examples/envtest.fcgi examples/exec-cgi.fcgi examples/fortune.fcgi examples/mintest.fcgi examples/sample.cgi lib/Net/Async/FastCGI.pm lib/Net/Async/FastCGI/Protocol.pm lib/Net/Async/FastCGI/PSGI.pm lib/Net/Async/FastCGI/Request.pm lib/Net/Async/FastCGI/ServerProtocol.pm lib/Plack/Handler/Net/Async/FastCGI.pm LICENSE Makefile.PL MANIFEST This list of files META.json META.yml psgifiles/counter.psgi psgifiles/env.psgi psgifiles/helloworld.psgi psgifiles/sleepy.psgi README t/00use.t t/01test.t t/02request-minimal.t t/03request-full.t t/04request-reuse.t t/05request-multiplex.t t/06request-binary.t t/07request-longparams.t t/08request-shortwrites.t t/09request-streamstdout.t t/10request-close.t t/11request-encoding.t t/12request-unknown.t t/13request-handles.t t/20get_values.t t/30request-HTTP.t t/40psgi.t t/41psgi-streaming.t t/99pod.t t/lib/TestFCGI.pm Net-Async-FastCGI-0.25/Makefile.PL000444001750001750 165712110012063 15302 0ustar00leoleo000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4001 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Net::Async::FastCGI', 'VERSION_FROM' => 'lib/Net/Async/FastCGI.pm', 'PREREQ_PM' => { 'Encode' => 0, 'Exporter' => '5.57', 'HTTP::Request' => 0, 'HTTP::Response' => 0, 'IO::Async::Listener' => '0.35', 'IO::Async::Loop' => '0.16', 'IO::Async::Protocol::Stream' => '0.33', 'IO::Async::Test' => 0, 'Net::FastCGI::Constant' => '0.10', 'Net::FastCGI::Protocol' => '0.10', 'Test::HexString' => 0, 'Test::More' => 0, 'Test::Refcount' => 0, 'Tie::Handle' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Net-Async-FastCGI-0.25/lib000755001750001750 012110012063 13730 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/lib/Net000755001750001750 012110012063 14456 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/lib/Net/Async000755001750001750 012110012063 15533 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/lib/Net/Async/FastCGI.pm000444001750001750 1346312110012063 17475 0ustar00leoleo000000000000# 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, 2005-2013 -- leonerd@leonerd.org.uk package Net::Async::FastCGI; use strict; use warnings; use Carp; use base qw( IO::Async::Listener ); IO::Async::Listener->VERSION( '0.35' ); use Net::Async::FastCGI::ServerProtocol; our $VERSION = '0.25'; # The FCGI_GET_VALUES request might ask for our maximally supported number of # concurrent connections or requests. We don't really have an inbuilt maximum, # so just respond these large numbers our $MAX_CONNS = 1024; our $MAX_REQS = 1024; =head1 NAME C - use FastCGI with L =head1 SYNOPSIS As an adapter: use Net::Async::FastCGI; use IO::Async::Loop; my $loop = IO::Async::Loop->new(); my $fastcgi = Net::Async::FastCGI->new( on_request => sub { my ( $fastcgi, $req ) = @_; # Handle the request here } ); $loop->add( $fastcgi ); $fastcgi->listen( service => 1234, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, on_listen_error => sub { die "Cannot listen - $_[-1]\n" }, ); $loop->run; As a subclass: package MyFastCGIResponder; use base qw( Net::Async::FastCGI ); sub on_request { my $self = shift; my ( $req ) = @_; # Handle the request here } ... use IO::Async::Loop; my $loop = IO::Async::Loop->new(); my $fastcgi; $loop->add( $fastcgi = MyFastCGIResponder->new( service => 1234 ) ); $fastcgi->listen( service => 1234, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, on_listen_error => sub { die "Cannot listen - $_[-1]\n" }, ); $loop->run; =head1 DESCRIPTION This module allows a program to respond asynchronously to FastCGI requests, as part of a program based on L. An object in this class represents a single FastCGI responder that the webserver is configured to communicate with. It can handle multiple outstanding requests at a time, responding to each as data is provided by the program. Individual outstanding requests that have been started but not yet finished, are represented by instances of L. =cut =head1 EVENTS The following events are invoked, either using subclass methods or CODE references in parameters: =head2 on_request $req Invoked when a new FastCGI request is received. It will be passed a new L object. =cut =head1 PARAMETERS The following named parameters may be passed to C or C: =over 8 =item on_request => CODE CODE references for C event handler. =item default_encoding => STRING Sets the default encoding used by all new requests. If not supplied then C will apply. =back =cut sub _init { my $self = shift; my ( $params ) = @_; $self->SUPER::_init( $params ); $params->{default_encoding} = "UTF-8"; } sub configure { my $self = shift; my %params = @_; if( exists $params{on_request} ) { $self->{on_request} = delete $params{on_request}; } if( exists $params{default_encoding} ) { $self->{default_encoding} = delete $params{default_encoding}; } $self->SUPER::configure( %params ); } sub on_stream { my $self = shift; my ( $stream ) = @_; $self->add_child( Net::Async::FastCGI::ServerProtocol->new( transport => $stream, fcgi => $self, ) ); } =head1 METHODS =cut =head2 $fcgi->listen( %args ) Start listening for connections on a socket, creating it first if necessary. This method may be called in either of the following ways. To listen on an existing socket filehandle: =over 4 =item handle => IO An IO handle referring to a listen-mode socket. This is now deprecated; use the C key to the C or C methods instead. =back Or, to create the listening socket or sockets: =over 4 =item service => STRING Port number or service name to listen on. =item host => STRING Optional. If supplied, the hostname will be resolved into a set of addresses, and one listening socket will be created for each address. If not, then all available addresses will be used. =back This method may also require C or C callbacks for error handling - see L for more detail. =cut sub listen { my $self = shift; my %args = @_; $self->SUPER::listen( %args, socktype => 'stream' ); } sub _request_ready { my $self = shift; my ( $req ) = @_; $self->invoke_event( on_request => $req ); } sub _default_encoding { my $self = shift; return $self->{default_encoding}; } =head1 Limits in FCGI_GET_VALUES The C FastCGI request can enquire of the responder the maximum number of connections or requests it can support. Because this module puts no fundamental limit on these values, it will return some arbitrary numbers. These are given in package variables: $Net::Async::FastCGI::MAX_CONNS = 1024; $Net::Async::FastCGI::MAX_REQS = 1024; These variables are provided in case the containing application wishes to make the library return different values in the request. These values are not actually used by the library, other than to fill in the values in response of C. =head1 Using a socket on STDIN When running a local FastCGI responder, the webserver will create a new INET socket connected to the script's STDIN file handle. To use the socket in this case, it should be passed as the C argument. =head1 SEE ALSO =over 4 =item * L - Fast CGI drop-in replacement of L; single-threaded, blocking mode. =item * L - The Common Gateway Interface Specification =item * L - FastCGI Specification =back =head1 AUTHOR Paul Evans =cut 0x55AA; Net-Async-FastCGI-0.25/lib/Net/Async/FastCGI000755001750001750 012110012063 16753 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/lib/Net/Async/FastCGI/ServerProtocol.pm000444001750001750 634212110012063 22443 0ustar00leoleo000000000000# 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, 2005-2011 -- leonerd@leonerd.org.uk package Net::Async::FastCGI::ServerProtocol; use strict; use warnings; use base qw( Net::Async::FastCGI::Protocol ); use IO::Async::Stream 0.33; use Net::FastCGI::Constant qw( FCGI_VERSION_1 :type :role :protocol_status ); use Net::FastCGI::Protocol qw( build_params parse_params parse_begin_request_body build_end_request_body ); use Net::Async::FastCGI::Request; sub _init { my $self = shift; my ( $params ) = @_; $self->{fcgi} = delete $params->{fcgi}; $self->{reqs} = {}; # {$reqid} = $req } sub on_closed { my ( $self ) = @_; $_->_abort for values %{ $self->{reqs} }; # TODO: This might want to live in IO::Async::Protocol if( my $parent = $self->parent ) { $parent->remove_child( $self ); } } sub on_mgmt_record { my $self = shift; my ( $type, $rec ) = @_; return $self->_get_values( $rec ) if $type == FCGI_GET_VALUES; return $self->SUPER::on_mgmt_record( $type, $rec ); } sub on_record { my $self = shift; my ( $reqid, $rec ) = @_; my $type = $rec->{type}; if( $type == FCGI_BEGIN_REQUEST ) { ( my $role, $rec->{flags} ) = parse_begin_request_body( $rec->{content} ); if( $role == FCGI_RESPONDER ) { my $req = Net::Async::FastCGI::Request->new( conn => $self, fcgi => $self->{fcgi}, rec => $rec, ); $self->{reqs}->{$reqid} = $req; } else { $self->write_record( { type => FCGI_END_REQUEST, reqid => $rec->{reqid} }, build_end_request_body( 0, FCGI_UNKNOWN_ROLE ) ); } return; } # FastCGI spec says we're supposed to ignore any record apart from # FCGI_BEGIN_REQUEST on unrecognised request IDs my $req = $self->{reqs}->{$reqid} or return; $req->incomingrecord( $rec ); } sub _req_needs_flush { my $self = shift; $self->{gensub_queued}++ or $self->write( sub { my ( $self ) = @_; undef $self->{gensub_queued}; my $want_more = 0; foreach my $req ( values %{ $self->{reqs} } ) { $req->_flush_streams; $want_more = 1 if $req->_needs_flush; } $self->_req_needs_flush if $want_more; return undef; } ); } sub _removereq { my $self = shift; my ( $reqid ) = @_; delete $self->{reqs}->{$reqid}; } sub _get_values { my $self = shift; my ( $rec ) = @_; my $content = $rec->{content}; my $ret = ""; foreach my $name ( keys %{ parse_params( $content ) } ) { my $value = $self->_get_value( $name ); if( defined $value ) { $ret .= build_params( { $name => $value } ); } } $self->write_record( { type => FCGI_GET_VALUES_RESULT, reqid => 0, }, $ret ); } # This is a method so subclasses could hook extra values if they want sub _get_value { my $self = shift; my ( $name ) = @_; return 1 if $name eq "FCGI_MPXS_CONNS"; return $Net::Async::FastCGI::MAX_CONNS if $name eq "FCGI_MAX_CONNS"; return $Net::Async::FastCGI::MAX_REQS if $name eq "FCGI_MAX_REQS"; return undef; } 0x55AA; Net-Async-FastCGI-0.25/lib/Net/Async/FastCGI/Request.pm000444001750001750 4315512110012063 21126 0ustar00leoleo000000000000# 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, 2005-2013 -- leonerd@leonerd.org.uk package Net::Async::FastCGI::Request; use strict; use warnings; use Carp; use Net::FastCGI::Constant qw( :type :flag :protocol_status ); use Net::FastCGI::Protocol qw( parse_params build_end_request_body ); # The largest amount of data we can fit in a FastCGI record - MUST NOT # be greater than 2^16-1 use constant MAXRECORDDATA => 65535; use Encode qw( find_encoding ); use POSIX qw( EAGAIN ); our $VERSION = '0.25'; my $CRLF = "\x0d\x0a"; =head1 NAME C - a single active FastCGI request =head1 SYNOPSIS use Net::Async::FastCGI; use IO::Async::Loop; my $fcgi = Net::Async::FastCGI->new( on_request => sub { my ( $fcgi, $req ) = @_; my $path = $req->param( "PATH_INFO" ); $req->print_stdout( "Status: 200 OK\r\n" . "Content-type: text/plain\r\n" . "\r\n" . "You requested $path" ); $req->finish(); } ); my $loop = IO::Async::Loop->new(); $loop->add( $fcgi ); $loop->run; =head1 DESCRIPTION Instances of this object class represent individual requests received from the webserver that are currently in-progress, and have not yet been completed. 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 event of the containing C object. =cut sub new { my $class = shift; my %args = @_; my $rec = $args{rec}; my $self = bless { conn => $args{conn}, fcgi => $args{fcgi}, reqid => $rec->{reqid}, keepconn => $rec->{flags} & FCGI_KEEP_CONN, stdin => "", stdindone => 0, params => {}, paramsdone => 0, stdout => "", stderr => "", used_stderr => 0, }, $class; $self->set_encoding( $args{fcgi}->_default_encoding ); return $self; } sub write_record { my $self = shift; my ( $rec ) = @_; return if $self->is_aborted; my $content = $rec->{content}; my $contentlen = length( $content ); if( $contentlen > MAXRECORDDATA ) { warn __PACKAGE__."->write_record() called with content longer than ".MAXRECORDDATA." bytes - truncating"; $content = substr( $content, 0, MAXRECORDDATA ); } $rec->{reqid} = $self->{reqid} unless defined $rec->{reqid}; my $conn = $self->{conn}; $conn->write_record( $rec, $content ); } sub incomingrecord { my $self = shift; my ( $rec ) = @_; my $type = $rec->{type}; if( $type == FCGI_PARAMS ) { $self->incomingrecord_params( $rec ); } elsif( $type == FCGI_STDIN ) { $self->incomingrecord_stdin( $rec ); } else { warn "$self just received unknown record type"; } } sub _ready_check { my $self = shift; if( $self->{stdindone} and $self->{paramsdone} ) { $self->{fcgi}->_request_ready( $self ); } } sub incomingrecord_params { my $self = shift; my ( $rec ) = @_; my $content = $rec->{content}; my $len = $rec->{len}; if( $len ) { no warnings 'uninitialized'; $self->{paramscontent} .= $content; return; } else { $self->{params} = parse_params( delete $self->{paramscontent} ); $self->{paramsdone} = 1; } $self->_ready_check; } sub incomingrecord_stdin { my $self = shift; my ( $rec ) = @_; my $content = $rec->{content}; my $len = $rec->{len}; if( $len ) { $self->{stdin} .= $content; } else { $self->{stdindone} = 1; } $self->_ready_check; } =head1 METHODS =cut =head2 $hashref = $req->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 = shift; my %p = %{$self->{params}}; return \%p; } =head2 $p = $req->param( $key ) This method returns the value of a single request parameter, or C if no such key exists. =cut sub param { my $self = shift; my ( $key ) = @_; return $self->{params}{$key}; } =head2 $method = $req->method Returns the value of the C parameter, or C if there is no value set for it. =cut sub method { my $self = shift; return $self->param( "REQUEST_METHOD" ) || "GET"; } =head2 $script_name = $req->script_name Returns the value of the C parameter. =cut sub script_name { my $self = shift; return $self->param( "SCRIPT_NAME" ); } =head2 $path_info = $req->path_info Returns the value of the C parameter. =cut sub path_info { my $self = shift; return $self->param( "PATH_INFO" ); } =head2 $path = $req->path Returns the full request path by reconstructing it from C and C. =cut sub path { my $self = shift; my $path = join "", grep defined && length, $self->script_name, $self->path_info; $path = "/" if !length $path; return $path; } =head2 $query_string = $req->query_string Returns the value of the C parameter. =cut sub query_string { my $self = shift; return $self->param( "QUERY_STRING" ) || ""; } =head2 $protocol = $req->protocol Returns the value of the C parameter. =cut sub protocol { my $self = shift; return $self->param( "SERVER_PROTOCOL" ); } =head2 $req->set_encoding( $encoding ) Sets the character encoding used by the request's STDIN, STDOUT and STDERR streams. This method may be called at any time to change the encoding in effect, which will be used the next time C, C, C or C are called. This encoding will remain in effect until changed again. The encoding of a new request is determined by the C parameter of the containing C object. If the value C is passed, the encoding will be removed, and the above methods will work directly on bytes instead of encoded strings. =cut sub set_encoding { my $self = shift; my ( $encoding ) = @_; if( defined $encoding ) { my $codec = find_encoding( $encoding ); defined $codec or croak "Unrecognised encoding '$encoding'"; $self->{codec} = $codec; } else { undef $self->{codec}; } } =head2 $line = $req->read_stdin_line This method works similarly to the C<< >> operator. If at least one line of data is available then it is returned, including the linefeed, and removed from the buffer. If not, then any remaining partial line is returned and removed from the buffer. If no data is available any more, then C is returned instead. =cut sub read_stdin_line { my $self = shift; my $codec = $self->{codec}; if( $self->{stdin} =~ s/^(.*[\r\n])// ) { return $codec ? $codec->decode( $1 ) : $1; } elsif( $self->{stdin} =~ s/^(.+)// ) { return $codec ? $codec->decode( $1 ) : $1; } else { return undef; } } =head2 $data = $req->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. If $size is not defined, then it will return all the available data. =cut sub read_stdin { my $self = shift; my ( $size ) = @_; return undef unless length $self->{stdin}; $size = length $self->{stdin} unless defined $size; my $codec = $self->{codec}; # If $size is too big, substr() will cope my $bytes = substr( $self->{stdin}, 0, $size, "" ); return $codec ? $codec->decode( $bytes ) : $bytes; } sub _print_stream { my $self = shift; my ( $data, $stream ) = @_; while( length $data ) { # Send chunks of up to MAXRECORDDATA bytes at once my $chunk = substr( $data, 0, MAXRECORDDATA, "" ); $self->write_record( { type => $stream, content => $chunk } ); } } sub _flush_streams { my $self = shift; if( length $self->{stdout} ) { $self->_print_stream( $self->{stdout}, FCGI_STDOUT ); $self->{stdout} = ""; } elsif( my $cb = $self->{stdout_cb} ) { $cb->(); } if( length $self->{stderr} ) { $self->_print_stream( $self->{stderr}, FCGI_STDERR ); $self->{stderr} = ""; } } sub _needs_flush { my $self = shift; return defined $self->{stdout_cb}; } =head2 $req->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 = shift; my ( $data ) = @_; my $codec = $self->{codec}; $self->{stdout} .= $codec ? $codec->encode( $data ) : $data; $self->{conn}->_req_needs_flush( $self ); } =head2 $req->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 = shift; my ( $data ) = @_; my $codec = $self->{codec}; $self->{used_stderr} = 1; $self->{stderr} .= $codec ? $codec->encode( $data ) : $data; $self->{conn}->_req_needs_flush( $self ); } =head2 $req->stream_stdout_then_finish( $readfn, $exitcode ) This method installs a callback for streaming data to the STDOUT stream. Whenever the output stream is otherwise-idle, the function will be called to generate some more data to output. When this function returns C it indicates the end of the stream, and the request will be finished with the given exit code. If this method is used, then care should be taken to ensure that the number of bytes written to the server matches the number that was claimed in the C, if such was provided. This logic should be performed by the containing application; C will not track it. =cut sub stream_stdout_then_finish { my $self = shift; my ( $readfn, $exitcode ) = @_; $self->{stdout_cb} = sub { my $data = $readfn->(); if( defined $data ) { $self->print_stdout( $data ); } else { delete $self->{stdout_cb}; $self->finish( $exitcode ); } }; $self->{conn}->_req_needs_flush( $self ); } =head2 $stdin = $req->stdin Returns an IO handle representing the request's STDIN buffer. This may be read from using the C or C functions or the C<< <$stdin> >> operator. Note that this will be a tied IO handle, it will not be useable directly as an OS-level filehandle. =cut sub stdin { my $self = shift; return Net::Async::FastCGI::Request::TiedHandle->new( READ => sub { $_[1] = $self->read_stdin( $_[2] ); return defined $_[1] ? length $_[1] : 0; }, READLINE => sub { return $self->read_stdin_line; }, ); } =head2 $stdout = $req->stdout =head2 $stderr = $req->stderr Returns an IO handle representing the request's STDOUT or STDERR streams respectively. These may written to using C, C, C, etc.. Note that these will be tied IO handles, they will not be useable directly as an OS-level filehandle. =cut sub _stdouterr { my $self = shift; my ( $method ) = @_; return Net::Async::FastCGI::Request::TiedHandle->new( WRITE => sub { $self->$method( $_[1] ) }, ); } sub stdout { return shift->_stdouterr( "print_stdout" ); } sub stderr { return shift->_stdouterr( "print_stderr" ); } =head2 $req->finish( $exitcode ) 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. At some point after calling this method, the request object will be removed from the containing C object, once all the buffered outbound data has been sent. If present, C<$exitcode> should indicate the numeric status code to send to the webserver. If absent, a value of C<0> is presumed. =cut sub finish { my $self = shift; my ( $exitcode ) = @_; return if $self->is_aborted; $self->_flush_streams; # Signal the end of STDOUT $self->write_record( { type => FCGI_STDOUT, content => "" } ); # Signal the end of STDERR if we used it $self->write_record( { type => FCGI_STDERR, content => "" } ) if $self->{used_stderr}; $self->write_record( { type => FCGI_END_REQUEST, content => build_end_request_body( $exitcode || 0, FCGI_REQUEST_COMPLETE ) } ); my $conn = $self->{conn}; if( $self->{keepconn} ) { $conn->_removereq( $self->{reqid} ); } else { $conn->close; } } =head2 $stdout = $req->stdout_with_close Similar to the C method, except that when the C method is called on the returned filehandle, the request will be finished by calling C. =cut sub stdout_with_close { my $self = shift; return Net::Async::FastCGI::Request::TiedHandle->new( WRITE => sub { $self->print_stdout( $_[1] ) }, CLOSE => sub { $self->finish( 0 ) }, ); } sub _abort { my $self = shift; $self->{aborted} = 1; my $conn = $self->{conn}; $conn->_removereq( $self->{reqid} ); delete $self->{stdout_cb}; } =head2 $req->is_aborted Returns true if the webserver has already closed the control connection. No further work on this request is necessary, as it will be discarded. It is not required to call this method; if the request is aborted then any output will be discarded. It may however be useful to call just before expensive operations, in case effort can be avoided if it would otherwise be wasted. =cut sub is_aborted { my $self = shift; return $self->{aborted}; } =head1 HTTP::Request/Response Interface The following pair of methods form an interface that allows the request to be used as a source of L objects, responding to them by sending L objects. This may be useful to fit it in to existing code that already uses these. =cut =head2 $http_req = $req->as_http_request Returns a new C object that gives a reasonable approximation to the request. Because the webserver has translated the original HTTP request into FastCGI parameters, this may not be a perfect recreation of the request as received by the webserver. =cut sub as_http_request { my $self = shift; require HTTP::Request; my $params = $self->params; my $authority = ( $params->{HTTP_HOST} || $params->{SERVER_NAME} || "" ) . ":" . ( $params->{SERVER_PORT} || "80" ); my $path = $self->path; my $query_string = $self->query_string; $path .= "?$query_string" if length $query_string; my $uri = URI->new( "http://$authority$path" )->canonical; my @headers; # Content-Type and Content-Length come specially push @headers, "Content-Type" => $params->{CONTENT_TYPE} if exists $params->{CONTENT_TYPE}; push @headers, "Content-Length" => $params->{CONTENT_LENGTH} if exists $params->{CONTENT_LENGTH}; # Pull all the HTTP_FOO parameters as headers. These will be in all-caps # and use _ for word separators, but HTTP::Headers can cope foreach ( keys %$params ) { m/^HTTP_(.*)$/ and push @headers, $1 => $params->{$_}; } my $content = $self->{stdin}; my $req = HTTP::Request->new( $self->method, $uri, \@headers, $content ); $req->protocol( $self->protocol ); return $req; } =head2 $req->send_http_response( $resp ) Sends the given C object as the response to this request. The status, headers and content are all written out to the request's STDOUT stream and then the request is finished with 0 as the exit code. =cut sub send_http_response { my $self = shift; my ( $resp ) = @_; # (Fast)CGI suggests this is the way to report the status $resp->header( Status => $resp->code ); my $topline = $resp->protocol . " " . $resp->status_line; $self->print_stdout( $topline . $CRLF ); $self->print_stdout( $resp->headers_as_string( $CRLF ) ); $self->print_stdout( $CRLF ); $self->print_stdout( $resp->content ); $self->finish( 0 ); } package # hide from CPAN Net::Async::FastCGI::Request::TiedHandle; use base qw( Tie::Handle ); use Symbol qw( gensym ); sub new { my $class = shift; my $handle = gensym; tie *$handle, $class, @_; return $handle; } sub TIEHANDLE { my $class = shift; return bless { @_ }, $class; } sub CLOSE { shift->{CLOSE}->( @_ ) } sub READ { shift->{READ}->( @_ ) } sub READLINE { shift->{READLINE}->( @_ ) } sub WRITE { shift->{WRITE}->( @_ ) } =head1 EXAMPLES =head2 Streaming A File To serve contents of files on disk, it may be more efficient to use C: use Net::Async::FastCGI; use IO::Async::Loop; my $fcgi = Net::Async::FastCGI->new( on_request => sub { my ( $fcgi, $req ) = @_; open( my $file, "<", "/path/to/file" ); $req->print_stdout( "Status: 200 OK\r\n" . "Content-type: application/octet-stream\r\n" . "\r\n" ); $req->stream_stdout_then_finish( sub { read( $file, my $buffer, 8192 ) or return undef; return $buffer }, 0 ); } my $loop = IO::Async::Loop->new(); $loop->add( $fcgi ); $loop->run; It may be more efficient again to instead use the C feature of certain webservers, which allows the webserver itself to serve the file efficiently. See your webserver's documentation for more detail. =head1 AUTHOR Paul Evans =cut 0x55AA; Net-Async-FastCGI-0.25/lib/Net/Async/FastCGI/Protocol.pm000444001750001750 333612110012063 21254 0ustar00leoleo000000000000# 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-2011 -- leonerd@leonerd.org.uk package Net::Async::FastCGI::Protocol; use strict; use warnings; use base qw( IO::Async::Protocol::Stream ); our $VERSION = '0.25'; use Net::FastCGI::Constant qw( FCGI_UNKNOWN_TYPE ); use Net::FastCGI::Protocol qw( parse_header build_record build_unknown_type_body ); sub on_read { my $self = shift; my ( $buffref, $handleclosed ) = @_; my $blen = length $$buffref; if( $handleclosed ) { # Abort my $fcgi = $self->{fcgi}; $fcgi->remove_child( $self ); return; } # Do we have a record header yet? return 0 unless( $blen >= 8 ); # Excellent - parse it my ( $type, $reqid, $contentlen, $padlen ) = parse_header( $$buffref ); # Do we have enough for a complete record? return 0 unless( $blen >= 8 + $contentlen + $padlen ); substr( $$buffref, 0, 8, "" ); # Header my $rec = { type => $type, reqid => $reqid, len => $contentlen, plen => $padlen, }; $rec->{content} = substr( $$buffref, 0, $contentlen, "" ); substr( $$buffref, 0, $rec->{plen}, "" ); # Padding if( $reqid == 0 ) { $self->on_mgmt_record( $type, $rec ); } else { $self->on_record( $reqid, $rec ); } return 1; } sub on_mgmt_record { my $self = shift; my ( $type, $rec ) = @_; $self->write_record( { type => FCGI_UNKNOWN_TYPE, reqid => 0 }, build_unknown_type_body( $type ) ); } sub write_record { my $self = shift; my ( $rec, $content ) = @_; $self->write( build_record( $rec->{type}, $rec->{reqid}, $content ) ); } 0x55AA; Net-Async-FastCGI-0.25/lib/Net/Async/FastCGI/PSGI.pm000444001750001750 776112110012063 20223 0ustar00leoleo000000000000# 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-2013 -- leonerd@leonerd.org.uk package Net::Async::FastCGI::PSGI; use strict; use warnings; use Carp; use base qw( Net::Async::FastCGI ); our $VERSION = '0.25'; my $CRLF = "\x0d\x0a"; =head1 NAME C - use C applications with C =head1 SYNOPSIS use Net::Async::FastCGI::PSGI; use IO::Async::Loop; my $loop = IO::Async::Loop->new; my $fcgi = Net::Async::FastCGI::PSGI->new( port => 12345, app => sub { my $env = shift; return [ 200, [ "Content-Type" => "text/plain" ], [ "Hello, world!" ], ]; }, ); $loop->add( $fcgi ); $loop->run; =head1 DESCRIPTION This subclass of L allows a FastCGI responder to use a L application to respond to requests. It acts as a gateway between the FastCGI connection from the webserver, and the C application. Aside from the use of C instead of the C event, this class behaves similarly to C. =cut =head1 PARAMETERS The following named parameters may be passed to C or C: =over 8 =item app => CODE Reference to the actual C 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}; } $self->SUPER::configure( %args ); } =head1 PSGI ENVIRONMENT The following extra keys are supplied to the environment of the C app: =over 8 =item C The C object serving the request =item C The L object representing this particular request =item C The L object that the C object is a member of. =back =cut sub on_request { my $self = shift; my ( $req ) = @_; # Much of this code stolen fro^W^Winspired by Plack::Handler::Net::FastCGI my %env = ( %{ $req->params }, 'psgi.version' => [1,0], 'psgi.url_scheme' => ($req->param("HTTPS")||"off") =~ m/^(?:on|1)/i ? "https" : "http", 'psgi.input' => $req->stdin, 'psgi.errors' => $req->stderr, 'psgi.multithread' => 0, 'psgi.multiprocess' => 0, 'psgi.run_once' => 0, 'psgi.nonblocking' => 1, 'psgi.streaming' => 1, # Extensions 'net.async.fastcgi' => $self, 'net.async.fastcgi.req' => $req, 'io.async.loop' => $self->get_loop, ); my $resp = $self->{app}->( \%env ); my $responder = sub { my ( $status, $headers, $body ) = @{ +shift }; $req->print_stdout( "Status: $status$CRLF" ); while( my ( $header, $value ) = splice @$headers, 0, 2 ) { $req->print_stdout( "$header: $value$CRLF" ); } $req->print_stdout( $CRLF ); if( !defined $body ) { croak "Responder given no body in void context" unless defined wantarray; return $req->stdout_with_close; } if( ref $body eq "ARRAY" ) { $req->print_stdout( $_ ) for @$body; $req->finish( 0 ); } else { $req->stream_stdout_then_finish( sub { local $/ = \8192; my $buffer = $body->getline; defined $buffer and return $buffer; $body->close; return undef; }, 0 ); } }; if( ref $resp eq "ARRAY" ) { $responder->( $resp ); } elsif( ref $resp eq "CODE" ) { $resp->( $responder ); } } =head1 SEE ALSO =over 4 =item * L - Perl Web Server Gateway Interface Specification =item * L - FastCGI handler for Plack using L =back =head1 AUTHOR Paul Evans =cut 0x55AA; Net-Async-FastCGI-0.25/lib/Plack000755001750001750 012110012063 14762 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/lib/Plack/Handler000755001750001750 012110012063 16337 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/lib/Plack/Handler/Net000755001750001750 012110012063 17065 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/lib/Plack/Handler/Net/Async000755001750001750 012110012063 20142 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/lib/Plack/Handler/Net/Async/FastCGI.pm000444001750001750 465312110012063 22065 0ustar00leoleo000000000000# 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-2013 -- leonerd@leonerd.org.uk package Plack::Handler::Net::Async::FastCGI; use strict; use warnings; use Net::Async::FastCGI::PSGI; use IO::Async::Loop; our $VERSION = '0.25'; =head1 NAME C - FastCGI handler for Plack using L =head1 DESCRIPTION This module allows L to run a L application as a standalone FastCGI daemon under L, by using L. plackup -s Net::Async::FastCGI --listen ":2000" application.psgi This is internally implemented using L; further information on environment etc.. is documented there. =cut sub new { my $class = shift; my %opts = @_; delete $opts{host}; delete $opts{port}; my $self = bless { map { $_ => delete $opts{$_} } qw( listen server_ready socket ), }, $class; keys %opts and die "Unrecognised keys " . join( ", ", sort keys %opts ); return $self; } sub run { my $self = shift; my ( $app ) = @_; my $loop = IO::Async::Loop->new; foreach my $listen ( @{ $self->{listen} } ) { my $fcgi = Net::Async::FastCGI::PSGI->new( app => $app, ); $loop->add( $fcgi ); if( $self->{socket} ) { my $path = $self->{socket}; require IO::Socket::UNIX; unlink $path if -e $path; my $socket = IO::Socket::UNIX->new( Local => $path, Listen => 10, ) or die "Cannot listen on $path - $!"; $fcgi->configure( handle => $socket ); } else { my ( $host, $service ) = $listen =~ m/^(.*):(.*?)$/; $fcgi->listen( host => $host, service => $service, on_notifier => sub { $self->{server_ready} and $self->{server_ready}->() }, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n"; }, on_listen_error => sub { die "Cannot listen - $_[-1]\n"; }, ); } } $loop->loop_forever; } =head1 SEE ALSO =over 4 =item * L - use FastCGI with L =item * L - Perl Superglue for Web frameworks and Web Servers (PSGI toolkit) =back =head1 AUTHOR Paul Evans =cut 0x55AA; Net-Async-FastCGI-0.25/examples000755001750001750 012110012063 15000 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/examples/exec-cgi.fcgi000555001750001750 240412110012063 17456 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use Net::Async::FastCGI; 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->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 = Net::Async::FastCGI->new( handle => \*STDIN, on_request => \&on_request, ); $loop->add( $fcgi ); $loop->run; Net-Async-FastCGI-0.25/examples/sample.cgi000555001750001750 125012110012063 17103 0ustar00leoleo000000000000#!/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"), "
", "Foorbar Form Results: ", $c->param('foo'), "
", "Thanks for submitting!", $c->end_html(); } else { print $c->header, $c->start_html("It's the Foobar Form!"), '
', '
', '', '
', $c->end_html(); } Net-Async-FastCGI-0.25/examples/envtest.fcgi000555001750001750 247212110012063 17467 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use IO::Async::Loop; my $loop = IO::Async::Loop->new(); $loop->add( Example::EnvTestResponder->new( handle => \*STDIN ) ); $loop->run; package Example::EnvTestResponder; use base qw( Net::Async::FastCGI ); sub on_request { my $self = shift; my ( $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 = "

Request Variables

\n"; $page .= "

Basics

\n" . "

Path: $path

\n"; if ( keys %queryparams ) { $page .= "

Query parameters

\n" . "\n"; foreach my $key ( sort keys %queryparams ) { $page .= "\n"; } $page .= "
$key$queryparams{$key}
\n"; } $page .= "

Environment variables

\n"; $page .= "\n"; foreach my $key ( sort keys %$env ) { $page .= "\n"; } $page .= "
$key$env->{$key}
\n"; $req->print_stdout( "Content-type: text/html\r\n" . "Content-length: " . length( $page ) . "\r\n" . "\r\n" . $page . "\r\n" ); $req->finish(); } Net-Async-FastCGI-0.25/examples/fortune.fcgi000555001750001750 363612110012063 17464 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use IO::Async::Loop; my $FORTUNE = "/usr/games/fortune"; my $loop = IO::Async::Loop->new(); $loop->add( Example::FortuneResponder->new( handle => \*STDIN ) ); $loop->run; package Example::FortuneResponder; use base qw( Net::Async::FastCGI ); use IO::Async::Stream; sub on_request { my $self = shift; my ( $req ) = @_; my $kid = $self->loop->open_child( command => [ $FORTUNE ], stdout => { on_read => sub { my ( undef, $buffref, $closed ) = @_; if( $$buffref =~ s{^(.*?)\n}{} ) { $req->print_stdout( "

$1

" ); return 1; } if( $closed ) { # Deal with a final partial line the child may have written $req->print_stdout( "

$$buffref

" ) if length $$buffref; $req->print_stdout( "" ); } 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" . "" . " Fortune" . "

$FORTUNE says:

" ); } Net-Async-FastCGI-0.25/examples/mintest.fcgi000555001750001750 152512110012063 17460 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use Net::Async::FastCGI; 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 = < FCGI::Async testing page

Path

$path

Query String

$qs

Method

$method
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 = Net::Async::FastCGI->new( handle => \*STDIN, on_request => \&on_request, ); $loop->add( $fcgi ); $loop->run; Net-Async-FastCGI-0.25/t000755001750001750 012110012063 13425 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/t/00use.t000444001750001750 13512110012063 14662 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 1; use_ok( "Net::Async::FastCGI" ); Net-Async-FastCGI-0.25/t/30request-HTTP.t000444001750001750 546612110012063 16372 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 8; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => fcgi_keyval( REQUEST_METHOD => "GET" ) . fcgi_keyval( SCRIPT_NAME => "/fcgi-bin/test.fcgi" ) . fcgi_keyval( PATH_INFO => "/path/to/file" ) . fcgi_keyval( QUERY_STRING => "" ) . fcgi_keyval( HTTP_HOST => "mysite" ) . fcgi_keyval( CONTENT_TYPE => "text/plain" ) . fcgi_keyval( CONTENT_LENGTH => "11" ) . fcgi_keyval( SERVER_HOST => "localhost" ) . fcgi_keyval( SERVER_PORT => "80" ) . fcgi_keyval( SERVER_PROTOCOL => "HTTP/1.1" ) . fcgi_keyval( "" => "" ) ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # STDIN fcgi_trans( type => 5, id => 1, data => "Hello there" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; my $httpreq = $request->as_http_request; isa_ok( $httpreq, 'HTTP::Request', '$httpreq isa HTTP::Request' ); is( $httpreq->method, "GET", '$httpreq->method' ); is( $httpreq->protocol, "HTTP/1.1", '$httpreq->protocol' ); is( $httpreq->header( "Host" ), "mysite", '$httpreq->header' ); is( $httpreq->content_type, "text/plain", '$httpreq->content_type' ); is( $httpreq->content, "Hello there", '$httpreq->content' ); is( $httpreq->uri, "http://mysite/fcgi-bin/test.fcgi/path/to/file", '$httpreq->uri' ); require HTTP::Response; my $resp = HTTP::Response->new( 200 ); # TODO: Maybe we can get Net::Async::FastCGI::Request itself to fill this in? $resp->protocol( "HTTP/1.1" ); $resp->header( Content_type => "text/plain" ); $resp->content( "Here is my response" ); $request->send_http_response( $resp ); my $CRLF = "\x0d\x0a"; my $expect_stdout = join( "", map "$_$CRLF", "HTTP/1.1 200 OK", "Content-Type: text/plain", "Status: 200", '' ) . "Here is my response"; my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => $expect_stdout ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/01test.t000444001750001750 42312110012063 15046 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 1; use Test::HexString; use TestFCGI; is_hexstr( fcgi_trans( type => 1, id => 1, data => "ABCDEFGH" ), "\1\1\0\1\0\x08\0\0ABCDEFGH", 'Testing fcgi_trans() internal function' ); Net-Async-FastCGI-0.25/t/02request-minimal.t000444001750001750 366012110012063 17232 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 10; use Test::HexString; use Test::Refcount; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); ok( defined $fcgi, 'defined $fcgi' ); isa_ok( $fcgi, "Net::Async::FastCGI", '$fcgi isa FCGI::Async' ); is_oneref( $fcgi, '$fcgi has refcount 1 initially' ); $loop->add( $fcgi ); is_refcount( $fcgi, 2, '$fcgi has refcount 2 after $loop->add' ); my $C = connect_client_sock( $selfaddr ); # Got it - now pretend to be an FCGI client, such as how a webserver would # behave. $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # No parameters fcgi_trans( type => 4, id => 1, data => "" ) . # No STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, {}, '$request has empty params hash' ); is( $request->read_stdin_line, undef, '$request has empty STDIN' ); $request->finish; undef $request; # for refcount my $expect; $expect = # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); # Since we didn't specify FCGI_KEEP_CONN, we expect that $C should now be # closed, and that reading any more will give us EOF my $l = $C->sysread( $buffer, 8192 ); is( $l, 0, 'Client connection now closed' ); is_refcount( $fcgi, 2, '$fcgi has refcount 2 before $loop->remove' ); $loop->remove( $fcgi ); is_oneref( $fcgi, '$fcgi has refcount 1 finally' ); Net-Async-FastCGI-0.25/t/10request-close.t000444001750001750 230512110012063 16703 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 4; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # No parameters fcgi_trans( type => 4, id => 1, data => "" ) . # No STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, {}, '$request has empty params hash' ); is( $request->read_stdin_line, undef, '$request has empty STDIN' ); $request->print_stdout( "Hello, world!" ); # Client goes away before we finish close $C; wait_for { $request->is_aborted }; is( $request->is_aborted, 1, 'Request is aborted' ); $request->finish; $loop->loop_once( 0 ); # If we're still alive here then the code didn't die. Good. ok( 1, 'Still alive after $request->finish' ); Net-Async-FastCGI-0.25/t/04request-reuse.t000444001750001750 460712110012063 16733 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 6; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => "\4\5NAMEfirst" ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # No STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, { NAME => 'first' }, '$request params' ); is( $request->read_stdin_line, undef, '$request has empty STDIN' ); $request->print_stdout( "one" ); $request->finish; my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "one" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); # Now send a second one $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => "\4\6NAMEsecond" ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # No STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); undef $request; wait_for { defined $request }; is_deeply( $request->params, { NAME => 'second' }, '$request params' ); is( $request->read_stdin_line, undef, '$req has empty STDIN' ); $request->print_stdout( "two" ); $request->finish; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "two" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/03request-full.t000444001750001750 634212110012063 16547 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 12; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $CRLF = "\x0d\x0a"; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => fcgi_keyval( REQUEST_METHOD => "GET" ) . fcgi_keyval( SCRIPT_NAME => "/cgi-bin/foo.fcgi" ) . fcgi_keyval( PATH_INFO => "/another/path" ) . fcgi_keyval( QUERY_STRING => "foo=bar" ) . fcgi_keyval( SERVER_PROTOCOL => "HTTP/1.1" ) ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # STDIN fcgi_trans( type => 5, id => 1, data => "Hello, FastCGI script$CRLF" . "Here are several lines of data$CRLF" . "They should appear on STDIN$CRLF" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, { REQUEST_METHOD => "GET", SCRIPT_NAME => "/cgi-bin/foo.fcgi", PATH_INFO => "/another/path", QUERY_STRING => "foo=bar", SERVER_PROTOCOL => "HTTP/1.1", }, '$request has correct params' ); is( $request->method, "GET", '$request->method' ); is( $request->script_name, "/cgi-bin/foo.fcgi", '$request->script_name' ); is( $request->path_info, "/another/path", '$request->path_info' ); is( $request->path, "/cgi-bin/foo.fcgi/another/path", '$request->path' ); is( $request->query_string, "foo=bar", '$request->query_string' ); is( $request->protocol, "HTTP/1.1", '$request->protocol' ); is( $request->read_stdin_line, "Hello, FastCGI script$CRLF", '$request has correct STDIN line 1' ); is( $request->read_stdin_line, "Here are several lines of data$CRLF", '$request has correct STDIN line 2' ); is( $request->read_stdin_line, "They should appear on STDIN$CRLF", '$request has correct STDIN line 3' ); is( $request->read_stdin_line, undef, '$request has correct STDIN finish' ); $request->print_stdout( "Hello, world!" ); $request->print_stderr( "Some errors occured\n" ); $request->finish( 5 ); my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "Hello, world!" ) . # STDERR fcgi_trans( type => 7, id => 1, data => "Some errors occured\n" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End of STDERR fcgi_trans( type => 7, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\5\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/06request-binary.t000444001750001750 451012110012063 17067 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 8; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # No parameters fcgi_trans( type => 4, id => 1, data => "" ) . # STDIN fcgi_trans( type => 5, id => 1, data => "123456789" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, {}, '$request has empty params hash' ); is( $request->read_stdin( 4 ), "1234", '$request first four STDIN bytes' ); is( $request->read_stdin( 4 ), "5678", '$request next four STDIN bytes' ); is( $request->read_stdin( 4 ), "9", '$request last STDIN bytes' ); is( $request->read_stdin( 4 ), undef, '$request end of STDIN' ); $request->finish; my $expect; $expect = # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); # Now send a second one $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # No parameters fcgi_trans( type => 4, id => 1, data => "" ) . # STDIN fcgi_trans( type => 5, id => 1, data => "ABCDEFGH" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); undef $request; wait_for { defined $request }; is( $request->read_stdin( undef ), "ABCDEFGH", '$request entire STDIN' ); $request->finish; $expect = # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/05request-multiplex.t000444001750001750 401312110012063 17623 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 2; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { my ( $fcgi, $req ) = @_; my $data = $req->param( 'data' ); $req->print_stdout( "You wrote $data" ); $req->finish; }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin 1 with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Begin 2 with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 2, data => "\0\1\1\0\0\0\0\0" ) . # Parameters 1 fcgi_trans( type => 4, id => 1, data => "\4\5dataValue" ) . # End of parameters 1 fcgi_trans( type => 4, id => 1, data => "" ) . # Parameters 2 fcgi_trans( type => 4, id => 2, data => "\4\x0bdataOther value" ) . # End of parameters 2 fcgi_trans( type => 4, id => 2, data => "" ) . # No STDIN 1 fcgi_trans( type => 5, id => 1, data => "" ) ); my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "You wrote Value" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); $C->syswrite( # No STDIN 2 fcgi_trans( type => 5, id => 2, data => "" ) ); $expect = # STDOUT fcgi_trans( type => 6, id => 2, data => "You wrote Other value" ) . # End of STDOUT fcgi_trans( type => 6, id => 2, data => "" ) . # End request fcgi_trans( type => 3, id => 2, data => "\0\0\0\0\0\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/11request-encoding.t000444001750001750 403512110012063 17367 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 5; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # No parameters fcgi_trans( type => 4, id => 1, data => "" ) . # STDIN fcgi_trans( type => 5, id => 1, data => "\xc3\xa5" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, {}, '$request has empty params hash' ); is( $request->read_stdin_line, chr(0xe5), '$request has a single Unicode character' ); # Pick a character in 8859-1 so we can check UTF-8 is really being applied $request->print_stdout( chr(0xe4) ); my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "\xc3\xa4" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI STDOUT stream contains UTF-8 encoded data' ); $request->set_encoding( "ISO-8859-1" ); $request->print_stdout( chr(0xe4) ); $request->finish; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "\xe4" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record contains ISO-8859-1 data' ); # Since we didn't specify FCGI_KEEP_CONN, we expect that $C should now be # closed, and that reading any more will give us EOF my $l = $C->sysread( $buffer, 8192 ); is( $l, 0, 'Client connection now closed' ); Net-Async-FastCGI-0.25/t/12request-unknown.t000444001750001750 222512110012063 17300 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 2; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Some unknown value fcgi_trans( type => 0x14, id => 0, data => "" ) ); my $expect; $expect = # FCGI_UNKNOWN_TYPE fcgi_trans( type => 11, id => 0, data => "\x14\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI unknown type' ); $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\4\0\0\0\0\0\0" ) ); $expect = # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\3\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, "FastCGI end request record with unknown role" ); Net-Async-FastCGI-0.25/t/09request-streamstdout.t000444001750001750 271412110012063 20350 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 3; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # No parameters fcgi_trans( type => 4, id => 1, data => "" ) . # No STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, {}, '$request has empty params hash' ); is( $request->read_stdin_line, undef, '$request has empty STDIN' ); my $stdout = "Hello, world."; $request->stream_stdout_then_finish( sub { my ( $len ) = @_; return length $stdout ? substr( $stdout, 0, 128, "" ) : undef; }, 0 ); my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "Hello, world." ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/20get_values.t000444001750001750 340412110012063 16250 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 3; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub {}, # ignore, we're not really going to start any ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # FCGI_GET_VALUES fcgi_trans( type => 9, id => 0, data => "\x0f\0FCGI_MPXS_CONNS" ) ); my $expect; $expect = # FCGI_GET_VALUES_RESULT fcgi_trans( type => 10, id => 0, data => "\x0f\1FCGI_MPXS_CONNS1" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record for FCGI_MPXS_CONNS' ); $C->syswrite( # FCGI_GET_VALUES fcgi_trans( type => 9, id => 0, data => "\x0e\0FCGI_MAX_CONNS" ) ); $expect = # FCGI_GET_VALUES_RESULT fcgi_trans( type => 10, id => 0, data => "\x0e\4FCGI_MAX_CONNS1024" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record for FCGI_MAX_CONNS' ); $C->syswrite( # FCGI_GET_VALUES fcgi_trans( type => 9, id => 0, data => "\x0d\0FCGI_MAX_REQS" ) ); $expect = # FCGI_GET_VALUES_RESULT fcgi_trans( type => 10, id => 0, data => "\x0d\4FCGI_MAX_REQS1024" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record for FCGI_MAX_REQS' ); Net-Async-FastCGI-0.25/t/99pod.t000444001750001750 22712110012063 14674 0ustar00leoleo000000000000#!/usr/bin/perl -w use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Net-Async-FastCGI-0.25/t/08request-shortwrites.t000444001750001750 255612110012063 20212 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 3; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # No parameters fcgi_trans( type => 4, id => 1, data => "" ) . # No STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, {}, '$request has empty params hash' ); is( $request->read_stdin_line, undef, '$request has empty STDIN' ); $request->print_stdout( "Hello, " ); $request->print_stdout( "world." ); $request->finish; my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "Hello, world." ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/13request-handles.t000444001750001750 373112110012063 17223 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 7; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => "\3\3FOOfoo\5\5SPLOTsplot" ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # STDIN fcgi_trans( type => 5, id => 1, data => "Some data on STDIN\nAnd another line\n" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; my $stdin = $request->stdin; ok( defined $stdin, '$request->stdin defined' ); is( <$stdin>, "Some data on STDIN\n", '<$stdin>' ); is( read( $stdin, my $readbuf, 8192 ), 17, 'read $stdin length' ); is( $readbuf, "And another line\n", 'read $stdin buffer' ); my $stdout = $request->stdout; ok( defined $stdout, '$request->stdout defined' ); print $stdout "Hello, world!"; my $stderr = $request->stderr; ok( defined $stderr, '$request->stderr defined' ); print $stderr "Some errors occured\n"; $request->finish( 5 ); my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "Hello, world!" ) . # STDERR fcgi_trans( type => 7, id => 1, data => "Some errors occured\n" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End of STDERR fcgi_trans( type => 7, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\5\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/07request-longparams.t000444001750001750 262412110012063 17753 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 3; use Test::HexString; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI; use TestFCGI; my $request; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $fcgi = Net::Async::FastCGI->new( handle => $S, on_request => sub { $request = $_[1] }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); my $paramvalue = "A" x 240; # Important that 240 is bigger than 127 $C->syswrite( # Begin fcgi_trans( type => 1, id => 1, data => "\0\1\0\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => "\4\x80\0\0\xf0LONG$paramvalue" ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # No STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $request }; is_deeply( $request->params, { LONG => $paramvalue }, '$request has correct params' ); is( $request->read_stdin_line, undef, '$request has empty STDIN' ); $request->finish; my $expect; $expect = # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); Net-Async-FastCGI-0.25/t/40psgi.t000444001750001750 1740412110012063 15103 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 12; use Test::Identity; use Test::HexString; use Test::Refcount; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI::PSGI; use TestFCGI; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $received_env; my $fcgi = Net::Async::FastCGI::PSGI->new( handle => $S, app => sub { # Simplest PSGI app $received_env = shift; return [ 200, [ "Content-Type" => "text/plain" ], [ "Hello, world" ], ]; }, ); ok( defined $fcgi, 'defined $fcgi' ); $loop->add( $fcgi ); # One ref in the Loop as well as this lexical variable is_refcount( $fcgi, 2, '$fcgi has refcount 2 initially' ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => fcgi_keyval( REQUEST_METHOD => "GET" ) . fcgi_keyval( SCRIPT_NAME => "" ) . fcgi_keyval( PATH_INFO => "" ) . fcgi_keyval( REQUEST_URI => "/" ) . fcgi_keyval( QUERY_STRING => "" ) . fcgi_keyval( SERVER_NAME => "localhost" ) . fcgi_keyval( SERVER_PORT => "80" ) . fcgi_keyval( SERVER_PROTOCOL => "HTTP/1.1" ) ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $received_env }; # Some keys are awkward, handle them first ok( defined(delete $received_env->{'psgi.input'}), "psgi.input exists" ); ok( defined(delete $received_env->{'psgi.errors'}), "psgi.errors exists" ); identical( delete $received_env->{'net.async.fastcgi'}, $fcgi, "net.async.fastcgi is \$fcgi" ); can_ok( delete $received_env->{'net.async.fastcgi.req'}, "params" ); identical( delete $received_env->{'io.async.loop'}, $loop, "io.async.loop is \$loop" ); is_deeply( $received_env, { PATH_INFO => "", QUERY_STRING => "", REQUEST_METHOD => "GET", REQUEST_URI => "/", SCRIPT_NAME => "", SERVER_NAME => "localhost", SERVER_PORT => "80", SERVER_PROTOCOL => "HTTP/1.1", 'psgi.version' => [1,0], 'psgi.url_scheme' => "http", 'psgi.run_once' => 0, 'psgi.multiprocess' => 0, 'psgi.multithread' => 0, 'psgi.streaming' => 1, 'psgi.nonblocking' => 1, }, 'received $env in PSGI app' ); my $CRLF = "\x0d\x0a"; my $expect_stdout = join( "", map "$_$CRLF", "Status: 200", "Content-Type: text/plain", '' ) . "Hello, world"; my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => $expect_stdout ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request record' ); $fcgi->configure( app => sub { my $env = shift; my $input = delete $env->{'psgi.input'}; my $content = ""; while( $input->read( my $buffer, 1024 ) ) { $content .= $buffer; } return [ 200, [ "Content-Type" => "text/plain" ], [ "Input was: $content" ], ]; } ); $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => fcgi_keyval( REQUEST_METHOD => "GET" ) . fcgi_keyval( SCRIPT_NAME => "" ) . fcgi_keyval( PATH_INFO => "" ) . fcgi_keyval( REQUEST_URI => "/" ) . fcgi_keyval( QUERY_STRING => "" ) . fcgi_keyval( SERVER_NAME => "localhost" ) . fcgi_keyval( SERVER_PORT => "80" ) . fcgi_keyval( SERVER_PROTOCOL => "HTTP/1.1" ) ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # STDIN fcgi_trans( type => 5, id => 1, data => "Some data on STDIN" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); $expect_stdout = join( "", map "$_$CRLF", "Status: 200", "Content-Type: text/plain", '' ) . "Input was: Some data on STDIN"; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => $expect_stdout ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI request/response with STDIN reading' ); $fcgi->configure( app => sub { my $env = shift; $env->{'psgi.errors'}->print( "An error line here\n" ); return [ 200, [ "Content-Type" => "text/plain" ], [ "" ], ]; } ); $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => fcgi_keyval( REQUEST_METHOD => "GET" ) . fcgi_keyval( SCRIPT_NAME => "" ) . fcgi_keyval( PATH_INFO => "" ) . fcgi_keyval( REQUEST_URI => "/" ) . fcgi_keyval( QUERY_STRING => "" ) . fcgi_keyval( SERVER_NAME => "localhost" ) . fcgi_keyval( SERVER_PORT => "80" ) . fcgi_keyval( SERVER_PROTOCOL => "HTTP/1.1" ) ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); $expect_stdout = join( "", map "$_$CRLF", "Status: 200", "Content-Type: text/plain", '' ) . ""; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => $expect_stdout ) . # STDERR fcgi_trans( type => 7, id => 1, data => "An error line here\n" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End of STDERR fcgi_trans( type => 7, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI request/response with STDERR printing' ); $fcgi->configure( app => sub { my $env = shift; open my $body, "<", \"Here is a IO-like string"; return [ 200, [ "Content-Type" => "text/plain" ], $body, ]; } ); $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => fcgi_keyval( REQUEST_METHOD => "GET" ) . fcgi_keyval( SCRIPT_NAME => "" ) . fcgi_keyval( PATH_INFO => "" ) . fcgi_keyval( REQUEST_URI => "/" ) . fcgi_keyval( QUERY_STRING => "" ) . fcgi_keyval( SERVER_NAME => "localhost" ) . fcgi_keyval( SERVER_PORT => "80" ) . fcgi_keyval( SERVER_PROTOCOL => "HTTP/1.1" ) ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); # This STDOUT will come in two pieces $expect_stdout = join( "", map "$_$CRLF", "Status: 200", "Content-Type: text/plain", '' ); $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => $expect_stdout ) . # STDOUT fcgi_trans( type => 6, id => 1, data => "Here is a IO-like string" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI request/response with IO-like body' ); Net-Async-FastCGI-0.25/t/41psgi-streaming.t000444001750001750 755312110012063 17057 0ustar00leoleo000000000000#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 5; use Test::HexString; use Test::Refcount; use IO::Async::Loop; use IO::Async::Test; use Net::Async::FastCGI::PSGI; use TestFCGI; my ( $S, $selfaddr ) = make_server_sock; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $responder; my $fcgi = Net::Async::FastCGI::PSGI->new( handle => $S, app => sub { my $env = shift; return sub { $responder = shift; } }, ); $loop->add( $fcgi ); my $C = connect_client_sock( $selfaddr ); $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => fcgi_keyval( REQUEST_METHOD => "GET" ) . fcgi_keyval( SCRIPT_NAME => "" ) . fcgi_keyval( PATH_INFO => "" ) . fcgi_keyval( REQUEST_URI => "/" ) . fcgi_keyval( QUERY_STRING => "" ) . fcgi_keyval( SERVER_NAME => "localhost" ) . fcgi_keyval( SERVER_PORT => "80" ) . fcgi_keyval( SERVER_PROTOCOL => "HTTP/1.1" ) ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $responder }; is( ref $responder, "CODE", '$responder is a CODE ref' ); $responder->([ 200, [ "Content-Type" => "text/plain" ], [ "Deferred content here" ] ]); my $CRLF = "\x0d\x0a"; my $expect_stdout = join( "", map "$_$CRLF", "Status: 200", "Content-Type: text/plain", '' ) . "Deferred content here"; my $expect; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => $expect_stdout ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); my $buffer; $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI end request after deferred content' ); undef $responder; $C->syswrite( # Begin with FCGI_KEEP_CONN fcgi_trans( type => 1, id => 1, data => "\0\1\1\0\0\0\0\0" ) . # Parameters fcgi_trans( type => 4, id => 1, data => fcgi_keyval( REQUEST_METHOD => "GET" ) . fcgi_keyval( SCRIPT_NAME => "" ) . fcgi_keyval( PATH_INFO => "" ) . fcgi_keyval( REQUEST_URI => "/" ) . fcgi_keyval( QUERY_STRING => "" ) . fcgi_keyval( SERVER_NAME => "localhost" ) . fcgi_keyval( SERVER_PORT => "80" ) . fcgi_keyval( SERVER_PROTOCOL => "HTTP/1.1" ) ) . # End of parameters fcgi_trans( type => 4, id => 1, data => "" ) . # End of STDIN fcgi_trans( type => 5, id => 1, data => "" ) ); wait_for { defined $responder }; my $writer = $responder->([ 200, [ "Content-Type" => "text/plain" ], ]); $expect_stdout = join( "", map "$_$CRLF", "Status: 200", "Content-Type: text/plain", '' ); $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => $expect_stdout ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI STDOUT record after streamed responder' ); $writer->write( "Streamed " ); $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "Streamed " ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI STDOUT record after streamed writer write' ); $writer->write( "Output" ); $writer->close; $expect = # STDOUT fcgi_trans( type => 6, id => 1, data => "Output" ) . # End of STDOUT fcgi_trans( type => 6, id => 1, data => "" ) . # End request fcgi_trans( type => 3, id => 1, data => "\0\0\0\0\0\0\0\0" ); $buffer = ""; wait_for_stream { length $buffer >= length $expect } $C => $buffer; is_hexstr( $buffer, $expect, 'FastCGI STDOUT record after streamed writer write' ); Net-Async-FastCGI-0.25/t/lib000755001750001750 012110012063 14173 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/t/lib/TestFCGI.pm000444001750001750 405512110012063 16242 0ustar00leoleo000000000000package TestFCGI; use strict; use Exporter 'import'; our @EXPORT = qw( fcgi_keyval fcgi_trans make_server_sock connect_client_sock ); use IO::Socket::INET; # This test code gets scary to write without effectively writing our # own FastCGI client implementation. Without doing that, the best thing we can # do is provide a little helper function to build FastCGI transaction records. sub fcgi_keyval { my ( $key, $value ) = @_; my $klen = length $key; my $vlen = length $value; $klen < 128 and $vlen < 128 and return pack( "C1C1A*A*", $klen, $vlen, $key, $value ); die "Cannot represent keyval (klen=$klen vlen=$vlen)\n"; } sub fcgi_trans { my %args = @_; $args{version} ||= 1; my $data = $args{data}; my $len = length $data; # Pad data to 8byte boundary my $plen = 8 - ( $len % 8 ); $plen = 0 if $plen == 8; # version type id length padlen reserved return pack( "C C n n C C", 1, $args{type}, $args{id}, $len, $plen, 0 ) . $data . "\0" x $plen; } sub make_server_sock { # Be polite, and only ask to bind to localhost, rather than default of # anything. Also, OpenBSD seems to get upset if we don't, because sockname # will be a broadcast address, that the subsequent connect() won't like my $S = IO::Socket::INET->new( Type => SOCK_STREAM, Listen => 10, LocalAddr => '127.0.0.1', ReuseAddr => 1, Blocking => 0, ); defined $S or die "Unable to create socket - $!"; my $selfaddr = $S->sockname; defined $selfaddr or die "Unable to get sockname - $!"; return ( $S, $selfaddr ); } sub connect_client_sock { my ( $selfaddr ) = @_; my $C = IO::Socket::INET->new( Type => SOCK_STREAM, ); defined $C or die "Unable to create client socket - $!"; # Normal blocking connect so we can be sure it's done $C->connect( $selfaddr ) or die "Unable to connect socket - $!"; $C->blocking(0); return $C; } 1; Net-Async-FastCGI-0.25/psgifiles000755001750001750 012110012063 15147 5ustar00leoleo000000000000Net-Async-FastCGI-0.25/psgifiles/env.psgi000444001750001750 101212110012063 16752 0ustar00leoleo000000000000#!/usr/bin/perl use strict; sub { my $env = shift; my $input = ""; while( $env->{"psgi.input"}->read( my $buffer, 8192 ) ) { $input .= $buffer; } return [ '200', [ 'Content-Type' => 'text/plain' ], [ "The method was $env->{REQUEST_METHOD}\n", "The path was $env->{PATH_INFO}\n", "The query string was $env->{QUERY_STRING}\n", "The body was ".length($input)." bytes\n\n" . join("", map { " \$ENV{$_} = $env->{$_}\n" } sort keys %$env) ], ]; } Net-Async-FastCGI-0.25/psgifiles/counter.psgi000444001750001750 102712110012063 17647 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use IO::Async::Timer::Periodic; sub { my $env = shift; return sub { my $responder = shift; my $writer = $responder->([ 200, [ 'Content-Type' => "text/plain" ], ]); my $counter = 1; my $timer = IO::Async::Timer::Periodic->new( interval => 1, on_tick => sub { $writer->write( "$counter\r\n" ); $counter++ }, ); $timer->start; $env->{'io.async.loop'}->add( $timer ); }; } Net-Async-FastCGI-0.25/psgifiles/sleepy.psgi000444001750001750 55712110012063 17460 0ustar00leoleo000000000000#!/usr/bin/perl use strict; sub { my $env = shift; return sub { my $respond = shift; $env->{'io.async.loop'}->enqueue_timer( delay => 3, code => sub { $respond->([ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello World\n" ], ]); }, ); }; } Net-Async-FastCGI-0.25/psgifiles/helloworld.psgi000444001750001750 23612110012063 20324 0ustar00leoleo000000000000#!/usr/bin/perl use strict; sub { my $env = shift; return [ '200', [ 'Content-Type' => 'text/plain' ], [ "Hello World\n" ], ]; }