POE-Component-Server-SimpleHTTP-2.30/000755 001751 001751 00000000000 14426154312 020024 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.30/todo000644 001751 001751 00000001207 14426154312 020714 0ustar00bingosbingos000000 000000 - look if ADDRESS stuff is really unnecesary because that makes impossible to bind to certain ip (it might be optional but possible to give) - Support for ucfirst lc $arguments not only uppercase ones? (or check if that works in all cases) - indents in everywhere and one coding style (which one?) - cleanup logging methods, currently: * LOGHANDLER is fired on request (which place could be used for ACLs not loggers) * LOG2HANDLER is fired after servicing request BUT NOT for Streams (need to be fixed) - maybe after first fail for any session/event post that handler should be disabled? or maybe triggerable behaviour any other ideas? POE-Component-Server-SimpleHTTP-2.30/README000644 001751 001751 00000051122 14426154312 020705 0ustar00bingosbingos000000 000000 NAME POE::Component::Server::SimpleHTTP - Perl extension to serve HTTP requests in POE. VERSION version 2.30 SYNOPSIS use POE; use POE::Component::Server::SimpleHTTP; # Start the server! POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'PORT' => 11111, 'HOSTNAME' => 'MySite.com', 'HANDLERS' => [ { 'DIR' => '^/bar/.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_BAR', }, { 'DIR' => '^/$', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, { 'DIR' => '^/foo/.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_NULL', }, { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_ERROR', }, ], 'LOGHANDLER' => { 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_LOG', }, 'LOG2HANDLER' => { 'SESSION' => 'HTTP_GET', 'EVENT' => 'POSTLOG', }, # In the testing phase... 'SSLKEYCERT' => [ 'private-key.pem', 'public-cert.pem' ], 'SSLINTERMEDIATECACERT' => 'intermediate-ca-cert.pem', ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ); $_[KERNEL]->post( 'HTTPD', 'GETHANDLERS', $_[SESSION], 'GOT_HANDLERS' ); }, 'GOT_BAR' => \&GOT_REQ, 'GOT_MAIN' => \&GOT_REQ, 'GOT_ERROR' => \&GOT_ERR, 'GOT_NULL' => \&GOT_NULL, 'GOT_HANDLERS' => \&GOT_HANDLERS, 'GOT_LOG' => \&GOT_LOG, }, ); # Start POE! POE::Kernel->run(); sub GOT_HANDLERS { # ARG0 = HANDLERS array my $handlers = $_[ ARG0 ]; # Move the first handler to the last one push( @$handlers, shift( @$handlers ) ); # Send it off! $_[KERNEL]->post( 'HTTPD', 'SETHANDLERS', $handlers ); } sub GOT_NULL { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Kill this! $_[KERNEL]->post( 'HTTPD', 'CLOSE', $response ); } sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content( 'Some funky HTML here' ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_ERR { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Check for errors if ( ! defined $request ) { $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); return; } # Do our stuff to HTTP::Response $response->code( 404 ); $response->content( "Hi visitor from " . $response->connection->remote_ip . ", Page not found -> '" . $request->uri->path . "'" ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_LOG { # ARG0 = HTTP::Request object, ARG1 = remote IP my ($request, $remote_ip) = @_[ARG0,ARG1]; # Do some sort of logging activity. # If the request was malformed, $request = undef # CHECK FOR A REQUEST OBJECT BEFORE USING IT. if( $request ) { { warn join(' ', time(), $remote_ip, $request->uri ), "\n"; } else { warn join(' ', time(), $remote_ip, 'Bad request' ), "\n"; } return; } DESCRIPTION This module makes serving up HTTP requests a breeze in POE. The hardest thing to understand in this module is the HANDLERS. That's it! The standard way to use this module is to do this: use POE; use POE::Component::Server::SimpleHTTP; POE::Component::Server::SimpleHTTP->new( ... ); POE::Session->create( ... ); POE::Kernel->run(); Starting SimpleHTTP To start SimpleHTTP, just call it's new method: POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '192.168.1.1', 'PORT' => 11111, 'HOSTNAME' => 'MySite.com', 'HEADERS' => {}, 'HANDLERS' => [ ], ); This method will die on error or return success. This constructor accepts only 7 options. ALIAS This will set the alias SimpleHTTP uses in the POE Kernel. This will default to "SimpleHTTP" ADDRESS This value will be passed to POE::Wheel::SocketFactory to bind to, will use INADDR_ANY if it is nothing is provided (or IN6ADDR_ANY if DOMAIN is AF_INET6). For UNIX domain sockets, it should be a path describing the socket's filename. If neither DOMAIN nor ADDRESS are specified, it will use IN6ADDR_ANY and AF_INET6. PORT This value will be passed to POE::Wheel::SocketFactory to bind to. DOMAIN This value will be passed to POE::Wheel::SocketFactory to define the socket domain used (AF_INET, AF_INET6, AF_UNIX). HOSTNAME This value is for the HTTP::Request's URI to point to. If this is not supplied, SimpleHTTP will use Sys::Hostname to find it. HEADERS This should be a hashref, that will become the default headers on all HTTP::Response objects. You can override this in individual requests by setting it via $request->header( ... ) For more information, consult the HTTP::Headers module. HANDLERS This is the hardest part of SimpleHTTP :) You supply an array, with each element being a hash. All the hashes should contain those 3 keys: DIR -> The regexp that will be used, more later. SESSION -> The session to send the input EVENT -> The event to trigger The DIR key should be a valid regexp. This will be matched against the current request path. Pseudocode is: if ( $path =~ /$DIR/ ) NOTE: The path is UNIX style, not MSWIN style ( /blah/foo not \blah\foo ) Now, if you supply 100 handlers, how will SimpleHTTP know what to do? Simple! By passing in an array in the first place, you have already told SimpleHTTP the order of your handlers. They will be tried in order, and if a match is not found, SimpleHTTP will return a 404 response. This allows some cool things like specifying 3 handlers with DIR of: '^/foo/.*', '^/$', '.*' Now, if the request is not in /foo or not root, your 3rd handler will catch it, becoming the "404 not found" handler! NOTE: You might get weird Session/Events, make sure your handlers are in order, for example: '^/', '^/foo/.*' The 2nd handler will NEVER get any requests, as the first one will match ( no $ in the regex ) Now, here's what a handler receives: ARG0 -> HTTP::Request object ARG1 -> POE::Component::Server::SimpleHTTP::Response object ARG2 -> The exact DIR that matched, so you can see what triggered what NOTE: If ARG0 is undef, that means POE::Filter::HTTPD encountered an error parsing the client request, simply modify the HTTP::Response object and send some sort of generic error. SimpleHTTP will set the path used in matching the DIR regexes to an empty string, so if there is a "catch-all" DIR regex like '.*', it will catch the errors, and only that one. NOTE: The only way SimpleHTTP will leak memory ( hopefully heh ) is if you discard the SimpleHTTP::Response object without sending it back to SimpleHTTP via the DONE/CLOSE events, so never do that! KEEPALIVE Set to true to enable HTTP keep-alive support. Connections will be kept alive until the client closes the connection. All HTTP/1.1 connections are kept-open, unless you set the response Connection header to close. $response->header( Connection => 'close' ); If you want more control, use POE::Component::Server::HTTP::KeepAlive. LOGHANDLER Expects a hashref with the following key, values: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event for each request to the server from clients. Malformed client requests will not be passed into the handler. Instead undef will be passed. Event is called before ANY content handler is called. The event will have the following parameters: ARG0 -> HTTP::Request object/undef if client request was malformed. ARG1 -> the IP address of the client LOG2HANDLER Expect a hashref with the following key, values: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event for each response that hit DONE call. Malformed client requests will not be passed into the handler. Event is after processing all content handlers. The event will have the following parameters: ARG0 -> HTTP::Request object ARG1 -> HTTP::Response object That makes possible following code: my ($login, $password) = $request->authorization_basic(); printf STDERR "%s - %s [%s] \"%s %s %s\" %d %d\n", $response->connection->remote_ip, $login||'-', POSIX::strftime("%d/%b/%Y:%T %z",localtime(time())), $request->method(), $request->uri()->path(), $request->protocol(), $response->code(), length($response->content()); Emulate apache-like logs for PoCo::Server::SimpleHTTP SETUPHANDLER Expects a hashref with the following key, values: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event when the listener wheel has been setup. Currently there are no parameters returned. SSLKEYCERT This should be an arrayref of only 2 elements - the private key and public certificate locations. Now, this is still in the experimental stage, and testing is greatly welcome! Again, this will automatically turn every incoming connection into a SSL socket. Once enough testing has been done, this option will be augmented with more SSL stuff! SSLINTERMEDIATECACERT This option is needed in case the SSL certificate references an intermediate certification authority certificate. PROXYMODE Set this to a true value to enable the server to act as a proxy server, ie. it won't mangle the HTTP::Request URI. Events SimpleHTTP is so simple, there are only 8 events available. DONE This event accepts only one argument: the HTTP::Response object we sent to the handler. Calling this event implies that this particular request is done, and will proceed to close the socket. NOTE: This method automatically sets those 3 headers if they are not already set: Date -> Current date stringified via HTTP::Date->time2str Content-Type -> text/html Content-Length -> length( $response->content ) To get greater throughput and response time, do not post() to the DONE event, call() it! However, this will force your program to block while servicing web requests... CLOSE This event accepts only one argument: the HTTP::Response object we sent to the handler. Calling this event will close the socket, not sending any output GETHANDLERS This event accepts 2 arguments: The session + event to send the response to This event will send back the current HANDLERS array ( deep-cloned via Storable::dclone ) The resulting array can be played around to your tastes, then once you are done... SETHANDLERS This event accepts only one argument: pointer to HANDLERS array BEWARE: if there is an error in the HANDLERS, SimpleHTTP will die! SETCLOSEHANDLER $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $connection, $event, @args ); Calls $event in the current session when $connection is closed. You could use for persistent connection handling. Multiple session may register close handlers. Calling SETCLOSEHANDLER without $event to remove the current session's handler: $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $connection ); You must make sure that @args doesn't cause a circular reference. Ideally, use $connection-ID> or some other unique value associated with this $connection. STARTLISTEN Starts the listening socket, if it was shut down STOPLISTEN Simply a wrapper for SHUTDOWN GRACEFUL, but will not shutdown SimpleHTTP if there is no more requests SHUTDOWN Without arguments, SimpleHTTP does this: Close the listening socket Kills all pending requests by closing their sockets Removes it's alias With an argument of 'GRACEFUL', SimpleHTTP does this: Close the listening socket Waits for all pending requests to come in via DONE/CLOSE, then removes it's alias STREAM With a $response argument it streams the content and calls back the streaming event of the user's session (or with the dont_flush option you're responsible for calling back your session's streaming event). To use the streaming feature see below. Streaming with SimpleHTTP It's possible to send data as a stream to clients (unbuffered and integrated in the POE loop). Just create your session to receive events from SimpleHTTP as usually and add a streaming event, this event will be triggered over and over each time you set the $response to a streaming state and once you trigger it: # sets the response as streamed within our session which alias is HTTP_GET # with the event GOT_STREAM $response->stream( session => 'HTTP_GET', event => 'GOT_STREAM', dont_flush => 1 ); # then you can simply yield your streaming event, once the GOT_STREAM event # has reached its end it will be triggered again and again, until you # send a CLOSE event to the kernel with the appropriate response as parameter $kernel->yield('GOT_STREAM', $response); The optional dont_flush option gives the user the ability to control the callback to the streaming event, which means once your stream event has reached its end it won't be called, you have to call it back. You can now send data by chunks and either call yourself back (via POE) or shutdown when your streaming is done (EOF for example). sub GOT_STREAM { my ( $kernel, $heap, $response ) = @_[KERNEL, HEAP, ARG0]; # sets the content of the response $response->content("Hello World\n"); # send it to the client POE::Kernel->post('HTTPD', 'STREAM', $response); # if we have previously set the dont_flush option # we have to trigger our event back until the end of # the stream like this (that can be a yield, of course): # # $kernel->delay('GOT_STREAM', 1, $stream ); # otherwise the GOT_STREAM event is triggered continuously until # we call the CLOSE event on the response like that : # if ($heap{'streaming_is_done'}) { # close the socket and end the stream POE::Kernel->post('HTTPD', 'CLOSE', $response ); } } The dont_flush option is there to be able to control the frequency of flushes to the client. SimpleHTTP Notes You can enable debugging mode by doing this: sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE::Component::Server::SimpleHTTP; Also, this module will try to keep the Listening socket alive. if it dies, it will open it again for a max of 5 retries. You can override this behavior by doing this: sub POE::Component::Server::SimpleHTTP::MAX_RETRIES () { 10 } use POE::Component::Server::SimpleHTTP; For those who are pondering about basic-authentication, here's a tiny snippet to put in the Event handler # Contributed by Rocco Caputo sub Got_Request { # ARG0 = HTTP::Request, ARG1 = HTTP::Response my( $request, $response ) = @_[ ARG0, ARG1 ]; # Get the login my ( $login, $password ) = $request->authorization_basic(); # Decide what to do if ( ! defined $login or ! defined $password ) { # Set the authorization $response->header( 'WWW-Authenticate' => 'Basic realm="MyRealm"' ); $response->code( 401 ); $response->content( 'FORBIDDEN.' ); # Send it off! $_[KERNEL]->post( 'SimpleHTTP', 'DONE', $response ); } else { # Authenticate the user and move on } } EXPORT Nothing. ABSTRACT An easy to use HTTP daemon for POE-enabled programs SEE ALSO L L L L L L L L AUTHOR Apocalypse COPYRIGHT AND LICENSE This software is copyright (c) 2023 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. POE-Component-Server-SimpleHTTP-2.30/LICENSE000644 001751 001751 00000044142 14426154312 021036 0ustar00bingosbingos000000 000000 This software is copyright (c) 2023 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. 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) 2023 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. 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, Fifth Floor, Boston, MA 02110-1301 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) 2023 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. 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 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End POE-Component-Server-SimpleHTTP-2.30/Changes000644 001751 001751 00000003404 14426154312 021320 0ustar00bingosbingos000000 000000 ================================================== Changes from 2018-05-09 00:00:00 +0000 to present. ================================================== ----------------------------------------- version 2.30 at 2023-05-08 11:10:47 +0000 ----------------------------------------- Change: 89d04178d93e58d19b6182e713c872bde7271a8c Author: Chris 'BinGOs' Williams Date : 2023-05-08 12:10:47 +0000 Release engineering for 2.30 Change: ba688d4b8a7ab7911962d04860d4ec877e89c424 Author: Ricardo Signes Date : 2023-05-08 12:07:43 +0000 post fails if it returns false; check that, not $! I was getting errors with an ENOENT in them, which dngor says shouldn't be coming from the kernel. We discussed this on irc.perl.org #magnet, 2016-12-23 around 15:00 UTC. One possibility, unconfirmed, is that something else in the handler is setting $!, and the kernel does not guarantee clearing $! on success — like lots of Perl 5 stuff. So, this commit relies on post's return value, and then assumes $! will be sensible, rather than assuming a true $! means that the post failed. ----------------------------------------- version 2.28 at 2018-09-17 09:19:09 +0000 ----------------------------------------- Change: cf677362a133592236f3a438ba339ae0fa030c80 Author: Chris 'BinGOs' Williams Date : 2018-09-17 10:19:09 +0000 Release engineering for 2.28 Change: d712a41b23990ecbee9050b997532b8c6b4c6065 Author: Damyan Ivanov Date : 2018-09-16 20:51:07 +0000 add support for IPv6 ================================================= Plus 41 releases after 2018-05-09 00:00:00 +0000. ================================================= POE-Component-Server-SimpleHTTP-2.30/dist.ini000644 001751 001751 00000001610 14426154312 021466 0ustar00bingosbingos000000 000000 name = POE-Component-Server-SimpleHTTP version = 2.30 author = Apocalypse license = Perl_5 copyright_holder = Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn [@BINGOS] [DynamicPrereqs] -delimiter = | -raw = |test_requires('POE::Component::Client::HTTP', '0.82') if prompt_default_no('Do you want to test streaming ( requires POE::Component::Client::HTTP )'); -raw = |requires('POE::Component::SSLify', '0.04') if prompt_default_no('Do you want SSL support ( requires POE::Component::SSLify )'); [Prereqs / ConfigureRequires] ExtUtils::MakeMaker = 0 [Prereqs / TestRequires] ExtUtils::MakeMaker = 6.59 POE::Filter::HTTP::Parser = 1.06 Test::More = 0.47 Test::POE::Client::TCP = 1.24 [Prereqs] Carp = 0 HTTP::Date = 0 HTTP::Request = 0 HTTP::Response = 0 Moose = 0.9 MooseX::POE = 0.205 POE = 1.0000 Socket = 0 Storable = 0 Sys::Hostname = 0 perl = 5.006 POE-Component-Server-SimpleHTTP-2.30/META.yml000644 001751 001751 00000002115 14426154312 021274 0ustar00bingosbingos000000 000000 --- abstract: 'Perl extension to serve HTTP requests in POE.' author: - 'Apocalypse ' build_requires: ExtUtils::MakeMaker: '6.59' File::Spec: '0' IO::Handle: '0' IPC::Open3: '0' POE::Filter::HTTP::Parser: '1.06' Test::More: '0.47' Test::POE::Client::TCP: '1.24' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: POE-Component-Server-SimpleHTTP requires: Carp: '0' HTTP::Date: '0' HTTP::Request: '0' HTTP::Response: '0' Moose: '0.9' MooseX::POE: '0.205' POE: '1.0000' Socket: '0' Storable: '0' Sys::Hostname: '0' perl: '5.006' resources: homepage: https://github.com/bingos/poe-component-server-simplehttp repository: https://github.com/bingos/poe-component-server-simplehttp.git version: '2.30' x_generated_by_perl: v5.36.1 x_serialization_backend: 'YAML::Tiny version 1.74' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' POE-Component-Server-SimpleHTTP-2.30/MANIFEST000644 001751 001751 00000001174 14426154312 021160 0ustar00bingosbingos000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.030. Changes Changes.old Changes.svn LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini examples/prefork.pl examples/proxy.pl examples/server.pl examples/stream.pl lib/POE/Component/Server/SimpleHTTP.pm lib/POE/Component/Server/SimpleHTTP/Connection.pm lib/POE/Component/Server/SimpleHTTP/Response.pm lib/POE/Component/Server/SimpleHTTP/State.pm t/00-compile.t t/02_simple.t t/02_simple_ipv6.t t/03_bad_handler.t t/03_bad_request.t t/04_run_close.t t/04_run_keepalive.t t/05_post.t t/06_stream.t t/author-pod-coverage.t t/author-pod-syntax.t todo POE-Component-Server-SimpleHTTP-2.30/META.json000644 001751 001751 00000003765 14426154312 021460 0ustar00bingosbingos000000 000000 { "abstract" : "Perl extension to serve HTTP requests in POE.", "author" : [ "Apocalypse " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "POE-Component-Server-SimpleHTTP", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Pod::Coverage::TrustPod" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08" } }, "runtime" : { "requires" : { "Carp" : "0", "HTTP::Date" : "0", "HTTP::Request" : "0", "HTTP::Response" : "0", "Moose" : "0.9", "MooseX::POE" : "0.205", "POE" : "1.0000", "Socket" : "0", "Storable" : "0", "Sys::Hostname" : "0", "perl" : "5.006" } }, "test" : { "requires" : { "ExtUtils::MakeMaker" : "6.59", "File::Spec" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "POE::Filter::HTTP::Parser" : "1.06", "Test::More" : "0.47", "Test::POE::Client::TCP" : "1.24" } } }, "release_status" : "stable", "resources" : { "homepage" : "https://github.com/bingos/poe-component-server-simplehttp", "repository" : { "type" : "git", "url" : "https://github.com/bingos/poe-component-server-simplehttp.git", "web" : "https://github.com/bingos/poe-component-server-simplehttp" } }, "version" : "2.30", "x_generated_by_perl" : "v5.36.1", "x_serialization_backend" : "Cpanel::JSON::XS version 4.36", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } POE-Component-Server-SimpleHTTP-2.30/Changes.old000644 001751 001751 00000010031 14426154312 022067 0ustar00bingosbingos000000 000000 Revision history for Perl extension POE::Component::Server::SimpleHTTP. Switched to new Changes log from SVN * 1.16 Kwalitee fixes. * 1.15 Changed SSLify to require instead of use. * 1.14 Changed the defaults for the Prefork and SSLify to 'no'. Applied streaming support patches from eriam. Converted Makefile.PL to Module::Install. * 1.13 learned about the difference between ref $self and ref( $self ) Kwalitee-related fixes * 1.12 Finally use a Changes file - thanks RT #18981 Added some debug stuff Cleanup of POD files Fixed a long-standing bug of closing requests if they sent a EOF Removed the PreFork test ( cannot disable if told installer to not install it! ) * 1.11 Fixed the bug where no HEADERS resulted in a explosion, thanks BinGOs! PreForking added, look at SimpleHTTP::PreFork, thanks Stephen! * 1.10 Rearranged some DEBUG printouts Added some more 'return 1;' for POEization Fixed STOPLISTEN/STARTLISTEN error Added experimental SSL support via PoCo::SSLify * 1.09 Fixed a small bug regarding the timing of SHUTDOWN GRACEFUL I always forget to supply the session parameter to $kernel->call() :X * 1.08 Made the SHUTDOWN event more smarter with the 'GRACEFUL' argument Added the STARTLISTEN event to complement the STOPLISTEN event Caught a minor bug -> If the client closed the socket and SimpleHTTP got an socket error, it will delete the wheel, resulting in confusion when we get the DONE/CLOSE event Added $response->connection->dead boolean argument to check for the presence of a dead client Re-jigging of internals ;) Documented the only way to leak memory in SimpleHTTP ( hopefully heh ) Added the end-run leak checking to bite programmers that discard SimpleHTTP::Response objects :-) I am considering putting SimpleHTTP::Response, HTTP::Request, SimpleHTTP::Connection into one super-object, called SimpleHTTP::Request This object will have the HTTP::Request, HTTP::Response, SimpleHTTP::Connection objects hanging off it: $client->request() # HTTP::Request $client->response() # HTTP::Response $client->connection() # SimpleHTTP::Connection If I get enough ayes from people, I will go ahead and implement this change for a cleaner design. E-MAIL me your opinion or it will be ignored :) * 1.07 Added the STOPLISTEN event, to make it shutdown the listening socket to help larger programs shutdown cleanly Removed the CHANGES file, as it is redundant :) Added "return 1;" everywhere I could to avoid the nasty copy-on-exit POE bug squashed in 1.05 * 1.06 Fixed SHUTDOWN to cleanly kill sockets, checking for definedness first Fixed new() to remove options that exist, but is undef -> results in croaking when DEBUG is on Added the CLOSE event to kill sockets without sending any output * 1.05 Got rid of POE::Component::Server::TCP and replaced it with POE::Wheel::SocketFactory for speed/efficiency As the documentation for POE::Filter::HTTPD says, updated POD to reflect the HTTP::Request/Response issue Got rid of SimpleHTTP::Request, due to moving of the Connection object to Response -> Found a circular leak by having SimpleHTTP::Connection in SimpleHTTP::Request, to get rid of it, moved it to Response -> Realized that sometimes HTTP::Request will be undef, so how would you get the Connection object? Internal tweaking to save some memory Added the MAX_RETRIES subroutine More extensive DEBUG statements POD updates Paul Visscher tracked down the HTTP::Request object leak, thanks! Cleaned up the Makefile.PL Benchmarked and found a significant speed difference between post()ing and call()ing the DONE event -> The call() method is ~8% faster -> However, the chance of connecting sockets timing out is greater... * 1.04 Fixed a bug reported by Tim Wood about socket disappearing Fixed *another* bug in the Connection object, pesky CaPs! ( Again, reported by Tim Wood ) * 1.03 Added the GETHANDLERS/SETHANDLERS event POD updates Fixed SimpleHTTP::Connection to get rid of the funky CaPs * 1.02 Small fix regarding the Got_Error routine for Wheel::ReadWrite * 1.01 Initial Revision POE-Component-Server-SimpleHTTP-2.30/Changes.svn000644 001751 001751 00000042313 14426154312 022127 0ustar00bingosbingos000000 000000 ======================== 2009-02-26 16:24:08 1.56 ======================== 2009-02-26 16:21:41 (r140) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M ADDRESS was not being passed through to the SocketFactory as an option. It does now ======================== 2009-01-23 07:27:00 1.54 ======================== 2009-01-23 07:23:17 (r138) by bingos lib/POE/Component/Server/SimpleHTTP/PreFork.pm M; t/05_post.t M; t/04_run_close.t M; t/04_run_keepalive.t M; lib/POE/Component/Server/SimpleHTTP/Response.pm M; lib/POE/Component/Server/SimpleHTTP/Connection.pm M; lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Move testsuite to use POE::Filter::HTTP::Parser, perltidy everything, bump version =========================== 2009-01-22 08:50:54 1.53_03 =========================== 2009-01-22 08:50:31 (r136) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Bump development release version 2009-01-22 08:49:21 (r135) by bingos t/04_run_keepalive.t M; lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Ran perltidy against SimpleHTTP.pm, fixed keepalive test =========================== 2009-01-21 14:05:58 1.53_02 =========================== 2009-01-21 14:05:18 (r133) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Forgot the dependency on Test::POE::Client::TCP for the new tests. doh. =========================== 2009-01-20 16:07:32 1.53_01 =========================== 2009-01-20 16:06:43 (r131) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Give it a development version and ship for the CPAN Testers to smoke 2009-01-20 16:00:37 (r130) by bingos t/05_post.t A; t/02_simple.t A; t/08_post.t D; t/04_run_close.t A; t/04_run_keepalive.t A; t/03_pod_coverage.t D; lib/POE/Component/Server/SimpleHTTP.pm M; t/03_bad_request.t A; MANIFEST M; Changes M; t/99_pod.t A; t/07_bad_request.t D; t/11_keepalive.t D; t/04_test_kwalitee.t D; t/05_run.t D; t/99_pod_coverage.t A; Makefile.PL M; t/02_pod.t D; t/03_bad_handler.t A Houston we appear to have a refactored testsuite. Yes, it really works. And consistently as well. hurrah 2009-01-19 21:23:03 (r128) by bingos t/05_run.t M; t/07_bad_request.t M; t/11_keepalive.t M Hopefully fixed mysteriously failing tests, by making the STDOUT "hot" in the forked process 2009-01-19 21:07:42 (r126) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Fix [rt.cpan.org #42444] reported by pravus ======================== 2008-12-17 10:42:57 1.50 ======================== 2008-12-17 10:39:28 (r124) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Fix applied for RT #41780 2008-11-15 08:53:26 (r123) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Some code tidying ======================== 2008-09-05 15:39:31 1.48 ======================== 2008-09-05 15:36:56 (r121) by bingos; Makefile.PL M Added makemaker_args() directive to Makefile.PL, thanks to Matt Trout for that tip 2008-09-05 15:34:46 (r120) by bingos lib/POE/Component/Server/SimpleHTTP/PreFork.pm M; lib/POE/Component/Server/SimpleHTTP/Response.pm M; lib/POE/Component/Server/SimpleHTTP/Connection.pm M; lib/POE/Component/Server/SimpleHTTP.pm M Removed the FATAL => 'all' from use warnings. suggested by Andreas Gudmundsson 2008-09-05 15:24:08 (r119) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Downstream Debian patch applied RT #38743 by Martin Ferrari ======================== 2008-04-14 12:09:28 1.46 ======================== 2008-04-14 12:08:42 (r117) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Fixed PROXYMODE setting handling ======================== 2008-04-14 11:30:47 1.44 ======================== 2008-04-14 11:27:08 (r115) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Added PROXYMODE setting 2008-04-03 15:18:15 (r114) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M; lib/POE/Component/Server/SimpleHTTP.pm M Dont flush option added in the Response object and corrected case. 2008-02-22 01:12:35 (r113) by agaran; todo A - BinGOs, dont kill me, but i like to have todo to consider 2008-02-22 00:42:03 (r112) by agaran; t/11_keepalive.t M - random port used for testing, helped for me in few cases 2008-02-20 20:49:27 (r111) by agaran lib/POE/Component/Server/SimpleHTTP.pm M - missed one letter 2008-02-20 17:16:43 (r110) by agaran lib/POE/Component/Server/SimpleHTTP.pm M - new LOG2HANDLER which is fired after servicing request ======================== 2008-02-13 08:42:59 1.42 ======================== 2008-02-13 08:29:28 (r108) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M Increased the requirement of PoCo-Client-HTTP to version 0.82 as per RT#33201 ======================== 2008-01-17 15:32:57 1.40 ======================== 2008-01-17 15:31:39 (r106) by bingos t/01_load.t M; lib/POE/Component/Server/SimpleHTTP.pm M; Changes M "Fixed" the uppercase options annoyance. Hurrah. ======================== 2008-01-17 14:53:21 1.38 ======================== 2008-01-17 14:45:39 (r104) by bingos t/09_prefork_maxrequestperchild.t M; lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Amended the test count in 09_prefork test, reported by UltraDM. ======================== 2008-01-14 21:26:41 1.36 ======================== 2008-01-14 21:25:39 (r102) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Applied a patch from Maciej Pijanka (agaran) ======================== 2008-01-09 15:29:51 1.34 ======================== 2008-01-09 09:41:15 (r100) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Makefile.PL M; Changes M Bumped required version of POE to 0.9999 to fix problem with POE::Filter::HTTPD and bad requests ======================== 2008-01-08 10:13:14 1.32 ======================== 2008-01-08 10:11:41 (r98) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Fixed problem with bad requests, reported by agaran ======================== 2007-12-21 16:59:05 1.30 ======================== 2007-12-21 16:56:40 (r96) by bingos t/09_prefork_maxrequestperchild.t M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M; Makefile.PL M; Changes M; t/10_prefork_stream.t M Minor amendments prior to CPAN Release 2007-12-20 02:28:51 (r95) by leolo; Makefile.PL M Added build_requires LWP::ConnCache 2007-12-20 02:27:49 (r94) by leolo lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M; t/11_keepalive.t A Added HTTP/1.1 keep-alive support. - Off by default, turn on with KEEPALIVE=>1 - Added t/11_keepalive.t to test above Created Fix_Headers() which adds default response headers for both stream and normal responses. Responses to HEAD requests shouldn't have Content-Length set! Default content-type is now text/plain 2007-12-17 15:26:10 (r93) by leolo t/05_run.t M; lib/POE/Component/Server/SimpleHTTP/Connection.pm M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M Changed the on_close interface to 'SETCLOSEHANDLER' which is closer to the normal SimpleHTTP interface. 2007-12-14 20:41:39 (r92) by leolo t/05_run.t M; lib/POE/Component/Server/SimpleHTTP/Connection.pm M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M Added Server::SimpleHTTP::Connection->ID Added Server::SimpleHTTP::Connection->on_close Modified t/05_run.t and t/06_stream.t to test the above Documented the above ======================== 2007-12-13 13:56:17 1.28 ======================== 2007-12-13 13:55:58 (r90) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Bump version for release =========================== 2007-12-13 13:05:37 1.27_03 =========================== 2007-12-13 13:05:20 (r88) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Made setting an ALIAS optional =========================== 2007-12-13 09:45:04 1.27_02 =========================== 2007-12-13 09:44:15 (r85) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M; Makefile.PL M Only make PoCo-Client-HTTP a build_prereq if explicitly requested or Prefork support has been requested 2007-12-13 08:22:38 (r83) by bingos t/05_run.t M; t/08_post.t M; lib/POE/Component/Server/SimpleHTTP.pm M; t/07_bad_request.t M Adjusted timing of the tests. ======================== 2007-12-11 17:42:57 1.26 ======================== 2007-12-11 17:42:24 (r81) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Bump version for release 2007-12-11 17:40:36 (r80) by bingos t/05_run.t M; t/08_post.t M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M; t/07_bad_request.t M Refactored all tests apart from the Prefork tests to use POE::Wheel::Run or equivalent instead of fork(). 2007-12-11 13:42:26 (r79) by bingos; t/05_run.t M; Changes M Refactored 05_run.t to remove fork() and use POE::Wheel::Run instead. ======================== 2007-11-29 12:11:45 1.25 ======================== 2007-11-29 12:10:14 (r77) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M; t/07_bad_request.t M Fixed one of the test cases for MSWin32 ======================== 2007-11-01 15:08:54 1.24 ======================== 2007-11-01 15:07:15 (r75) by bingos t/05_run.t M; t/08_post.t M; lib/POE/Component/Server/SimpleHTTP.pm M; t/06_stream.t M; Makefile.PL M; t/07_bad_request.t M Changes to skip fork tests on MSWin32 2007-07-13 10:27:38 (r74) by bingos t/5_run.t D; t/9_prefork_maxrequestperchild.t D; t/08_post.t A; t/03_pod_coverage.t A; t/1_load.t D; t/06_stream.t A; MANIFEST M; t/2_pod.t D; t/07_bad_request.t A; t/04_test_kwalitee.t A; t/05_run.t A; t/09_prefork_maxrequestperchild.t A; t/8_post.t D; t/01_load.t A; t/3_pod_coverage.t D; t/6_stream.t D; t/02_pod.t A; t/10_prefork_stream.t M; t/7_bad_request.t D; t/4_test_kwalitee.t D Fixed the skipall in the tests requiring IPC::Shareable. Renumbered tests 2007-07-12 18:53:12 (r73) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M Made ADDRESS parameter optional, thanks to Zach Roberts for pointing that out. Updated the documentation. Fixed MANIFEST 2007-07-08 09:09:11 (r72) by eriam t/9_prefork_maxrequestperchild.t M; t/10_prefork_stream.t M Added SKIP and tweaked the test that forks childs so I does not mess up with Test::More 2007-07-07 20:58:46 (r71) by avinash240 lib/POE/Component/Server/SimpleHTTP/PreFork.pm M; t/9_prefork_maxrequestperchild.t A; t/8_post.t A; lib/POE/Component/Server/SimpleHTTP/Response.pm M; lib/POE/Component/Server/SimpleHTTP.pm M; t/6_stream.t M; t/10_prefork_stream.t A Merging in PUSH branch, DO NOT push out to CPAN before making sure test cases are Prefork aware and 7_bad_request.t pass. 2007-06-07 16:42:36 (r60) by bingos; t/3_pod_coverage.t A Added back t/3_pod_coverage.t 2007-04-30 23:54:04 (r51) by avinash240; t/7_bad_request.t M Saved bad request test, which cannot be commited til new version of POE is release. 2007-04-27 22:01:30 (r50) by avinash240 Makefile.PL M; t/7_bad_request.t A Committing failing test case which illustrates issue with external Wheel which SimpleHTTP uses for handing off HTTP::Requests to it's Got_Input handler. 2007-04-27 18:37:56 (r49) by avinash240 t/7_stream_dont_flush.pl D; lib/POE/Component/Server/SimpleHTTP/Response.pm M; t/3_pod_coverage.t D; lib/POE/Component/Server/SimpleHTTP.pm M; t/6_stream.t M; Changes M; t/7_stream_dont_flush.t D Removing push branch work from trunk. It is now under branches/push. 2007-04-26 08:40:39 (r45) by eriam lib/POE/Component/Server/SimpleHTTP.pm M + new api + dont_flush option + POD !! 2007-04-26 08:29:53 (r44) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M + dont_flush option 2007-04-26 08:29:12 (r43) by eriam; t/7_stream_dont_flush.t A ! extension name .. 2007-04-26 08:28:30 (r42) by eriam; t/7_stream_dont_flush.pl A + new api + option for giving the user the ability to do his callbacks on his own 2007-04-26 08:27:36 (r41) by eriam; t/6_stream.t M + new api 2007-03-21 18:20:53 (r36) by bingos; t/3_pod_coverage.t A; Changes M Forgot to add pod_coverage test to svn ======================== 2007-03-21 18:02:05 1.23 ======================== 2007-03-21 17:59:56 (r34) by avinash240 lib/POE/Component/Server/SimpleHTTP.pm M Bumping up version number. 2007-03-21 17:54:25 (r33) by avinash240; Makefile.PL M Fixing build requirement issues for streaming tests. ======================== 2007-03-21 08:44:13 1.22 ======================== 2007-03-21 08:42:20 (r31) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M; Changes M Added files to MANIFEST. Bumped version number for release. 2007-03-20 18:39:13 (r30) by eriam; t/6_stream.t A + test for streaming .. 2007-03-19 19:36:47 (r29) by eriam lib/POE/Component/Server/SimpleHTTP.pm M + pod and modified parameters passed to the stream event (everything is contained in a hash) 2007-03-19 19:34:41 (r28) by eriam; examples/stream.pl A sample of the streaming feature 2007-03-16 10:49:44 (r27) by eriam lib/POE/Component/Server/SimpleHTTP.pm M + test for streamed wheel + POST stream event to foreign session 2007-03-16 10:48:09 (r26) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M added STREAM_SESSION to allow other POE session to register the STREAM event ======================== 2007-03-15 19:36:38 1.21 ======================== 2007-03-15 19:35:12 (r24) by bingos lib/POE/Component/Server/SimpleHTTP.pm M Bumped the version number for release 2007-03-08 14:27:26 (r23) by avinash240 lib/POE/Component/Server/SimpleHTTP.pm M Updated POD in regards to the Log Handler session and how its arguments changed based on malformed client requests. 2007-03-08 04:29:40 (r22) by avinash240 lib/POE/Component/Server/SimpleHTTP.pm M Server now handles malformed requests better. Will not try to dispatch to a handler when receiving a malformed request. 2007-03-06 09:25:04 (r21) by bingos; Changes M Changes updated from release. ======================== 2007-03-06 09:17:46 1.20 ======================== 2007-03-06 09:14:40 (r19) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Bumped the version number 2007-03-06 03:56:13 (r18) by avinash240 t/5_run.t M; lib/POE/Component/Server/SimpleHTTP.pm M Server no longer dies if it cannot find a handler for a path, now it returns a response with a 404 code along with the content '404 Not Found' per RFC description. 2007-03-05 00:02:24 (r17) by avinash240 lib/POE/Component/Server/SimpleHTTP.pm M Server will now croak if it has a handler registered for the directory but has a problem posting to it. ======================== 2007-02-15 17:23:44 1.19 ======================== 2007-02-15 17:22:33 (r14) by bingos t/5_run.t A; lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M Added avinash240's test from branch/push 2007-02-15 17:12:36 (r12) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; Changes M Hacked to make the HEAP an object and added some methods ======================== 2007-02-15 14:47:56 1.17 ======================== 2007-02-15 14:46:02 (r10) by bingos; t/4_test_kwalitee.t A Added kwalitee test. 2007-02-15 14:45:34 (r9) by bingos tools A; Changes.old A; lib/POE/Component/Server/SimpleHTTP.pm M; META.yml D; MANIFEST M; tools/svn-log.perl A; Changes R Added LOGHANDLER directive for general logging duties. Deprecated the Changes to Changes.old, added svn logging for the future Changes file. 2007-02-05 21:36:44 (r8) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M ! is_streaming 2007-02-03 19:02:35 (r7) by eriam lib/POE/Component/Server/SimpleHTTP.pm M + is_streaming needs a 1 to be initialized 2007-02-03 19:01:03 (r6) by eriam lib/POE/Component/Server/SimpleHTTP/Response.pm M ! is_streaming can now be used to test if a response is actually in streaming mode ======================== 2007-01-29 15:13:13 1.16 ======================== 2007-01-29 15:07:26 (r4) by bingos lib/POE/Component/Server/SimpleHTTP.pm M; MANIFEST M; Changes M; inc D Kwalitee fixes 2007-01-19 16:10:20 (r1) by svn README A; inc/Module A; /trunk A; lib/POE/Component/Server A; inc/Module/Install/WriteAll.pm A; t A; lib/POE/Component/Server/SimpleHTTP/Response.pm A; t/1_load.t A; lib/POE/Component/Server/SimpleHTTP.pm A; t/2_pod.t A; inc A; lib/POE/Component/Server/SimpleHTTP/PreFork.pm A; examples A; inc/Module/Install.pm A; /branches A; lib/POE/Component/Server/SimpleHTTP A; lib/POE/Component A; inc/Module/Install/Makefile.pm A; examples/server.pl A; inc/Module/Install/Metadata.pm A; lib/POE/Component/Server/SimpleHTTP/Connection.pm A; inc/Module/Install A; lib A; MANIFEST A; Changes A; inc/Module/Install/Fetch.pm A; inc/Module/Install/Can.pm A; inc/Module/Install/Win32.pm A; META.yml A; Makefile.PL A; lib/POE A; inc/Module/Install/Base.pm A; /tags A Initial repository layout ============== End of Excerpt ============== POE-Component-Server-SimpleHTTP-2.30/t/000755 001751 001751 00000000000 14426154312 020267 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.30/Makefile.PL000644 001751 001751 00000006446 14426154312 022010 0ustar00bingosbingos000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.030. use strict; use warnings; use 5.006; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Perl extension to serve HTTP requests in POE.", "AUTHOR" => "Apocalypse ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "POE-Component-Server-SimpleHTTP", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.006", "NAME" => "POE::Component::Server::SimpleHTTP", "PREREQ_PM" => { "Carp" => 0, "HTTP::Date" => 0, "HTTP::Request" => 0, "HTTP::Response" => 0, "Moose" => "0.9", "MooseX::POE" => "0.205", "POE" => "1.0000", "Socket" => 0, "Storable" => 0, "Sys::Hostname" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => "6.59", "File::Spec" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "POE::Filter::HTTP::Parser" => "1.06", "Test::More" => "0.47", "Test::POE::Client::TCP" => "1.24" }, "VERSION" => "2.30", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "ExtUtils::MakeMaker" => "6.59", "File::Spec" => 0, "HTTP::Date" => 0, "HTTP::Request" => 0, "HTTP::Response" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Moose" => "0.9", "MooseX::POE" => "0.205", "POE" => "1.0000", "POE::Filter::HTTP::Parser" => "1.06", "Socket" => 0, "Storable" => 0, "Sys::Hostname" => 0, "Test::More" => "0.47", "Test::POE::Client::TCP" => "1.24" ); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.040 test_requires('POE::Component::Client::HTTP', '0.82') if prompt_default_no('Do you want to test streaming ( requires POE::Component::Client::HTTP )'); requires('POE::Component::SSLify', '0.04') if prompt_default_no('Do you want SSL support ( requires POE::Component::SSLify )'); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.040 sub _add_prereq { my ($mm_key, $module, $version_or_range) = @_; $version_or_range ||= 0; warn "$module already exists in $mm_key (at version $WriteMakefileArgs{$mm_key}{$module}) -- need to do a sane metamerge!" if exists $WriteMakefileArgs{$mm_key}{$module} and $WriteMakefileArgs{$mm_key}{$module} ne '0' and $WriteMakefileArgs{$mm_key}{$module} ne $version_or_range; warn "$module already exists in FallbackPrereqs (at version $FallbackPrereqs{$module}) -- need to do a sane metamerge!" if exists $FallbackPrereqs{$module} and $FallbackPrereqs{$module} ne '0' and $FallbackPrereqs{$module} ne $version_or_range; $WriteMakefileArgs{$mm_key}{$module} = $FallbackPrereqs{$module} = $version_or_range; return; } sub prompt_default_no { prompt("$_[0] [y/N]", 'N') =~ /^y/i ? 1 :0; } sub requires { goto &runtime_requires } sub runtime_requires { my ($module, $version_or_range) = @_; _add_prereq(PREREQ_PM => $module, $version_or_range); } sub test_requires { my ($module, $version_or_range) = @_; _add_prereq(TEST_REQUIRES => $module, $version_or_range); } POE-Component-Server-SimpleHTTP-2.30/examples/000755 001751 001751 00000000000 14426154312 021642 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.30/lib/000755 001751 001751 00000000000 14426154312 020572 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.30/lib/POE/000755 001751 001751 00000000000 14426154312 021215 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.30/lib/POE/Component/000755 001751 001751 00000000000 14426154312 023157 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.30/lib/POE/Component/Server/000755 001751 001751 00000000000 14426154312 024425 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.30/lib/POE/Component/Server/SimpleHTTP.pm000644 001751 001751 00000140663 14426154312 026726 0ustar00bingosbingos000000 000000 package POE::Component::Server::SimpleHTTP; $POE::Component::Server::SimpleHTTP::VERSION = '2.30'; #ABSTRACT: Perl extension to serve HTTP requests in POE. use strict; use warnings; use POE; use POE::Wheel::SocketFactory; use POE::Wheel::ReadWrite; use POE::Filter::HTTPD; use POE::Filter::Stream; use Carp qw( croak ); use Socket qw( AF_INET AF_INET6 INADDR_ANY IN6ADDR_ANY inet_pton ); use HTTP::Date qw( time2str ); use POE::Component::Server::SimpleHTTP::Connection; use POE::Component::Server::SimpleHTTP::Response; use POE::Component::Server::SimpleHTTP::State; BEGIN { # Debug fun! if ( !defined &DEBUG ) { eval "sub DEBUG () { 0 }"; } # Our own definition of the max retries if ( !defined &MAX_RETRIES ) { eval "sub MAX_RETRIES () { 5 }"; } } use MooseX::POE; use Moose::Util::TypeConstraints; has 'alias' => ( is => 'ro', ); has 'domain' => ( is => 'ro', ); has 'address' => ( is => 'ro', ); has 'port' => ( is => 'ro', default => sub { 0 }, writer => '_set_port', ); has 'hostname' => ( is => 'ro', default => sub { require Sys::Hostname; return Sys::Hostname::hostname(); }, ); has 'proxymode' => ( is => 'ro', isa => 'Bool', default => sub { 0 }, ); has 'keepalive' => ( is => 'ro', isa => 'Bool', default => sub { 0 }, ); has 'sslkeycert' => ( is => 'ro', isa => subtype 'ArrayRef' => where { scalar @$_ == 2 }, ); has 'sslintermediatecacert' => ( is => 'ro', isa => 'Str', ); has 'headers' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'handlers' => ( is => 'ro', isa => 'ArrayRef', required => 1, writer => '_set_handlers', ); has 'errorhandler' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'loghandler' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'log2handler' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'setuphandler' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, ); has 'retries' => ( traits => ['Counter'], is => 'ro', isa => 'Num', default => sub { 0 }, handles => { inc_retry => 'inc', dec_retry => 'dec', reset_retries => 'reset', }, ); has '_requests' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, init_arg => undef, clearer => '_clear_requests', ); has '_connections' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, init_arg => undef, clearer => '_clear_connections', ); has '_chunkcount' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, init_arg => undef, clearer => '_clear_chunkcount', ); has '_responses' => ( is => 'ro', isa => 'HashRef', default => sub {{}}, init_arg => undef, clearer => '_clear_responses', ); has '_factory' => ( is => 'ro', isa => 'POE::Wheel::SocketFactory', init_arg => undef, clearer => '_clear_factory', writer => '_set_factory', ); sub BUILDARGS { my $class = shift; my %args = @_; $args{lc $_} = delete $args{$_} for keys %args; if ( $args{sslkeycert} and ref $args{sslkeycert} eq 'ARRAY' and scalar @{ $args{sslkeycert} } == 2 ) { eval { require POE::Component::SSLify; import POE::Component::SSLify qw( SSLify_Options SSLify_GetSocket Server_SSLify SSLify_GetCipher SSLify_GetCTX ); SSLify_Options( @{ $args{sslkeycert} } ); }; if ($@) { warn "Unable to load PoCo::SSLify -> $@" if DEBUG; delete $args{sslkeycert}; } else { if ( $args{sslintermediatecacert} ) { my $ctx = SSLify_GetCTX(); Net::SSLeay::CTX_load_verify_locations($ctx, $args{sslintermediatecacert}, ''); } } } return $class->SUPER::BUILDARGS(%args); } sub session_id { shift->get_session_id; } sub getsockname { shift->_factory->getsockname; } sub shutdown { my $self = shift; $poe_kernel->call( $self->get_session_id, 'SHUTDOWN', @_ ); } # This subroutine, when SimpleHTTP exits, will search for leaks sub STOP { my $self = $_[OBJECT]; # Loop through all of the requests foreach my $req ( keys %{ $self->_requests } ) { # Bite the programmer! warn 'Did not get DONE/CLOSE event for Wheel ID ' . $req . ' from IP ' . $self->_requests->{$req}->response->connection->remote_ip; } # All done! return 1; } sub START { my ($kernel,$self) = @_[KERNEL,OBJECT]; $kernel->alias_set( $self->alias ) if $self->alias; $kernel->refcount_increment( $self->get_session_id, __PACKAGE__ ) unless $self->alias; MassageHandlers( $self->handlers ); # Start Listener $kernel->yield( 'start_listener' ); return; } # 'SHUTDOWN' # Stops the server! event 'SHUTDOWN' => sub { my ($kernel,$self,$graceful) = @_[KERNEL,OBJECT,ARG0]; # Shutdown the SocketFactory wheel $self->_clear_factory if $self->_factory; # Debug stuff warn 'Stopped listening for new connections!' if DEBUG; # Are we gracefully shutting down or not? if ( $graceful ) { # Check for existing requests and keep-alive connections if ( keys( %{ $self->_requests } ) == 0 and keys( %{ $self->_connections } ) == 0 ) { # Alright, shutdown anyway # Delete our alias $kernel->alias_remove( $_ ) for $kernel->alias_list(); $kernel->refcount_decrement( $self->get_session_id, __PACKAGE__ ) unless $self->alias; # Debug stuff warn 'Stopped SimpleHTTP gracefully, no requests left' if DEBUG; } # All done! return 1; } # Forcibly close all sockets that are open foreach my $S ( $self->_requests, $self->_connections ) { foreach my $conn ( keys %$S ) { # Can't call method "shutdown_input" on an undefined value at # /usr/lib/perl5/site_perl/5.8.2/POE/Component/Server/SimpleHTTP.pm line 323. if ( defined $S->{$conn}->wheel and defined $S->{$conn}->wheel->get_input_handle() ) { $S->{$conn}->close_wheel; } # Delete this request delete $S->{$conn}; } } # Delete our alias $kernel->alias_remove( $_ ) for $kernel->alias_list(); $kernel->refcount_decrement( $self->get_session_id, __PACKAGE__ ) unless $self->alias; # Debug stuff warn 'Successfully stopped SimpleHTTP' if DEBUG; # Return success return 1; }; # Sets up the SocketFactory wheel :) event 'start_listener' => sub { my ($kernel,$self,$noinc) = @_[KERNEL,OBJECT,ARG0]; warn "Creating SocketFactory wheel now\n" if DEBUG; # Check if we should set up the wheel if ( $self->retries == MAX_RETRIES ) { die 'POE::Component::Server::SimpleHTTP tried ' . MAX_RETRIES . ' times to create a Wheel and is giving up...'; } else { $self->inc_retry unless $noinc; my $domain = $self->domain; my $bindaddress = $self->address; if ( not defined $bindaddress and not defined $domain ) { $domain = AF_INET6; $bindaddress = IN6ADDR_ANY; } elsif ( not defined $bindaddress ) { if ( $domain == AF_INET6 ) { $bindaddress = IN6ADDR_ANY; } elsif ( $domain == AF_INET ) { $bindaddress = INADDR_ANY; } } else { if ( defined inet_pton(AF_INET6, $bindaddress) ) { $domain = AF_INET6; } elsif ( defined inet_pton(AF_INET, $bindaddress) ) { $domain = AF_INET; } } # Create our own SocketFactory Wheel :) my $factory = POE::Wheel::SocketFactory->new( ( $domain ? ( SocketDomain => $domain ) : () ), ( $bindaddress ? ( BindAddress => $bindaddress ) : () ), BindPort => $self->port, Reuse => 'yes', SuccessEvent => 'got_connection', FailureEvent => 'listener_error', ); my ( $family, $address, $port, $straddress ) = POE::Component::Server::SimpleHTTP::Connection->get_sockaddr_info( $factory->getsockname ); $self->_set_port( $port ) if ( $self->port == 0 and $port ); $self->_set_factory( $factory ); if ( $self->setuphandler ) { my $setuphandler = $self->setuphandler; if ( $setuphandler->{POSTBACK} and ref $setuphandler->{POSTBACK} eq 'POE::Session::AnonEvent' ) { $setuphandler->{POSTBACK}->( $port, $address ); } else { $kernel->post( $setuphandler->{'SESSION'}, $setuphandler->{'EVENT'}, $port, $address, ) if $setuphandler->{'SESSION'} and $setuphandler->{'EVENT'}; } } } return 1; }; # Got some sort of error from SocketFactory event listener_error => sub { my ($kernel,$self,$operation,$errnum,$errstr,$wheel_id) = @_[KERNEL,OBJECT,ARG0..ARG3]; warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n" if DEBUG; $self->call( 'start_listener' ); return 1; }; # 'STARTLISTEN' # Starts listening on the socket event 'STARTLISTEN' => sub { warn 'STARTLISTEN called, resuming accepts on SocketFactory' if DEBUG; $_[OBJECT]->call( 'start_listener', 'noinc' ); return 1; }; # 'STOPLISTEN' # Stops listening on the socket event 'STOPLISTEN' => sub { my $self = $_[OBJECT]; warn 'STOPLISTEN called, pausing accepts on SocketFactory' if DEBUG; $self->_clear_factory if $self->_factory; return 1; }; # 'SETHANDLERS' # Sets the HANDLERS event 'SETHANDLERS' => sub { my ($self,$handlers) = @_[OBJECT,ARG0]; MassageHandlers($handlers); $self->_set_handlers( $handlers ); return 1; }; # 'GETHANDLERS' # Gets the HANDLERS event 'GETHANDLERS' => sub { my ($kernel,$self,$session,$event ) = @_[KERNEL,OBJECT,ARG0,ARG1]; return unless $session and $event; require Storable; my $handlers = Storable::dclone( $self->handlers ); delete $_->{'RE'} for @{ $handlers }; $kernel->post( $session, $event, $handlers ); return 1; }; # This subroutine massages the HANDLERS for internal use # Should probably support POSTBACK/CALLBACK sub MassageHandlers { my $handler = shift; # Make sure it is ref to array if ( !ref $handler or ref($handler) ne 'ARRAY' ) { croak("HANDLERS is not a ref to an array!"); } # Massage the handlers my $count = 0; while ( $count < scalar(@$handler) ) { # Must be ref to hash if ( ref $handler->[$count] and ref( $handler->[$count] ) eq 'HASH' ) { # Make sure all the keys are uppercase $handler->[$count]->{ uc $_ } = delete $handler->[$count]->{$_} for keys %{ $handler->[$count] }; # Make sure it got the 3 parts necessary if ( !exists $handler->[$count]->{'SESSION'} or !defined $handler->[$count]->{'SESSION'} ) { croak("HANDLER number $count does not have a SESSION argument!"); } if ( !exists $handler->[$count]->{'EVENT'} or !defined $handler->[$count]->{'EVENT'} ) { croak("HANDLER number $count does not have an EVENT argument!"); } if ( !exists $handler->[$count]->{'DIR'} or !defined $handler->[$count]->{'DIR'} ) { croak("HANDLER number $count does not have a DIR argument!"); } # Convert SESSION to ID if ( UNIVERSAL::isa( $handler->[$count]->{'SESSION'}, 'POE::Session' ) ) { $handler->[$count]->{'SESSION'} = $handler->[$count]->{'SESSION'}->ID; } # Convert DIR to qr// format my $regex = undef; eval { $regex = qr/$handler->[ $count ]->{'DIR'}/ }; # Check for errors if ($@) { croak("HANDLER number $count has a malformed DIR -> $@"); } else { # Store it! $handler->[$count]->{'RE'} = $regex; } } else { croak("HANDLER number $count is not a reference to a HASH!"); } # Done with this one! $count++; } # Got here, success! return 1; } # 'Got_Connection' # The actual manager of connections event 'got_connection' => sub { my ( $kernel, $self, $socket ) = @_[KERNEL, OBJECT, ARG0]; my ( $family, $address, $port, $straddress ) = POE::Component::Server::SimpleHTTP::Connection->get_sockaddr_info( getpeername($socket) ); # Should we SSLify it? if ( $self->sslkeycert ) { # SSLify it! eval { $socket = Server_SSLify($socket) }; if ($@) { warn "Unable to turn on SSL for connection from $straddress -> $@"; close $socket; return 1; } } # Set up the Wheel to read from the socket my $wheel = POE::Wheel::ReadWrite->new( Handle => $socket, Filter => POE::Filter::HTTPD->new(), InputEvent => 'got_input', FlushedEvent => 'got_flush', ErrorEvent => 'got_error', ); if ( DEBUG and keys %{ $self->_connections } ) { # use Data::Dumper; warn "conn id=", $wheel->ID, " [", join( ', ', keys %{ $self->_connections } ), "]"; } # Save this wheel! # 0 = wheel, 1 = Output done?, 2 = SimpleHTTP::Response object, 3 == request, 4 == streaming? $self->_requests->{ $wheel->ID } = POE::Component::Server::SimpleHTTP::State->new( wheel => $wheel ); # Debug stuff if (DEBUG) { warn "Got_Connection completed creation of ReadWrite wheel ( " . $wheel->ID . " )"; } # Success! return 1; }; # 'Got_Input' # Finally got input, set some stuff and send away! event 'got_input' => sub { my ($kernel,$self,$request,$id) = @_[KERNEL,OBJECT,ARG0,ARG1]; my $connection; # This whole thing is a mess. Keep-Alive was bolted on and it # shows. Streaming is unpredictable. There are checks everywhere # because it leaks wheels. *sigh* # Was this request Keep-Alive? if ( $self->_connections->{$id} ) { my $state = delete $self->_connections->{$id}; $state->reset; $connection = $state->connection; $state->clear_connection; $self->_requests->{$id} = $state; warn "Keep-alive id=$id next request..." if DEBUG; } # Quick check to see if the socket died already... # Initially reported by Tim Wood unless ( $self->_requests->{$id}->wheel_alive ) { warn 'Got a request, but socket died already!' if DEBUG; # Destroy this wheel! $self->_requests->{$id}->close_wheel; delete $self->_requests->{$id}; return; } SWITCH: { last SWITCH if $connection; # connection was kept-alive # Directly access POE::Wheel::ReadWrite's HANDLE_INPUT -> to get the socket itself # Hmm, if we are SSL, then have to do an extra step! if ( $self->sslkeycert ) { $connection = POE::Component::Server::SimpleHTTP::Connection->new( SSLify_GetSocket( $self->_requests->{$id}->wheel->get_input_handle() ) ); last SWITCH; } $connection = POE::Component::Server::SimpleHTTP::Connection->new( $self->_requests->{$id}->wheel->get_input_handle() ); } # The HTTP::Response object, the path my ( $response, $path, $malformed_req ); # Check if it is HTTP::Request or Response # Quoting POE::Filter::HTTPD # The HTTPD filter parses the first HTTP 1.0 request from an incoming stream into an # HTTP::Request object (if the request is good) or an HTTP::Response object (if the # request was malformed). if ( $request->isa('HTTP::Response') ) { # Make the request nothing $response = $request; $request = undef; # Mark that this is a malformed request $malformed_req = 1; # Hack it to simulate POE::Component::Server::SimpleHTTP::Response->new( $id, $conn ); bless( $response, 'POE::Component::Server::SimpleHTTP::Response' ); $response->_WHEEL( $id ); $response->set_connection( $connection ); # Set the path to an empty string $path = ''; } else { unless ( $self->proxymode ) { # Add stuff it needs! my $uri = $request->uri; $uri->scheme('http'); $uri->host( $self->hostname ); $uri->port( $self->port ); # Get the path $path = $uri->path(); if ( !defined $path or $path eq '' ) { # Make it the default handler $path = '/'; } } else { # We're in PROXYMODE set the path to the full URI $path = $request->uri->as_string(); } # Get the response $response = POE::Component::Server::SimpleHTTP::Response->new( $id, $connection ); # Stuff the default headers $response->header( %{ $self->headers } ) if keys( %{ $self->headers } ) != 0; } # Check if the SimpleHTTP::Connection object croaked ( happens when sockets just disappear ) unless ( defined $response->connection ) { # Debug stuff warn "could not make connection object" if DEBUG; # Destroy this wheel! $self->_requests->{$id}->close_wheel; delete $self->_requests->{$id}; return; } # If we used SSL, turn on the flag! if ( $self->sslkeycert ) { $response->connection->ssl(1); # Put the cipher type for people who want it $response->connection->sslcipher( SSLify_GetCipher( $self->_requests->{$id}->wheel->get_input_handle() ) ); } if ( !defined( $request ) ) { $self->_requests->{$id}->close_wheel; delete $self->_requests->{$id}; return; } # Add this response to the wheel $self->_requests->{$id}->set_response( $response ); $self->_requests->{$id}->set_request( $request ); $response->connection->ID($id); # If they have a log handler registered, send out the needed information # TODO if we received a malformed request, we will not have a request object # We need to figure out what we're doing because they can't always expect to have # a request object, or should we keep it from being ?undef'd? if ( $self->loghandler and scalar keys %{ $self->loghandler } == 2 ) { my $ok = $kernel->post( $self->loghandler->{'SESSION'}, $self->loghandler->{'EVENT'}, $request, $response->connection->remote_ip() ); # Warn if we had a problem dispatching to the log handler above warn( "I had a problem posting to event '", $self->loghandler->{'EVENT'}, "' of the log handler alias '", $self->loghandler->{'SESSION'}, "'. As reported by Kernel: '$!', perhaps the alias is spelled incorrectly for this handler?" ) unless $ok; } # If we received a malformed request then # let's not try to dispatch to a handler if ($malformed_req) { # Just push out the response we got from POE::Filter::HTTPD saying your request was bad $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'BadRequest (by POE::Filter::HTTPD)', $response->connection->remote_ip() ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; $kernel->yield( 'DONE', $response ); return; } # Find which handler will handle this one foreach my $handler ( @{ $self->handlers } ) { # Check if this matches if ( $path =~ $handler->{'RE'} ) { # Send this off! my $ok = $kernel->post( $handler->{'SESSION'}, $handler->{'EVENT'}, $request, $response, $handler->{'DIR'}, ); # Make sure we croak if we have an issue posting croak( "I had a problem posting to event $handler->{'EVENT'} of session $handler->{'SESSION'} for DIR handler '$handler->{'DIR'}'", ". As reported by Kernel: '$!', perhaps the session name is spelled incorrectly for this handler?" ) unless $ok; # All done! return; } } # If we reached here, no handler was able to handle it... # Set response code to 404 and tell the client we didn't find anything $response->code(404); $response->content('404 Not Found'); $kernel->yield( 'DONE', $response ); return; }; # 'Got_Flush' # Finished with a request! event 'got_flush' => sub { my ($kernel,$self,$id) = @_[KERNEL,OBJECT,ARG0]; return unless defined $self->_requests->{$id}; # Debug stuff warn "Got Flush event for wheel ID ( $id )" if DEBUG; if ( $self->_requests->{$id}->streaming ) { # Do the stream ! warn "Streaming in progress ...!" if DEBUG; return; } # Check if we are shutting down if ( $self->_requests->{$id}->done ) { if ( $self->must_keepalive( $id ) ) { warn "Keep-alive id=$id ..." if DEBUG; my $state = delete $self->_requests->{$id}; $state->set_connection( $state->response->connection ); $state->reset; $self->_connections->{$id} = $state; delete $self->_chunkcount->{$id}; delete $self->_responses->{$id}; } else { # Shutdown read/write on the wheel $self->_requests->{$id}->close_wheel; delete $self->_requests->{$id}; } } else { # Ignore this, eh? if (DEBUG) { warn "Got Flush event for socket ( $id ) when we did not send anything!"; } } # Alright, do we have to shutdown? unless ( $self->_factory ) { # Check to see if we have any more requests if ( keys( %{ $self->_requests } ) == 0 and keys( %{ $self->_connections } ) == 0 ) { # Shutdown! $kernel->yield('SHUTDOWN'); } } # Success! return 1; }; # should we keep-alive the connection? sub must_keepalive { my ( $self, $id ) = @_; return unless $self->keepalive; my $resp = $self->_requests->{$id}->response; my $req = $self->_requests->{$id}->request; # error = close return 0 if $resp->is_error; # Connection is a comma-seperated header my $conn = lc ($req->header('Connection') || ''); return 0 if ",$conn," =~ /,\s*close\s*,/; $conn = lc ($req->header('Proxy-Connection') || ''); return 0 if ",$conn," =~ /,\s*close\s*,/; $conn = lc ($resp->header('Connection') || ''); return 0 if ",$conn," =~ /,\s*close\s*,/; # HTTP/1.1 = keep return 1 if $req->protocol eq 'HTTP/1.1'; return 0; } # 'Got_Error' # Got some sort of error from ReadWrite event 'got_error' => sub { my ($kernel,$self,$operation,$errnum,$errstr,$id) = @_[KERNEL,OBJECT,ARG0..ARG3]; # Only do this for non-EOF on read #unless ( $operation eq 'read' and $errnum == 0 ) { { # Debug stuff warn "Wheel $id generated $operation error $errnum: $errstr\n" if DEBUG; my $connection; if ( $self->_connections->{$id} ) { my $c = delete $self->_connections->{$id}; $connection = $c->connection; $c->close_wheel; } else { if( defined $self->_requests->{$id}->response ) { $connection = $self->_requests->{$id}->response->connection; } else { warn "response for $id is undefined" if DEBUG; } # Delete this connection $self->_requests->{$id}->close_wheel; } delete $self->_requests->{$id}; delete $self->_responses->{$id}; # Mark the client dead $connection->dead(1) if $connection; } # Success! return 1; }; # 'DONE' # Output to the client! event 'DONE' => sub { my ($kernel,$self,$response) = @_[KERNEL,OBJECT,ARG0]; # Check if we got it if ( !defined $response or !UNIVERSAL::isa( $response, 'HTTP::Response' ) ) { warn 'Did not get a HTTP::Response object!' if DEBUG; # Abort... return; } # Get the wheel ID my $id = $response->_WHEEL; # Check if the wheel exists ( sometimes it gets closed by the client, but the application doesn't know that... ) unless ( exists $self->_requests->{$id} ) { # Debug stuff warn 'Wheel disappeared, but the application sent us a DONE event, discarding it' if DEBUG; $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'Wheel disappeared !' ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; # All done! return 1; } # Check if we have already sent the response if ( $self->_requests->{$id}->done ) { # Tried to send twice! die 'Tried to send a response to the same connection twice!'; } # Quick check to see if the wheel/socket died already... # Initially reported by Tim Wood unless ( $self->_requests->{$id}->wheel_alive ) { warn 'Tried to send data over a closed/nonexistant socket!' if DEBUG; $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'Socket closed/nonexistant !' ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; return; } # Check if we were streaming. if ( $self->_requests->{$id}->streaming ) { $self->_requests->{$id}->set_streaming(0); $self->_requests->{$id}->set_done(1); # Finished streaming # TODO: We might not get a flush, trigger it ourselves. if ( !$self->_requests->{$id}->wheel->get_driver_out_messages ) { $kernel->yield( 'got_flush', $id ); } return; } $self->fix_headers( $response ); # Send it out! $self->_requests->{$id}->wheel->put($response); # Mark this socket done $self->_requests->{$id}->set_done(1); # Log FINALLY If they have a logFinal handler registered, send out the needed information if ( $self->log2handler and scalar keys %{ $self->log2handler } == 2 ) { $! = undef; $kernel->call( $self->log2handler->{'SESSION'}, $self->log2handler->{'EVENT'}, $self->_requests->{$id}->request, $response ); # Warn if we had a problem dispatching to the log handler above warn( "I had a problem posting to event '", $self->log2handler->{'EVENT'}, "' of the log handler alias '", $self->log2handler->{'SESSION'}, "'. As reported by Kernel: '$!', perhaps the alias is spelled incorrectly for this handler?" ) if $!; } # Debug stuff warn "Completed with Wheel ID $id" if DEBUG; # Success! return 1; }; # 'STREAM' # Stream output to the client event 'STREAM' => sub { my ($kernel,$self,$response) = @_[KERNEL,OBJECT,ARG0]; # Check if we got it unless ( defined $response and UNIVERSAL::isa( $response, 'HTTP::Response' ) ) { warn 'Did not get a HTTP::Response object!' if DEBUG; # Abort... return; } # Get the wheel ID my $id = $response->_WHEEL; $self->_chunkcount->{$id}++; if ( defined $response->STREAM ) { # Keep track if we plan to stream ... if ( $self->_responses->{$id} ) { warn "Restoring response from HEAP and id $id " if DEBUG; $response = $self->_responses->{$id}; } else { warn "Saving HEAP response to id $id " if DEBUG; $self->_responses->{$id} = $response; } } else { warn 'Can\'t push on a response that has not been not set as a STREAM!' if DEBUG; # Abort... return; } # Check if the wheel exists ( sometimes it gets closed by the client, but the application doesn't know that... ) unless ( exists $self->_requests->{$id} ) { # Debug stuff warn 'Wheel disappeared, but the application sent us a DONE event, discarding it' if DEBUG; $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'Wheel disappeared !' ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; # All done! return 1; } # Quick check to see if the wheel/socket died already... # Initially reported by Tim Wood unless ( $self->_requests->{$id}->wheel_alive ) { warn 'Tried to send data over a closed/nonexistant socket!' if DEBUG; $kernel->post( $self->errorhandler->{SESSION}, $self->errorhandler->{EVENT}, 'Socket closed/nonexistant !' ) if $self->errorhandler and $self->errorhandler->{SESSION} and $self->errorhandler->{EVENT}; return; } $self->fix_headers( $response, 1 ); # Sets the correct POE::Filter unless ( defined $response->IS_STREAMING ) { # Mark this socket done $self->_requests->{$id}->set_streaming(1); $response->set_streaming(1); } if (DEBUG) { warn "Sending stream via " . $response->STREAM_SESSION . "/" . $response->STREAM . " with id $id \n"; } if ( $self->_chunkcount->{$id} > 1 ) { my $wheel = $self->_requests->{ $response->_WHEEL }->wheel; $wheel->set_output_filter( POE::Filter::Stream->new() ); $wheel->put( $response->content ); } else { my $wheel = $self->_requests->{ $response->_WHEEL }->wheel; $wheel->set_output_filter( $wheel->get_input_filter() ); $wheel->put($response); } # we send the event to stream with wheels request and response to the session # that has registered the streaming event unless ( $response->DONT_FLUSH ) { $kernel->post( $response->STREAM_SESSION, # callback session $response->STREAM, # callback event $self->_responses->{ $response->_WHEEL } ); } # Success! return 1; }; # Add required headers to a response sub fix_headers { my ( $self, $response, $stream ) = @_; # Set the date if needed if ( !$response->header('Date') ) { $response->header( 'Date', time2str(time) ); } # Set the Content-Length if needed if ( !$stream and !$self->proxymode and !defined $response->header('Content-Length') and my $len = length $response->content ) { use bytes; $response->header( 'Content-Length', $len ); } # Set the Content-Type if needed if ( !$response->header('Content-Type') ) { $response->header( 'Content-Type', 'text/plain' ); } if ( !$response->protocol ) { my $request = $self->_requests->{ $response->_WHEEL }->request; return unless $request and $request->isa('HTTP::Request'); unless ( $request->method eq 'HEAD' ) { $response->protocol( $request->protocol ); } } } # 'CLOSE' # Closes the connection event 'CLOSE' => sub { my ($kernel,$self,$response) = @_[KERNEL,OBJECT,ARG0]; # Check if we got it unless ( defined $response and UNIVERSAL::isa( $response, 'HTTP::Response' ) ) { warn 'Did not get a HTTP::Response object!' if DEBUG; # Abort... return; } # Get the wheel ID my $id = $response->_WHEEL; if ( $self->_connections->{$id} ) { $self->_requests->{$id} = delete $self->_connections->{$id}; } # Check if the wheel exists ( sometimes it gets closed by the client, but the application doesn't know that... ) unless ( exists $self->_requests->{$id} ) { warn 'Wheel disappeared, but the application sent us a CLOSE event, discarding it' if DEBUG; return 1; } # Kill it! $self->_requests->{$id}->close_wheel if $self->_requests->{$id}->wheel_alive; # Delete it! delete $self->_requests->{$id}; delete $self->_responses->{$id}; warn 'Delete references to the connection done.' if DEBUG; # All done! return 1; }; # Registers a POE inline state (primarly for streaming) event 'REGISTER' => sub { my ( $session, $state, $code_ref ) = @_[ SESSION, ARG0 .. ARG1 ]; warn 'Registering state in POE session' if DEBUG; return $session->register_state( $state, $code_ref ); }; # SETCLOSEHANDLER event 'SETCLOSEHANDLER' => sub { my ($self,$sender) = @_[OBJECT,SENDER ]; my ($connection,$state,@params) = @_[ARG0..$#_]; # turn connection ID into the connection object unless ( ref $connection ) { my $id = $connection; if ( $self->_connections->{$id} ) { $connection = $self->_connections->{$id}->connection; } elsif ($self->_requests->{$id} and $self->_requests->{$id}->response ) { $connection = $self->_requests->{$id}->response->connection; } unless ( ref $connection ) { die "Can't find connection object for request $id"; } } if ($state) { $connection->_on_close( $sender->ID, $state, @params ); } else { $connection->_on_close($sender->ID); } }; no MooseX::POE; __PACKAGE__->meta->make_immutable( ); "Simple In'it"; __END__ =pod =encoding UTF-8 =head1 NAME POE::Component::Server::SimpleHTTP - Perl extension to serve HTTP requests in POE. =head1 VERSION version 2.30 =head1 SYNOPSIS use POE; use POE::Component::Server::SimpleHTTP; # Start the server! POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'PORT' => 11111, 'HOSTNAME' => 'MySite.com', 'HANDLERS' => [ { 'DIR' => '^/bar/.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_BAR', }, { 'DIR' => '^/$', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, { 'DIR' => '^/foo/.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_NULL', }, { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_ERROR', }, ], 'LOGHANDLER' => { 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_LOG', }, 'LOG2HANDLER' => { 'SESSION' => 'HTTP_GET', 'EVENT' => 'POSTLOG', }, # In the testing phase... 'SSLKEYCERT' => [ 'private-key.pem', 'public-cert.pem' ], 'SSLINTERMEDIATECACERT' => 'intermediate-ca-cert.pem', ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ); $_[KERNEL]->post( 'HTTPD', 'GETHANDLERS', $_[SESSION], 'GOT_HANDLERS' ); }, 'GOT_BAR' => \&GOT_REQ, 'GOT_MAIN' => \&GOT_REQ, 'GOT_ERROR' => \&GOT_ERR, 'GOT_NULL' => \&GOT_NULL, 'GOT_HANDLERS' => \&GOT_HANDLERS, 'GOT_LOG' => \&GOT_LOG, }, ); # Start POE! POE::Kernel->run(); sub GOT_HANDLERS { # ARG0 = HANDLERS array my $handlers = $_[ ARG0 ]; # Move the first handler to the last one push( @$handlers, shift( @$handlers ) ); # Send it off! $_[KERNEL]->post( 'HTTPD', 'SETHANDLERS', $handlers ); } sub GOT_NULL { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Kill this! $_[KERNEL]->post( 'HTTPD', 'CLOSE', $response ); } sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content( 'Some funky HTML here' ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_ERR { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Check for errors if ( ! defined $request ) { $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); return; } # Do our stuff to HTTP::Response $response->code( 404 ); $response->content( "Hi visitor from " . $response->connection->remote_ip . ", Page not found -> '" . $request->uri->path . "'" ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_LOG { # ARG0 = HTTP::Request object, ARG1 = remote IP my ($request, $remote_ip) = @_[ARG0,ARG1]; # Do some sort of logging activity. # If the request was malformed, $request = undef # CHECK FOR A REQUEST OBJECT BEFORE USING IT. if( $request ) { { warn join(' ', time(), $remote_ip, $request->uri ), "\n"; } else { warn join(' ', time(), $remote_ip, 'Bad request' ), "\n"; } return; } =head1 DESCRIPTION This module makes serving up HTTP requests a breeze in POE. The hardest thing to understand in this module is the HANDLERS. That's it! The standard way to use this module is to do this: use POE; use POE::Component::Server::SimpleHTTP; POE::Component::Server::SimpleHTTP->new( ... ); POE::Session->create( ... ); POE::Kernel->run(); =head2 Starting SimpleHTTP To start SimpleHTTP, just call it's new method: POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '192.168.1.1', 'PORT' => 11111, 'HOSTNAME' => 'MySite.com', 'HEADERS' => {}, 'HANDLERS' => [ ], ); This method will die on error or return success. This constructor accepts only 7 options. =over 4 =item C This will set the alias SimpleHTTP uses in the POE Kernel. This will default to "SimpleHTTP" =item C
This value will be passed to POE::Wheel::SocketFactory to bind to, will use INADDR_ANY if it is nothing is provided (or IN6ADDR_ANY if DOMAIN is AF_INET6). For UNIX domain sockets, it should be a path describing the socket's filename. If neither DOMAIN nor ADDRESS are specified, it will use IN6ADDR_ANY and AF_INET6. =item C This value will be passed to POE::Wheel::SocketFactory to bind to. =item C This value will be passed to POE::Wheel::SocketFactory to define the socket domain used (AF_INET, AF_INET6, AF_UNIX). =item C This value is for the HTTP::Request's URI to point to. If this is not supplied, SimpleHTTP will use Sys::Hostname to find it. =item C This should be a hashref, that will become the default headers on all HTTP::Response objects. You can override this in individual requests by setting it via $request->header( ... ) For more information, consult the L module. =item C This is the hardest part of SimpleHTTP :) You supply an array, with each element being a hash. All the hashes should contain those 3 keys: DIR -> The regexp that will be used, more later. SESSION -> The session to send the input EVENT -> The event to trigger The DIR key should be a valid regexp. This will be matched against the current request path. Pseudocode is: if ( $path =~ /$DIR/ ) NOTE: The path is UNIX style, not MSWIN style ( /blah/foo not \blah\foo ) Now, if you supply 100 handlers, how will SimpleHTTP know what to do? Simple! By passing in an array in the first place, you have already told SimpleHTTP the order of your handlers. They will be tried in order, and if a match is not found, SimpleHTTP will return a 404 response. This allows some cool things like specifying 3 handlers with DIR of: '^/foo/.*', '^/$', '.*' Now, if the request is not in /foo or not root, your 3rd handler will catch it, becoming the "404 not found" handler! NOTE: You might get weird Session/Events, make sure your handlers are in order, for example: '^/', '^/foo/.*' The 2nd handler will NEVER get any requests, as the first one will match ( no $ in the regex ) Now, here's what a handler receives: ARG0 -> HTTP::Request object ARG1 -> POE::Component::Server::SimpleHTTP::Response object ARG2 -> The exact DIR that matched, so you can see what triggered what NOTE: If ARG0 is undef, that means POE::Filter::HTTPD encountered an error parsing the client request, simply modify the HTTP::Response object and send some sort of generic error. SimpleHTTP will set the path used in matching the DIR regexes to an empty string, so if there is a "catch-all" DIR regex like '.*', it will catch the errors, and only that one. NOTE: The only way SimpleHTTP will leak memory ( hopefully heh ) is if you discard the SimpleHTTP::Response object without sending it back to SimpleHTTP via the DONE/CLOSE events, so never do that! =item C Set to true to enable HTTP keep-alive support. Connections will be kept alive until the client closes the connection. All HTTP/1.1 connections are kept-open, unless you set the response C header to C. $response->header( Connection => 'close' ); If you want more control, use L. =item C Expects a hashref with the following key, values: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event for each request to the server from clients. Malformed client requests will not be passed into the handler. Instead undef will be passed. Event is called before ANY content handler is called. The event will have the following parameters: ARG0 -> HTTP::Request object/undef if client request was malformed. ARG1 -> the IP address of the client =item C Expect a hashref with the following key, values: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event for each response that hit DONE call. Malformed client requests will not be passed into the handler. Event is after processing all content handlers. The event will have the following parameters: ARG0 -> HTTP::Request object ARG1 -> HTTP::Response object That makes possible following code: my ($login, $password) = $request->authorization_basic(); printf STDERR "%s - %s [%s] \"%s %s %s\" %d %d\n", $response->connection->remote_ip, $login||'-', POSIX::strftime("%d/%b/%Y:%T %z",localtime(time())), $request->method(), $request->uri()->path(), $request->protocol(), $response->code(), length($response->content()); Emulate apache-like logs for PoCo::Server::SimpleHTTP =item C Expects a hashref with the following key, values: SESSION -> The session to send the input EVENT -> The event to trigger You will receive an event when the listener wheel has been setup. Currently there are no parameters returned. =item C This should be an arrayref of only 2 elements - the private key and public certificate locations. Now, this is still in the experimental stage, and testing is greatly welcome! Again, this will automatically turn every incoming connection into a SSL socket. Once enough testing has been done, this option will be augmented with more SSL stuff! =item C This option is needed in case the SSL certificate references an intermediate certification authority certificate. =item C Set this to a true value to enable the server to act as a proxy server, ie. it won't mangle the HTTP::Request URI. =back =head2 Events SimpleHTTP is so simple, there are only 8 events available. =over 4 =item C This event accepts only one argument: the HTTP::Response object we sent to the handler. Calling this event implies that this particular request is done, and will proceed to close the socket. NOTE: This method automatically sets those 3 headers if they are not already set: Date -> Current date stringified via HTTP::Date->time2str Content-Type -> text/html Content-Length -> length( $response->content ) To get greater throughput and response time, do not post() to the DONE event, call() it! However, this will force your program to block while servicing web requests... =item C This event accepts only one argument: the HTTP::Response object we sent to the handler. Calling this event will close the socket, not sending any output =item C This event accepts 2 arguments: The session + event to send the response to This event will send back the current HANDLERS array ( deep-cloned via Storable::dclone ) The resulting array can be played around to your tastes, then once you are done... =item C This event accepts only one argument: pointer to HANDLERS array BEWARE: if there is an error in the HANDLERS, SimpleHTTP will die! =item C $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $connection, $event, @args ); Calls C<$event> in the current session when C<$connection> is closed. You could use for persistent connection handling. Multiple session may register close handlers. Calling SETCLOSEHANDLER without C<$event> to remove the current session's handler: $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $connection ); You B make sure that C<@args> doesn't cause a circular reference. Ideally, use C<$connection->ID> or some other unique value associated with this C<$connection>. =item C Starts the listening socket, if it was shut down =item C Simply a wrapper for SHUTDOWN GRACEFUL, but will not shutdown SimpleHTTP if there is no more requests =item C Without arguments, SimpleHTTP does this: Close the listening socket Kills all pending requests by closing their sockets Removes it's alias With an argument of 'GRACEFUL', SimpleHTTP does this: Close the listening socket Waits for all pending requests to come in via DONE/CLOSE, then removes it's alias =item C With a $response argument it streams the content and calls back the streaming event of the user's session (or with the dont_flush option you're responsible for calling back your session's streaming event). To use the streaming feature see below. =back =head2 Streaming with SimpleHTTP It's possible to send data as a stream to clients (unbuffered and integrated in the POE loop). Just create your session to receive events from SimpleHTTP as usually and add a streaming event, this event will be triggered over and over each time you set the $response to a streaming state and once you trigger it: # sets the response as streamed within our session which alias is HTTP_GET # with the event GOT_STREAM $response->stream( session => 'HTTP_GET', event => 'GOT_STREAM', dont_flush => 1 ); # then you can simply yield your streaming event, once the GOT_STREAM event # has reached its end it will be triggered again and again, until you # send a CLOSE event to the kernel with the appropriate response as parameter $kernel->yield('GOT_STREAM', $response); The optional dont_flush option gives the user the ability to control the callback to the streaming event, which means once your stream event has reached its end it won't be called, you have to call it back. You can now send data by chunks and either call yourself back (via POE) or shutdown when your streaming is done (EOF for example). sub GOT_STREAM { my ( $kernel, $heap, $response ) = @_[KERNEL, HEAP, ARG0]; # sets the content of the response $response->content("Hello World\n"); # send it to the client POE::Kernel->post('HTTPD', 'STREAM', $response); # if we have previously set the dont_flush option # we have to trigger our event back until the end of # the stream like this (that can be a yield, of course): # # $kernel->delay('GOT_STREAM', 1, $stream ); # otherwise the GOT_STREAM event is triggered continuously until # we call the CLOSE event on the response like that : # if ($heap{'streaming_is_done'}) { # close the socket and end the stream POE::Kernel->post('HTTPD', 'CLOSE', $response ); } } The dont_flush option is there to be able to control the frequency of flushes to the client. =head2 SimpleHTTP Notes You can enable debugging mode by doing this: sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE::Component::Server::SimpleHTTP; Also, this module will try to keep the Listening socket alive. if it dies, it will open it again for a max of 5 retries. You can override this behavior by doing this: sub POE::Component::Server::SimpleHTTP::MAX_RETRIES () { 10 } use POE::Component::Server::SimpleHTTP; For those who are pondering about basic-authentication, here's a tiny snippet to put in the Event handler # Contributed by Rocco Caputo sub Got_Request { # ARG0 = HTTP::Request, ARG1 = HTTP::Response my( $request, $response ) = @_[ ARG0, ARG1 ]; # Get the login my ( $login, $password ) = $request->authorization_basic(); # Decide what to do if ( ! defined $login or ! defined $password ) { # Set the authorization $response->header( 'WWW-Authenticate' => 'Basic realm="MyRealm"' ); $response->code( 401 ); $response->content( 'FORBIDDEN.' ); # Send it off! $_[KERNEL]->post( 'SimpleHTTP', 'DONE', $response ); } else { # Authenticate the user and move on } } =head2 EXPORT Nothing. =for Pod::Coverage MassageHandlers START STOP fix_headers getsockname must_keepalive session_id shutdown =head1 ABSTRACT An easy to use HTTP daemon for POE-enabled programs =head1 SEE ALSO L L L L L L L L =head1 AUTHOR Apocalypse =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut POE-Component-Server-SimpleHTTP-2.30/lib/POE/Component/Server/SimpleHTTP/000755 001751 001751 00000000000 14426154312 026356 5ustar00bingosbingos000000 000000 POE-Component-Server-SimpleHTTP-2.30/lib/POE/Component/Server/SimpleHTTP/State.pm000644 001751 001751 00000004250 14426154312 027775 0ustar00bingosbingos000000 000000 package POE::Component::Server::SimpleHTTP::State; $POE::Component::Server::SimpleHTTP::State::VERSION = '2.30'; use strict; use warnings; use POE::Wheel::ReadWrite; use Moose; has 'wheel' => ( is => 'ro', isa => 'POE::Wheel::ReadWrite', clearer => 'clear_wheel', predicate => 'has_wheel', required => 1, ); has 'response' => ( is => 'ro', isa => 'POE::Component::Server::SimpleHTTP::Response', writer => 'set_response', clearer => 'clear_response', ); has 'request' => ( is => 'ro', isa => 'HTTP::Request', writer => 'set_request', clearer => 'clear_request', ); has 'connection' => ( is => 'ro', isa => 'POE::Component::Server::SimpleHTTP::Connection', writer => 'set_connection', clearer => 'clear_connection', init_arg => undef, ); has 'done' => ( is => 'ro', isa => 'Bool', init_arg => undef, default => sub { 0 }, writer => 'set_done', ); has 'streaming' => ( is => 'ro', isa => 'Bool', init_arg => undef, default => sub { 0 }, writer => 'set_streaming', ); sub reset { my $self = shift; $self->clear_response; $self->clear_request; $self->set_streaming(0); $self->set_done(0); $self->wheel->set_output_filter( $self->wheel->get_input_filter ) if $self->has_wheel; return 1; } sub close_wheel { my $self = shift; return unless $self->has_wheel; $self->wheel->shutdown_input; $self->wheel->shutdown_output; $self->clear_wheel; return 1; } sub wheel_alive { my $self = shift; return unless $self->has_wheel; return unless defined $self->wheel; return unless $self->wheel->get_input_handle(); return 1; } no Moose; __PACKAGE__->meta->make_immutable(); 'This monkey has gone to heaven'; __END__ =pod =encoding UTF-8 =head1 NAME POE::Component::Server::SimpleHTTP::State =head1 VERSION version 2.30 =for Pod::Coverage close_wheel reset wheel_alive =head1 AUTHOR Apocalypse =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut POE-Component-Server-SimpleHTTP-2.30/lib/POE/Component/Server/SimpleHTTP/Response.pm000644 001751 001751 00000005066 14426154312 030521 0ustar00bingosbingos000000 000000 package POE::Component::Server::SimpleHTTP::Response; $POE::Component::Server::SimpleHTTP::Response::VERSION = '2.30'; #ABSTRACT: Emulates a HTTP::Response object, used for SimpleHTTP use strict; use warnings; use base qw( HTTP::Response ); use Moose; extends qw(HTTP::Response Moose::Object ); has '_WHEEL' => ( is => 'rw', ); has 'connection' => ( is => 'ro', writer => 'set_connection', ); has 'STREAM_SESSION' => ( is => 'rw', ); has 'STREAM' => ( is => 'rw', ); has 'STREAM_DONE' => ( is => 'ro', default => sub { 0 }, writer => 'set_stream_done', init_arg => undef, ); has 'IS_STREAMING' => ( is => 'ro', writer => 'set_streaming', ); has 'DONT_FLUSH' => ( is => 'rw', isa => 'Bool', ); sub new { my $class = shift; # Get the Wheel ID my $wid = shift; # Get the Connection object my $conn = shift; # Make sure we got the wheel ID! if ( !defined $wid ) { die 'Did not get a Wheel ID!'; } my $self = $class->SUPER::new(@_); return $class->meta->new_object( __INSTANCE__ => $self, _WHEEL => $wid, connection => $conn, ); } sub stream { my $self = shift; my %opt = (@_); no strict 'refs'; if ( $opt{event} ne '' ) { $self->STREAM_SESSION( $opt{'session'} || undef ); $self->STREAM( $opt{'event'} ); $self->DONT_FLUSH( $opt{'dont_flush'} ); } else { $self->STREAM( shift ); } } no Moose; __PACKAGE__->meta->make_immutable( inline_constructor => 0 ); # End of module 1; __END__ =pod =encoding UTF-8 =head1 NAME POE::Component::Server::SimpleHTTP::Response - Emulates a HTTP::Response object, used for SimpleHTTP =head1 VERSION version 2.30 =head1 SYNOPSIS use POE::Component::Server::SimpleHTTP::Response; my $response = POE::Component::Server::SimpleHTTP::Response->new( $wheel_id, $connection ); print $response->connection->remote_ip; =head1 DESCRIPTION This module is used as a drop-in replacement, because we need to store the wheel ID + connection object for the response. Use $response->connection to get the SimpleHTTP::Connection object =head2 EXPORT Nothing. =for Pod::Coverage stream =head1 SEE ALSO L L =head1 AUTHOR Apocalypse =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut POE-Component-Server-SimpleHTTP-2.30/lib/POE/Component/Server/SimpleHTTP/Connection.pm000644 001751 001751 00000010752 14426154312 031020 0ustar00bingosbingos000000 000000 # Declare our package package POE::Component::Server::SimpleHTTP::Connection; $POE::Component::Server::SimpleHTTP::Connection::VERSION = '2.30'; #ABSTRACT: Stores connection information for SimpleHTTP use strict; use warnings; use Socket (qw( AF_INET AF_INET6 AF_UNIX inet_ntop sockaddr_family unpack_sockaddr_in unpack_sockaddr_in6 unpack_sockaddr_un )); use POE; use Moose; has dead => ( is => 'rw', isa => 'Bool', default => 0, ); has ssl => ( is => 'rw', isa => 'Bool', default => 0, ); has sslcipher => ( is => 'rw', default => undef, ); has remote_ip => ( is => 'ro', ); has remote_port => ( is => 'ro', ); has remote_addr => ( is => 'ro', ); has local_ip => ( is => 'ro', ); has local_port => ( is => 'ro', ); has local_addr => ( is => 'ro', ); has ID => ( is => 'rw', ); has OnClose => ( is => 'ro', default => sub { { } }, ); sub BUILDARGS { my $class = shift; my $self = { }; my $socket = shift; eval { my $family; ( $family, $self->{'remote_port'}, $self->{'remote_addr'}, $self->{'remote_ip'} ) = $class->get_sockaddr_info( getpeername($socket) ); ( $family, $self->{'local_port'}, $self->{'local_addr'}, $self->{'local_ip'} ) = $class->get_sockaddr_info( getsockname($socket) ); }; if ($@) { return undef; } return $self; } sub _on_close { my ( $self, $sessionID, $state, @args ) = @_; if ($state) { $self->OnClose->{$sessionID} = [ $state, @args ]; $poe_kernel->refcount_increment( $sessionID, __PACKAGE__ ); } else { my $data = delete $self->OnClose->{$sessionID}; $poe_kernel->refcount_decrement( $sessionID, __PACKAGE__ ) if $data; } } sub DEMOLISH { my ($self) = @_; while ( my ( $sessionID, $data ) = each %{ $self->OnClose || {} } ) { $poe_kernel->call( $sessionID, @$data ); $poe_kernel->refcount_decrement( $sessionID, __PACKAGE__ ); } } sub get_sockaddr_info { my $class = shift; my $sockaddr = shift; my $family = sockaddr_family( $sockaddr ); my ( $port, $address, $straddress ); if ( $family == AF_INET ) { ( $port, $address ) = unpack_sockaddr_in( $sockaddr ); $straddress = inet_ntop( $family, $address ); } elsif ( $family == AF_INET6 ) { ( $port, $address ) = unpack_sockaddr_in6( $sockaddr ); $straddress = inet_ntop( $family, $address ); } elsif ( $family == AF_UNIX ) { $address = unpack_sockaddr_un( $sockaddr ); $straddress = $address // ''; $port = undef; } else { $address = $port = undef; $straddress = ''; } return ( $family, $address, $port, $straddress ); } no Moose; __PACKAGE__->meta->make_immutable; # End of module 1; __END__ =pod =encoding UTF-8 =head1 NAME POE::Component::Server::SimpleHTTP::Connection - Stores connection information for SimpleHTTP =head1 VERSION version 2.30 =head1 SYNOPSIS use POE::Component::Server::SimpleHTTP::Connection; my $connection = POE::Component::Server::SimpleHTTP::Connection->new( $socket ); # Print some stuff print $connection->remote_port; =head1 DESCRIPTION This module simply holds some information from a SimpleHTTP connection. =head2 METHODS my $connection = POE::Component::Server::SimpleHTTP::Connection->new( $socket ); $connection->remote_ip(); # Returns remote address as a string ( 1.1.1.1 or 2000::1 ) $connection->remote_port(); # Returns remote port $connection->remote_addr(); # Returns true remote address, consult the L POD $connection->local_addr(); # Returns true local address, same as above $connection->local_ip(); # Returns remote address as a string ( 1.1.1.1 or 2000::1 ) $connection->local_port(); # Returns local port $connection->dead(); # Returns a boolean value whether the socket is closed or not $connection->ssl(); # Returns a boolean value whether the socket is SSLified or not $connection->sslcipher(); # Returns the SSL Cipher type or undef if not SSL $connection->ID(); # unique ID of this connection =head2 EXPORT Nothing. =for Pod::Coverage DEMOLISH get_sockaddr_info =head1 SEE ALSO L, L =head1 AUTHOR Apocalypse =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 by Apocalypse, Chris Williams, Eriam Schaffter, Marlon Bailey and Philip Gwyn. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut POE-Component-Server-SimpleHTTP-2.30/examples/proxy.pl000644 001751 001751 00000005714 14426154312 023367 0ustar00bingosbingos000000 000000 use strict; use warnings; sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE qw(Component::Client::HTTP Component::Server::SimpleHTTP); use POE::Component::Server::SimpleHTTP::Response; # Stolen from POE::Wheel. This is static data, shared by all my $current_id = 0; my %active_identifiers; sub _allocate_identifier { while (1) { last unless exists $active_identifiers{ ++$current_id }; } return $active_identifiers{$current_id} = $current_id; } sub _free_identifier { my $id = shift; delete $active_identifiers{$id}; } my $agent = 'proxy' . $$; my $httpd = 'HTTPD' . $$; POE::Component::Client::HTTP->spawn( Alias => $agent, Streaming => 4096, ); POE::Component::Server::SimpleHTTP->new( KEEPALIVE => 1, ALIAS => $httpd, PORT => 11111, PROXYMODE => 1, HANDLERS => [ { DIR => '.*', SESSION => 'controller', EVENT => 'got_request', }, ], ); POE::Session->create( package_states => [ main => [qw(_start got_request _got_stream _response)], ], ); $poe_kernel->run(); exit 0; sub _start { $poe_kernel->alias_set( 'controller' ); return; } sub got_request { my($kernel,$heap,$request,$response,$dirmatch) = @_[KERNEL,HEAP,ARG0..ARG2]; my $httpd = $_[SENDER]->get_heap(); use Data::Dumper; $Data::Dumper::Indent=1; print Dumper( $response ); # Check for errors if ( ! defined $request ) { $kernel->post( $httpd, 'DONE', $response ); return; } $request->header('Connection', 'Keep-Alive'); $request->remove_header('Accept-Encoding'); # Let's see if it is a CONNECT request warn $request->as_string; warn $request->method, "\n"; if ( $request->method eq 'CONNECT' ) { my $uri = $request->uri; # warn $uri->authority, "\n"; warn $uri->as_string, "\n"; } $response->stream( session => 'controller', event => '_got_stream', dont_flush => 1 ); my $id = _allocate_identifier(); $kernel->post( $agent, 'request', '_response', $request, "$id", ); $heap->{_requests}->{ $id } = $response; return; } sub _response { my ($kernel,$heap,$request_packet,$response_packet) = @_[KERNEL,HEAP,ARG0,ARG1]; my $id = $request_packet->[1]; my $resp = $heap->{_requests}->{ $id }; my $response = _rebless( $resp, $response_packet->[0] ); my $chunk = $response_packet->[1]; warn $response->headers_as_string, "\n"; if ( $chunk ) { $response->content( $chunk ); $kernel->post( $httpd, 'STREAM', $response ); } else { $kernel->post( $httpd, 'DONE', $response ); } return; } sub _got_stream { my ($kernel,$heap,$response) = @_[KERNEL,HEAP,ARG0]; return; } sub _rebless { my ($orig,$new) = @_; $new->{$_} = $orig->{$_} for grep { exists $orig->{$_} } qw(_WHEEL connection STREAM_SESSION STREAM DONT_FLUSH IS_STREAMING); bless $new, 'POE::Component::Server::SimpleHTTP::Response'; return $new; } POE-Component-Server-SimpleHTTP-2.30/examples/server.pl000644 001751 001751 00000003356 14426154312 023514 0ustar00bingosbingos000000 000000 use POE; use POE::Component::Server::SimpleHTTP; use Sys::Hostname qw( hostname ); # Start the server! POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => 0, 'PORT' => 8080, 'HANDLERS' => [ { 'DIR' => '^/$', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_ERR', }, ], 'HEADERS' => { 'Server' => 'My Own Server', }, ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ) }, 'GOT_MAIN' => \&GOT_REQ, 'GOT_ERR' => \&GOT_ERR, }, ); # Start POE! POE::Kernel->run(); # We're done! exit; sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content( 'Hi, you fetched ' . $request->uri ); # We are done! $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_ERR { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Check for errors if ( ! defined $request ) { $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); return; } # Do our stuff to HTTP::Response $response->code( 404 ); $response->content( "Hi visitor from " . $response->connection->remote_ip . ", Page not found -> '" . $request->uri->path . "'" ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } POE-Component-Server-SimpleHTTP-2.30/examples/stream.pl000644 001751 001751 00000003065 14426154312 023476 0ustar00bingosbingos000000 000000 use POE; use POE::Component::Server::SimpleHTTP; use Sys::Hostname qw( hostname ); # Start the server! POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => 127.0.0.1, 'PORT' => 8080, 'HANDLERS' => [ { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, ], 'HEADERS' => { 'Server' => 'My Own Server', }, ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ) }, 'GOT_MAIN' => \&GOT_REQ, 'GOT_STREAM' => \&GOT_STREAM, }, ); # Start POE! POE::Kernel->run(); # We're done! exit; sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content_type("text/plain"); # sets the response as streamed within our session with the stream event $response->stream( session => 'HTTP_GET', event => 'GOT_STREAM' ); # We are done! $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_STREAM { my ( $kernel, $heap, $stream ) = @_[KERNEL, HEAP, ARG0]; # the stream hash contains the wheel, the request, the response # and an id associated the the wheel $stream->{'wheel'}->put("Hello World\n"); # lets go on streaming ... POE::Kernel->delay('GOT_STREAM', 1, $stream ); } POE-Component-Server-SimpleHTTP-2.30/examples/prefork.pl000644 001751 001751 00000004132 14426154312 023647 0ustar00bingosbingos000000 000000 use POE; use POE::Component::Server::SimpleHTTP::PreFork; use Sys::Hostname qw( hostname ); # Start the server! POE::Component::Server::SimpleHTTP::PreFork->new( 'ALIAS' => 'HTTPD', 'PORT' => 8080, 'HANDLERS' => [ { 'DIR' => '^/$', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_ERR', }, ], 'HEADERS' => { 'Server' => 'My Own Server', }, # In the testing phase... 'FORKHANDLERS' => { 'HTTP_GET' => 'FORKED' }, 'MINSPARESERVERS' => 5, 'MAXSPARESERVERS' => 10, 'MAXCLIENTS' => 256, 'STARTSERVERS' => 10, ) or die 'Unable to create the HTTP Server'; # Create our own session to receive events from SimpleHTTP POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ) }, 'GOT_MAIN' => \&GOT_REQ, 'GOT_ERR' => \&GOT_ERR, 'FORKED' => \&GOT_FORKED, }, ); # Start POE! POE::Kernel->run(); # We're done! exit; sub GOT_FORKED { warn "Forked\n"; return; } sub GOT_REQ { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content( 'Hi, you fetched ' . $request->uri ); # We are done! $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } sub GOT_ERR { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; # Check for errors if ( ! defined $request ) { $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); return; } # Do our stuff to HTTP::Response $response->code( 404 ); $response->content( "Hi visitor from " . $response->connection->remote_ip . ", Page not found -> '" . $request->uri->path . "'" ); # We are done! # For speed, you could use $_[KERNEL]->call( ... ) $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } POE-Component-Server-SimpleHTTP-2.30/t/05_post.t000644 001751 001751 00000006741 14426154312 021755 0ustar00bingosbingos000000 000000 use strict; use warnings; #use Test::More tests => 8; use Test::More; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; use HTTP::Response; use POE::Filter::HTTP::Parser; my @tests = ( [ '/', { code => '200', content => '^we' } ], ); my $test_count = 0; $test_count += scalar keys %{ $_->[1] } for @tests; plan tests => 2 + $test_count; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], heap => { tests => \@tests, }, options => { trace => 0 }, ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$port) = @_[KERNEL,HEAP,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::HTTP::Parser->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; my $test = shift @{ $heap->{tests} }; my $path = $test->[0]; $heap->{current_tests} = $test->[1]; my $req = HTTP::Request->new( POST => $path ); $req->header( Host => "127.0.0.1:$heap->{port}" ); $req->header( 'Content-Length', 40 ); $req->protocol( 'HTTP/1.1' ); $req->content( 'brother !~we need to get off this island' ); # $heap->{webc}->send_to_server("POST $path HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0AContent-Length: 40\x0D\x0A\x0D\x0Abrother !~we need to get off this island"); $heap->{webc}->send_to_server( $req ); return; } sub webc_input { my ($heap,$resp) = @_[HEAP,ARG0]; # my $status = $heap->{parser}->add($input); # if ( $status == 0 ) { # my $resp = $heap->{parser}->object(); isa_ok( $resp, 'HTTP::Response' ); diag($resp->as_string); my $tests = delete $heap->{current_tests}; foreach my $test ( keys %{ $tests } ) { if ( $test eq 'code' ) { ok( $resp->code eq $tests->{$test}, 'Code: ' . $tests->{$test} ); } if ( $test eq 'content_type' ) { ok( $resp->content_type eq $tests->{$test}, 'Content-Type: ' . $tests->{$test} ); } if ( $test eq 'content' ) { like( $resp->content, qr/$tests->{$test}/, 'Content: ' . $tests->{$test} ); } } # } # else { # } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; if ( scalar @{ $heap->{tests} } ) { $poe_kernel->yield( '_tests', $heap->{port} ); return; } $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } sub TOP { my ($request, $response) = @_[ARG0, ARG1]; diag($request->as_string); $response->code(200); $response->content_type('text/plain'); $response->content(join ' ', reverse split (/~/, $request->content) ); $poe_kernel->post( 'HTTPD', 'DONE', $response ); return; } POE-Component-Server-SimpleHTTP-2.30/t/02_simple.t000644 001751 001751 00000005663 14426154312 022260 0ustar00bingosbingos000000 000000 use strict; use warnings; use Test::More tests => 2; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$sender,$port) = @_[KERNEL,HEAP,SENDER,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::Stream->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; $heap->{webc}->send_to_server("GET / HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0A\x0D\x0A"); return; } sub TOP { my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; diag($request->as_string); $response->code( 200 ); $response->content('Moo'); $poe_kernel->post( $_[SENDER], 'DONE', $response ); return; } sub webc_input { my ($heap,$input) = @_[HEAP,ARG0]; diag($input); # HTTP/1.1 200 (OK) # Date: Tue, 20 Jan 2009 11:56:35 GMT # Content-Length: 3 # Content-Type: text/plain if ( $input =~ /^HTTP/ ) { like ($input, qr/HTTP\/1.1 200 \(OK\)/, 'HTTP/1.1 200 (OK)' ); return; } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } POE-Component-Server-SimpleHTTP-2.30/t/06_stream.t000644 001751 001751 00000012042 14426154312 022253 0ustar00bingosbingos000000 000000 use strict; use Test::More; #plan skip_all => 'MSWin32 does not have a proper fork()' if $^O eq 'MSWin32'; BEGIN { eval { require POE::Component::Client::HTTP; }; plan skip_all => 'POE::Component::Client::HTTP is required for this test' if $@; } plan tests => 6; use HTTP::Request; use POE; use POE::Kernel; #sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE::Component::Server::SimpleHTTP; my $PORT = 2080; my $IP = "localhost"; our %STREAMS; #################################################################### POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => "$IP", 'PORT' => $PORT, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '.*', 'SESSION' => 'HTTP_GET', 'EVENT' => 'GOT_MAIN', }, ], SETUPHANDLER => { SESSION => 'HTTP_GET', EVENT => '_tests', }, ); # Create our own session to receive events from SimpleHTTP POE::Component::Client::HTTP->spawn( Agent => 'TestAgent', Alias => 'ua', Protocol => 'HTTP/1.1', From => 'test@tester', Streaming => 100, Proxy => q{}, ); POE::Session->create( inline_states => { '_start' => sub { $_[KERNEL]->alias_set( 'HTTP_GET' ); $_[KERNEL]->yield('keepalive'); return; }, '_tests' => \&_tests, 'GOT_MAIN' => \&GOT_MAIN, 'GOT_STREAM' => \&GOT_STREAM, keepalive => \&keepalive, response => \&response, '_shutdown' => \&_shutdown, 'on_close' => \&on_close, }, ); $poe_kernel->run(); is( 0+keys %STREAMS, 0, "No open streams" ); exit 0; sub GOT_MAIN { # ARG0 = HTTP::Request object, ARG1 = HTTP::Response object, ARG2 = the DIR that matched my( $kernel, $heap, $request, $response, $dirmatch ) = @_[KERNEL, HEAP, ARG0 .. ARG2 ]; # Do our stuff to HTTP::Response $response->code( 200 ); $response->content_type("text/plain"); print "# GOT_MAIN \n"; # sets the response as streamed within our session with the stream event $response->stream( session => 'HTTP_GET', event => 'GOT_STREAM' ); $heap->{'count'} ||= 0; my $c = $response->connection; $STREAMS{ $c->ID }=1; $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $c, 'on_close', $c->ID ); # We are done! $kernel->yield('GOT_STREAM', $response); return; } sub GOT_STREAM { my ( $kernel, $heap, $response ) = @_[KERNEL, HEAP, ARG0]; # lets go on streaming ... if ($heap->{'count'} <= 2) { my $text = "Hello World ".$heap->{'count'}." \n"; #print "send ".$text."\n"; $response->content($text); $heap->{'count'}++; POE::Kernel->post('HTTPD', 'STREAM', $response); } else { $STREAMS{ $response->connection->ID }--; POE::Kernel->post('HTTPD', 'CLOSE', $response ); } return; } sub keepalive { my $heap = $_[HEAP]; $_[KERNEL]->delay_set('keepalive', 1); return; } sub _shutdown { $poe_kernel->alarm_remove_all(); $poe_kernel->alias_remove( 'HTTP_GET' ); $poe_kernel->post( 'ua', 'shutdown' ); $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } sub _tests { my ( $kernel, $heap, $session ) = @_[KERNEL, HEAP, SESSION ]; $heap->{'client_count'} = 0; my $request = HTTP::Request->new(GET => "http://$IP:$PORT/"); diag('Test a stream of 3 helloworlds ..'); POE::Kernel->post('ua', 'request', 'response', $request); return; } sub response { my ( $kernel, $heap, $session, $request_packet, $response_packet ) = @_[KERNEL, HEAP, SESSION, ARG0, ARG1]; my $return; # HTTP::Request my $request = $request_packet->[0]; my $response = $response_packet->[0]; # the PoCoClientHTTP sends the first chunk in the content # of the http response #if ($heap->{'count'} == 1) { # my $data = $response->content; # chomp($data); #print $data."\n"; # ok($data =~ /Hello World 0/, "First one as response content received"); #} # then all streamed data in the second element of the response # array ... my ($resp, $data) = @$response_packet; return unless $data; chomp($data); foreach my $hello ( split /\n/, $data ) { ok($hello =~ /Hello World/, "Received a hello"); $heap->{'client_count'}++; } if ($heap->{'client_count'} == 3) { is($heap->{'client_count'}, 3, "Got 3 streamed helloworlds ... all good :)"); $kernel->yield( '_shutdown' ); return; } return; } sub on_close { my $wid = $_[ARG0]; is( $STREAMS{$wid}, 0, "on_close comes after CLOSE" ); delete $STREAMS{ $wid } if $STREAMS{ $wid } == 0; } POE-Component-Server-SimpleHTTP-2.30/t/00-compile.t000644 001751 001751 00000003110 14426154312 022314 0ustar00bingosbingos000000 000000 use 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More; plan tests => 4 + ($ENV{AUTHOR_TESTING} ? 1 : 0); my @module_files = ( 'POE/Component/Server/SimpleHTTP.pm', 'POE/Component/Server/SimpleHTTP/Connection.pm', 'POE/Component/Server/SimpleHTTP/Response.pm', 'POE/Component/Server/SimpleHTTP/State.pm' ); # no fake home requested my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; POE-Component-Server-SimpleHTTP-2.30/t/04_run_close.t000644 001751 001751 00000012077 14426154312 022757 0ustar00bingosbingos000000 000000 use strict; use warnings; #use Test::More tests => 8; use Test::More; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; use HTTP::Response; use POE::Filter::HTTP::Parser; my @tests = ( [ '/', { code => '200', content => 'this is top' } ], [ '/honk/', { code => '200', content => 'this is honk' } ], [ '/bonk/zip.html', { code => '200', content_type => 'text/html', content => 'my friend' } ], [ '/wedonthaveone', { code => '404', } ], ); my $test_count = 0; $test_count += scalar keys %{ $_->[1] } for @tests; plan tests => 8 + $test_count; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP HONK BONK BONK2)], ], heap => { tests => \@tests, }, ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$port) = @_[KERNEL,HEAP,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::HTTP::Parser->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; my $test = shift @{ $heap->{tests} }; my $path = $test->[0]; $heap->{current_tests} = $test->[1]; my $req = HTTP::Request->new( GET => $path ); $req->header( Host => "127.0.0.1:$heap->{port}" ); $req->protocol( 'HTTP/1.1' ); $heap->{webc}->send_to_server( $req ); return; } sub webc_input { my ($heap,$resp) = @_[HEAP,ARG0]; isa_ok( $resp, 'HTTP::Response' ); diag($resp->as_string); my $tests = delete $heap->{current_tests}; foreach my $test ( keys %{ $tests } ) { if ( $test eq 'code' ) { ok( $resp->code eq $tests->{$test}, 'Code: ' . $tests->{$test} ); } if ( $test eq 'content_type' ) { ok( $resp->content_type eq $tests->{$test}, 'Content-Type: ' . $tests->{$test} ); } if ( $test eq 'content' ) { like( $resp->content, qr/$tests->{$test}/, 'Content: ' . $tests->{$test} ); } } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; if ( scalar @{ $heap->{tests} } ) { $poe_kernel->yield( '_tests', $heap->{port} ); return; } $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } ####################################### sub TOP { my ($request, $response) = @_[ARG0, ARG1]; $response->code(200); $response->content_type('text/plain'); $response->content("this is top"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub HONK { my ($request, $response) = @_[ARG0, ARG1]; my $c = $response->connection; $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $c->ID, 'on_close', [ $c->ID, "something" ], "more" ); $response->code(200); $response->content_type('text/plain'); $response->content("this is honk"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub BONK { my ($request, $response) = @_[ARG0, ARG1]; fail( "bonk should never be called" ); $response->code(200); $response->content_type('text/plain'); $response->content("this is bonk"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub BONK2 { my ($request, $response) = @_[ARG0, ARG1]; $response->code(200); $response->content_type('text/html'); $response->content(<<' HTML'); YEAH!

This, my friend, is the page you've been looking for.

HTML $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } POE-Component-Server-SimpleHTTP-2.30/t/03_bad_handler.t000644 001751 001751 00000004330 14426154312 023201 0ustar00bingosbingos000000 000000 use strict; use warnings; use Test::More tests => 3; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; use HTTP::Response; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$sender,$port) = @_[KERNEL,HEAP,SENDER,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::Stream->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; $heap->{webc}->send_to_server("GET /rubbish HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0A\x0D\x0A"); return; } sub TOP { my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; diag($request->as_string); $response->code( 200 ); $response->content("Moo\nMoo\nMoo\nMoo\n"); $poe_kernel->post( $_[SENDER], 'DONE', $response ); return; } sub webc_input { my ($heap,$input) = @_[HEAP,ARG0]; $heap->{string} .= $input; return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); my $response = HTTP::Response->parse( $heap->{string} ); isa_ok( $response, 'HTTP::Response' ) and diag($response->as_string); ok( $response->code eq '404', 'Got a 404 response from bad handler' ); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } POE-Component-Server-SimpleHTTP-2.30/t/03_bad_request.t000644 001751 001751 00000005663 14426154312 023266 0ustar00bingosbingos000000 000000 use strict; use warnings; use Test::More tests => 2; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _tests { my ($kernel,$heap,$sender,$port) = @_[KERNEL,HEAP,SENDER,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::Stream->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; $heap->{webc}->send_to_server("GEt / HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0A\x0D\x0A"); return; } sub TOP { my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; diag($request->as_string); $response->code( 200 ); $response->content('Moo'); $poe_kernel->post( $_[SENDER], 'DONE', $response ); return; } sub webc_input { my ($heap,$input) = @_[HEAP,ARG0]; diag($input); # HTTP/1.1 200 (OK) # Date: Tue, 20 Jan 2009 11:56:35 GMT # Content-Length: 3 # Content-Type: text/plain if ( $input =~ /^HTTP/ ) { like ($input, qr/HTTP\/1.1 200 \(OK\)/, 'HTTP/1.1 200 (OK)' ); return; } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } POE-Component-Server-SimpleHTTP-2.30/t/02_simple_ipv6.t000644 001751 001751 00000006006 14426154312 023214 0ustar00bingosbingos000000 000000 use strict; use warnings; use Test::More tests => 2; use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; POE::Session->create( package_states => [ main => [qw(_start _tests webc_connected webc_input webc_disconnected TOP)], ], ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); diag "starting httpd6"; POE::Component::Server::SimpleHTTP->new( 'ALIAS' => 'HTTPD6', 'ADDRESS' => '::1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); diag "httpd6 started"; return; } sub _tests { my ($kernel,$heap,$sender,$port) = @_[KERNEL,HEAP,SENDER,ARG0]; diag "Port is $port"; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '::1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::Stream->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; diag "webc_connected"; $heap->{webc}->send_to_server("GET / HTTP/1.1\x0D\x0AHost: ::1:$heap->{port}\x0D\x0A\x0D\x0A"); return; } sub TOP { my( $request, $response, $dirmatch ) = @_[ ARG0 .. ARG2 ]; diag($request->as_string); $response->code( 200 ); $response->content('Moo'); $poe_kernel->post( $_[SENDER], 'DONE', $response ); return; } sub webc_input { my ($heap,$input) = @_[HEAP,ARG0]; diag($input); # HTTP/1.1 200 (OK) # Date: Tue, 20 Jan 2009 11:56:35 GMT # Content-Length: 3 # Content-Type: text/plain if ( $input =~ /^HTTP/ ) { like ($input, qr/HTTP\/1.1 200 \(OK\)/, 'HTTP/1.1 200 (OK)' ); return; } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD6', 'SHUTDOWN' ); return; } POE-Component-Server-SimpleHTTP-2.30/t/04_run_keepalive.t000644 001751 001751 00000013366 14426154312 023621 0ustar00bingosbingos000000 000000 use strict; use warnings; #use Test::More tests => 8; use Test::More; #sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 } use POE qw(Component::Server::SimpleHTTP Filter::Stream); use Test::POE::Client::TCP; use HTTP::Request; use HTTP::Response; use POE::Filter::HTTP::Parser; my @tests = ( [ '/', { code => '200', content => 'this is top' } ], [ '/honk/', { code => '200', content => 'this is honk' } ], [ '/bonk/zip.html', { code => '200', content_type => 'text/html', content => 'my friend' } ], [ '/wedonthaveone', { code => '404', } ], ); my $test_count = 0; $test_count += scalar keys %{ $_->[1] } for @tests; plan tests => 6 + $test_count; POE::Session->create( package_states => [ main => [qw(_start _tests _run_tests webc_connected webc_input webc_disconnected TOP HONK BONK BONK2 _stop)], ], heap => { tests => \@tests, }, ); $poe_kernel->run(); exit 0; sub _start { my $session_id = $_[SESSION]->ID(); POE::Component::Server::SimpleHTTP->new( KEEPALIVE=>1, 'ALIAS' => 'HTTPD', 'ADDRESS' => '127.0.0.1', 'PORT' => 0, 'HOSTNAME' => 'pocosimpletest.com', 'HANDLERS' => [ { 'DIR' => '^/honk/', 'SESSION' => $session_id, 'EVENT' => 'HONK', }, { 'DIR' => '^/bonk/zip.html', 'SESSION' => $session_id, 'EVENT' => 'BONK2', }, { 'DIR' => '^/bonk/', 'SESSION' => $session_id, 'EVENT' => 'BONK', }, { 'DIR' => '^/$', 'SESSION' => $session_id, 'EVENT' => 'TOP', }, ], SETUPHANDLER => { SESSION => $session_id, EVENT => '_tests', }, ); return; } sub _stop { pass('Let my people go go'); return; } sub _tests { my ($kernel,$heap,$port) = @_[KERNEL,HEAP,ARG0]; $heap->{webc} = Test::POE::Client::TCP->spawn( address => '127.0.0.1', port => $port, autoconnect => 1, prefix => 'webc', filter => POE::Filter::HTTP::Parser->new(), ); $heap->{port} = $port; return; } sub webc_connected { my ($kernel,$heap) = @_[KERNEL,HEAP]; $kernel->yield( '_run_tests' ); return; } sub _run_tests { my ($kernel,$heap) = @_[KERNEL,HEAP]; $heap->{parser} = HTTP::Parser->new( response => 1 ); my $test = shift @{ $heap->{tests} }; return unless $test; my $path = $test->[0]; $heap->{current_tests} = $test->[1]; my $req = HTTP::Request->new( GET => $path ); $req->protocol( 'HTTP/1.1' ); $req->header( 'Host', "127.0.0.1:$heap->{port}" ); $req->header( 'Keep-Alive', 300 ); $req->header( 'Connection', 'keep-alive' ); # my $keepalive = ''; # $keepalive = "Keep-Alive: 300\x0D\x0AConnection: keep-alive\x0D\x0A"; # $heap->{webc}->send_to_server("GET $path HTTP/1.1\x0D\x0AHost: 127.0.0.1:$heap->{port}\x0D\x0A$keepalive\x0D\x0A"); $heap->{webc}->send_to_server( $req ); return; } sub webc_input { my ($heap,$resp) = @_[HEAP,ARG0]; # my $status = $heap->{parser}->add($input); # if ( $status == 0 ) { # my $resp = $heap->{parser}->object(); isa_ok( $resp, 'HTTP::Response' ); diag($resp->as_string); my $tests = delete $heap->{current_tests}; foreach my $test ( keys %{ $tests } ) { if ( $test eq 'code' ) { ok( $resp->code eq $tests->{$test}, 'Code: ' . $tests->{$test} ); } if ( $test eq 'content_type' ) { ok( $resp->content_type eq $tests->{$test}, 'Content-Type: ' . $tests->{$test} ); } if ( $test eq 'content' ) { like( $resp->content, qr/$tests->{$test}/, 'Content: ' . $tests->{$test} ); } } $poe_kernel->yield( '_run_tests' ); # } # else { # } return; } sub webc_disconnected { my ($heap,$state) = @_[HEAP,STATE]; pass($state); $heap->{webc}->shutdown(); delete $heap->{webc}; $poe_kernel->post( 'HTTPD', 'SHUTDOWN' ); return; } ####################################### sub TOP { my ($request, $response) = @_[ARG0, ARG1]; $response->code(200); $response->content_type('text/plain'); $response->content("this is top"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub HONK { my ($request, $response) = @_[ARG0, ARG1]; my $c = $response->connection; $_[KERNEL]->call( $_[SENDER], 'SETCLOSEHANDLER', $c->ID, 'on_close', [ $c->ID, "something" ], "more" ); $response->code(200); $response->content_type('text/plain'); $response->content("this is honk"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub BONK { my ($request, $response) = @_[ARG0, ARG1]; fail( "bonk should never be called" ); $response->code(200); $response->content_type('text/plain'); $response->content("this is bonk"); $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } ####################################### sub BONK2 { my ($request, $response) = @_[ARG0, ARG1]; $response->code(200); $response->content_type('text/html'); $response->content(<<' HTML'); YEAH!

This, my friend, is the page you've been looking for.

HTML $_[KERNEL]->post( 'HTTPD', 'DONE', $response ); } POE-Component-Server-SimpleHTTP-2.30/t/author-pod-syntax.t000644 001751 001751 00000000454 14426154312 024065 0ustar00bingosbingos000000 000000 #!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); POE-Component-Server-SimpleHTTP-2.30/t/author-pod-coverage.t000644 001751 001751 00000000567 14426154312 024337 0ustar00bingosbingos000000 000000 #!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use strict; use warnings; use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' });