POE-Component-Client-Keepalive-0.272000755000765000024 012357030152 16457 5ustar00trocstaff000000000000README100644000765000024 2224012357030152 17440 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272NAME POE::Component::Client::Keepalive - manage connections, with keep-alive VERSION version 0.272 SYNOPSIS use warnings; use strict; use POE; use POE::Component::Client::Keepalive; POE::Session->create( inline_states => { _start => \&start, got_conn => \&got_conn, got_error => \&handle_error, got_input => \&handle_input, } ); POE::Kernel->run(); exit; sub start { $_[HEAP]{ka} = POE::Component::Client::Keepalive->new(); $_[HEAP]{ka}->allocate( scheme => "http", addr => "127.0.0.1", port => 9999, event => "got_conn", context => "arbitrary data (even a reference) here", timeout => 60, ); print "Connection is in progress.\n"; } sub got_conn { my ($kernel, $heap, $response) = @_[KERNEL, HEAP, ARG0]; my $conn = $response->{connection}; my $context = $response->{context}; if (defined $conn) { if ($response->{from_cache}) { print "Connection was established immediately.\n"; } else { print "Connection was established asynchronously.\n"; } $conn->start( InputEvent => "got_input", ErrorEvent => "got_error", ); return; } print( "Connection could not be established: ", "$response->{function} error $response->{error_num}: ", "$response->{error_str}\n" ); } sub handle_input { my $input = $_[ARG0]; print "$input\n"; } sub handle_error { my $heap = $_[HEAP]; delete $heap->{connection}; $heap->{ka}->shutdown(); } DESCRIPTION POE::Component::Client::Keepalive creates and manages connections for other components. It maintains a cache of kept-alive connections for quick reuse. It is written specifically for clients that can benefit from kept-alive connections, such as HTTP clients. Using it for one-shot connections would probably be silly. new Creates a new keepalive connection manager. A program may contain several connection managers. Each will operate independently of the others. None will know about the limits set in the others, so it's possible to overrun your file descriptors for a process if you're not careful. new() takes up to five parameters. All of them are optional. To limit the number of simultaneous connections to a particular host (defined by a combination of scheme, address and port): max_per_host => $max_simultaneous_host_connections, # defaults to 4 To limit the overall number of connections that may be open at once, use max_open => $maximum_open_connections, # defaults to 128 Programs are required to give connections back to the manager when they are done. See the free() method for how that works. The connection manager will keep connections alive for a period of time before recycling them. The maximum keep-alive time may be set with keep_alive => $seconds_to_keep_free_conns_alive, # defaults to 15 Programs may not want to wait a long time for a connection to be established. They can set the request timeout to alter how long the component holds a request before generating an error. timeout => $seconds_to_process_a_request, # defaults to 120 Specify a bind_address to bind all client sockets to a particular local address. The value of bind_address will be passed directly to POE::Wheel::SocketFactory. See that module's documentation for implementation details. allocate Allocate a new connection. Allocate() will return a request ID immediately. The allocated connection, however, will be posted back to the requesting session. This happens even if the connection was found in the component's keep-alive cache. It's a bit slower, but the use cases are cleaner that way. Allocate() requires five parameters and has an optional sixth. Specify the scheme that will be used to communicate on the connection (typically http or https). The scheme is required, but you're free to make something up here. It's used internally to differentiate different types of socket (e.g., ssl vs. cleartext) on the same address and port. scheme => $connection_scheme, Request a connection to a particular address and port. The address and port must be numeric. Both the address and port are required. address => $remote_address, port => $remote_port, Specify an name of the event to post when an asynchronous response is ready. This is of course required. event => $return_event, Set the connection timeout, in seconds. The connection manager will post back an error message if it can't establish a connection within the requested time. This parameter is optional. It will default to the master timeout provided to the connection manager's constructor. timeout => $connect_timeout, Specify additional contextual data. The context defines the connection's purpose. It is used to maintain continuity between a call to allocate() and an asynchronous response. A context is extremely handy, but it's optional. context => $context_data, In summary: $mgr->allocate( scheme => "http", address => "127.0.0.1", port => 80, event => "got_a_connection", context => \%connection_context, ); The response event ("got_a_connection" in this example) contains several fields, passed as a list of key/value pairs. The list may be assigned to a hash for convenience: sub got_a_connection { my %response = @_[ARG0..$#_]; ...; } Four of the fields exist to echo back your data: $response{address} = $your_request_address; $response{context} = $your_request_context; $response{port} = $your_request_port; $response{scheme} = $your_request_scheme; One field returns the connection object if the connection was successful, or undef if there was a failure: $response{connection} = $new_socket_handle; On success, another field tells you whether the connection contains all new materials. That is, whether the connection has been recycled from the component's cache or created anew. $response{from_cache} = $status; The from_cache status may be "immediate" if the connection was immediately available from the cache. It will be "deferred" if the connection was reused, but another user had to release it first. Finally, from_cache will be false if the connection had to be created to satisfy allocate(). Three other fields return error information if the connection failed. They are not present if the connection was successful. $response{function} = $name_of_failing_function; $response{error_num} = $! as a number; $response{error_str} = $! as a string; free Free() notifies the connection manager when connections are free to be reused. Freed connections are entered into the keep-alive pool and may be returned by subsequent allocate() calls. $mgr->free($socket); For now free() is called with a socket, not a connection object. This is usually not a problem since POE::Component::Connection::Keepalive objects call free() for you when they are destroyed. Not calling free() will cause a program to leak connections. This is also not generally a problem, since free() is called automatically whenever connection objects are destroyed. deallocate Cancel a connection that has not yet been established. Requires one parameter, the request ID returned by allocate(). shutdown The keep-alive pool requires connections to be active internally. This may keep a program active even when all connections are idle. The shutdown() method forces the connection manager to clear its keep-alive pool, allowing a program to terminate gracefully. $mgr->shutdown(); SEE ALSO POE POE::Component::Connection::Keepalive LICENSE This distribution is copyright 2004-2009 by Rocco Caputo. All rights are reserved. This distribution is free software; you may redistribute it and/or modify it under the same terms as Perl itself. AUTHOR Rocco Caputo CONTRIBUTORS Rob Bloodgood helped out a lot. Thank you. Joel Bernstein solved some nasty race conditions. Portugal Telecom was kind enough to support his contributions. BUG TRACKER https://rt.cpan.org/Dist/Display.html?Queue=POE-Component-Client-Keepali ve REPOSITORY http://gitorious.org/poe-component-client-keepalive http://github.com/rcaputo/poe-component-client-keepalive OTHER RESOURCES http://search.cpan.org/dist/POE-Component-Client-Keepalive/ CHANGES100644000765000024 732212357030152 17537 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272================================================== Changes from 2013-07-08 00:00:00 +0000 to present. ================================================== ------------------------------------------ version 0.272 at 2014-07-08 17:54:44 +0000 ------------------------------------------ Change: 96d92a6c75eefdc3fd701c7af9a3255e1f446de5 Author: Rocco Caputo Date : 2014-07-08 13:45:54 +0000 rt.cpan.org 92985. Ideally resolve "Not an ARRAY reference" at shutdown. I haven't encountered the problem myself, but I see where it could happen, thanks to the bug report. This change should fix it, but I haven't got a test case, so no absolute guarantees are made. Change: 3e489b54e73a1ba6e7949f4c96b24bb23bda901f Author: Rocco Caputo Date : 2014-07-08 13:42:24 +0000 Speed up the test by shutting down the component when done. Change: a18da3eebd52c4341cca6baa8121607526b02ca1 Author: Rocco Caputo Date : 2013-09-28 09:56:09 +0000 Merge pull request #3 from dsteinbrunner/patch-1 Bugtracker metadata fix. Change: d5c4b1e9d2f16a2f06e11b674e6d5273f5d9c964 Author: David Steinbrunner Date : 2013-09-25 05:24:04 +0000 bugtracker metadata fix Change: 4f3529282049828691feed6fa726d90ba1e78176 Author: Rocco Caputo Date : 2013-09-07 18:06:06 +0000 Minor syntax cleanups. Nothing functionally significant. Change: c3e8492b933336765287302fb5a7fc54ddce0347 Author: Rocco Caputo Date : 2013-09-07 17:49:05 +0000 Improve thread safety. Move away from using stringified references. The references can change when threads come into play, but the saved string versions won't. This includes using fork() on Windows. Change: c8e993b3b8345644bfa49e8fac114760d0224303 Author: Rocco Caputo Date : 2013-09-07 17:44:49 +0000 Consolidate C statements. Change: 838ec7f439841a60ccd744b2c60e7df94089ec96 Author: Rocco Caputo Date : 2013-07-15 22:20:47 +0000 Log why connection tests fail. Most cpantesters.org failure reports are of the form "connection failed" without explaining why. Explain why. Change: e3bb8e929fed59ef7dd166a9a92c47c047f07205 Author: Rocco Caputo Date : 2013-07-15 03:10:15 +0000 Resolve most bind() conflicts by using port 0. I was using random ports, which are mostly okay, but over the course of hundreds of cpantesters.org reports, enough showed up to make it a concern Change: 20d1dce836f7ecba7ae4cbb0449fa4540e1c6e92 Author: Rocco Caputo Date : 2013-07-15 02:37:31 +0000 Remove a TestServer shutdown race condition. Counted after 14 cpantesters.org failures of the form "Failed test 'first request honored asynchronously'". Added detailed error information to the failure. If it happens again, I'll be better prepared to fix it. Stopped relying on the order of first/second connection callbacks. Previously, if the second fired first, we'd shut down the TestServer too early. The first connection would then fail because. Meanwhile, always shutdown the connection manager (not just after the second response). Each session has its own, and they both need to go. Otherwise the program waits the obligatory connection pool timeout. Change: 776e56c9af244b0ea35f12f9e4298654548d32cf Author: Rocco Caputo Date : 2012-06-03 03:08:19 +0000 Add more values to some debugging statements. ================================================= Plus 33 releases after 2013-07-08 00:00:00 +0000. ================================================= LICENSE100644000765000024 4365512357030152 17602 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272This software is copyright (c) 2014 by Rocco Caputo. 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) 2014 by Rocco Caputo. 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) 2014 by Rocco Caputo. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644000765000024 157712357030152 20216 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272name = POE-Component-Client-Keepalive author = Rocco Caputo license = Perl_5 copyright_holder = Rocco Caputo [Prereqs] Net::IP::Minimal = 0.02 POE = 1.311 POE::Component::Resolver = 0.917 [MetaResources] bugtracker = http://rt.cpan.org/Public/Dist/Display.html?Name=POE-Component-Client-Keepalive repository = https://github.com/rcaputo/poe-component-client-keepalive [Repository] git_remote = gh [ReadmeFromPod] [ReadmeMarkdownFromPod] [ReportVersions] ; Require everything to be checked in. [Git::Check] ; Calculate the release version. [Git::NextVersion] first_version = 0.269 version_regexp = ^v(\d+\.\d+)$ ; Generate the changelog. [ChangelogFromGit] tag_regexp = v(\d+[_.]\d+) ; Tag the repository after release. [Git::Tag] tag_format = v%v tag_message = Release %v. [@Classic] META.yml100644000765000024 126512357030152 20015 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272--- abstract: 'manage connections, with keep-alive' author: - 'Rocco Caputo ' build_requires: {} configure_requires: ExtUtils::MakeMaker: '6.30' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.019, CPAN::Meta::Converter version 2.141520' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: POE-Component-Client-Keepalive requires: Net::IP::Minimal: '0.02' POE: '1.311' POE::Component::Resolver: '0.917' resources: bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=POE-Component-Client-Keepalive repository: git://github.com/rcaputo/poe-component-client-keepalive.git version: '0.272' MANIFEST100644000765000024 115012357030152 17666 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.019. CHANGES LICENSE MANIFEST MANIFEST.SKIP META.yml Makefile.PL README README.mkdn dist.ini lib/POE/Component/Client/Keepalive.pm lib/POE/Component/Connection/Keepalive.pm mylib/TestServer.pm mylib/cvr.perl t/000-report-versions.t t/01_socket_reuse.t t/02_socket_queue.t t/03_each_queue.t t/04_free_each.t t/05_errors.t t/06_activity.t t/07_keep_alive.t t/08_quick_reuse.t t/09_timeout.t t/10_resolver.t t/11_dead_socket.t t/12_extref.t t/13_close.t t/50_bisbee_timeout.t t/51_reiss_reuse.t t/release-pod-coverage.t t/release-pod-syntax.t README.mkdn100644000765000024 2200212357030152 20364 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272# NAME POE::Component::Client::Keepalive - manage connections, with keep-alive # VERSION version 0.272 # SYNOPSIS use warnings; use strict; use POE; use POE::Component::Client::Keepalive; POE::Session->create( inline_states => { _start => \&start, got_conn => \&got_conn, got_error => \&handle_error, got_input => \&handle_input, } ); POE::Kernel->run(); exit; sub start { $_[HEAP]{ka} = POE::Component::Client::Keepalive->new(); $_[HEAP]{ka}->allocate( scheme => "http", addr => "127.0.0.1", port => 9999, event => "got_conn", context => "arbitrary data (even a reference) here", timeout => 60, ); print "Connection is in progress.\n"; } sub got_conn { my ($kernel, $heap, $response) = @_[KERNEL, HEAP, ARG0]; my $conn = $response->{connection}; my $context = $response->{context}; if (defined $conn) { if ($response->{from_cache}) { print "Connection was established immediately.\n"; } else { print "Connection was established asynchronously.\n"; } $conn->start( InputEvent => "got_input", ErrorEvent => "got_error", ); return; } print( "Connection could not be established: ", "$response->{function} error $response->{error_num}: ", "$response->{error_str}\n" ); } sub handle_input { my $input = $_[ARG0]; print "$input\n"; } sub handle_error { my $heap = $_[HEAP]; delete $heap->{connection}; $heap->{ka}->shutdown(); } # DESCRIPTION POE::Component::Client::Keepalive creates and manages connections for other components. It maintains a cache of kept-alive connections for quick reuse. It is written specifically for clients that can benefit from kept-alive connections, such as HTTP clients. Using it for one-shot connections would probably be silly. - new Creates a new keepalive connection manager. A program may contain several connection managers. Each will operate independently of the others. None will know about the limits set in the others, so it's possible to overrun your file descriptors for a process if you're not careful. new() takes up to five parameters. All of them are optional. To limit the number of simultaneous connections to a particular host (defined by a combination of scheme, address and port): max_per_host => $max_simultaneous_host_connections, # defaults to 4 To limit the overall number of connections that may be open at once, use max_open => $maximum_open_connections, # defaults to 128 Programs are required to give connections back to the manager when they are done. See the free() method for how that works. The connection manager will keep connections alive for a period of time before recycling them. The maximum keep-alive time may be set with keep_alive => $seconds_to_keep_free_conns_alive, # defaults to 15 Programs may not want to wait a long time for a connection to be established. They can set the request timeout to alter how long the component holds a request before generating an error. timeout => $seconds_to_process_a_request, # defaults to 120 Specify a bind\_address to bind all client sockets to a particular local address. The value of bind\_address will be passed directly to POE::Wheel::SocketFactory. See that module's documentation for implementation details. - allocate Allocate a new connection. Allocate() will return a request ID immediately. The allocated connection, however, will be posted back to the requesting session. This happens even if the connection was found in the component's keep-alive cache. It's a bit slower, but the use cases are cleaner that way. Allocate() requires five parameters and has an optional sixth. Specify the scheme that will be used to communicate on the connection (typically http or https). The scheme is required, but you're free to make something up here. It's used internally to differentiate different types of socket (e.g., ssl vs. cleartext) on the same address and port. scheme => $connection_scheme, Request a connection to a particular address and port. The address and port must be numeric. Both the address and port are required. address => $remote_address, port => $remote_port, Specify an name of the event to post when an asynchronous response is ready. This is of course required. event => $return_event, Set the connection timeout, in seconds. The connection manager will post back an error message if it can't establish a connection within the requested time. This parameter is optional. It will default to the master timeout provided to the connection manager's constructor. timeout => $connect_timeout, Specify additional contextual data. The context defines the connection's purpose. It is used to maintain continuity between a call to allocate() and an asynchronous response. A context is extremely handy, but it's optional. context => $context_data, In summary: $mgr->allocate( scheme => "http", address => "127.0.0.1", port => 80, event => "got_a_connection", context => \%connection_context, ); The response event ("got\_a\_connection" in this example) contains several fields, passed as a list of key/value pairs. The list may be assigned to a hash for convenience: sub got_a_connection { my %response = @_[ARG0..$#_]; ...; } Four of the fields exist to echo back your data: $response{address} = $your_request_address; $response{context} = $your_request_context; $response{port} = $your_request_port; $response{scheme} = $your_request_scheme; One field returns the connection object if the connection was successful, or undef if there was a failure: $response{connection} = $new_socket_handle; On success, another field tells you whether the connection contains all new materials. That is, whether the connection has been recycled from the component's cache or created anew. $response{from_cache} = $status; The from\_cache status may be "immediate" if the connection was immediately available from the cache. It will be "deferred" if the connection was reused, but another user had to release it first. Finally, from\_cache will be false if the connection had to be created to satisfy allocate(). Three other fields return error information if the connection failed. They are not present if the connection was successful. $response{function} = $name_of_failing_function; $response{error_num} = $! as a number; $response{error_str} = $! as a string; - free Free() notifies the connection manager when connections are free to be reused. Freed connections are entered into the keep-alive pool and may be returned by subsequent allocate() calls. $mgr->free($socket); For now free() is called with a socket, not a connection object. This is usually not a problem since POE::Component::Connection::Keepalive objects call free() for you when they are destroyed. Not calling free() will cause a program to leak connections. This is also not generally a problem, since free() is called automatically whenever connection objects are destroyed. - deallocate Cancel a connection that has not yet been established. Requires one parameter, the request ID returned by allocate(). - shutdown The keep-alive pool requires connections to be active internally. This may keep a program active even when all connections are idle. The shutdown() method forces the connection manager to clear its keep-alive pool, allowing a program to terminate gracefully. $mgr->shutdown(); # SEE ALSO [POE](https://metacpan.org/pod/POE) [POE::Component::Connection::Keepalive](https://metacpan.org/pod/POE::Component::Connection::Keepalive) # LICENSE This distribution is copyright 2004-2009 by Rocco Caputo. All rights are reserved. This distribution is free software; you may redistribute it and/or modify it under the same terms as Perl itself. # AUTHOR Rocco Caputo # CONTRIBUTORS Rob Bloodgood helped out a lot. Thank you. Joel Bernstein solved some nasty race conditions. Portugal Telecom [http://www.sapo.pt/](http://www.sapo.pt/) was kind enough to support his contributions. # BUG TRACKER https://rt.cpan.org/Dist/Display.html?Queue=POE-Component-Client-Keepalive # REPOSITORY http://gitorious.org/poe-component-client-keepalive http://github.com/rcaputo/poe-component-client-keepalive # OTHER RESOURCES http://search.cpan.org/dist/POE-Component-Client-Keepalive/ Makefile.PL100644000765000024 217112357030152 20513 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.019. use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "manage connections, with keep-alive", "AUTHOR" => "Rocco Caputo ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "POE-Component-Client-Keepalive", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "POE::Component::Client::Keepalive", "PREREQ_PM" => { "Net::IP::Minimal" => "0.02", "POE" => "1.311", "POE::Component::Resolver" => "0.917" }, "VERSION" => "0.272", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Net::IP::Minimal" => "0.02", "POE" => "1.311", "POE::Component::Resolver" => "0.917" ); 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); t000755000765000024 012357030152 16643 5ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.27213_close.t100644000765000024 362312357030152 20604 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Test close() on connections. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 4; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_first_conn => \&got_first_conn, got_second_conn => \&got_second_conn, nothing => sub { }, } ); sub start { my $heap = $_[HEAP]; $heap->{others} = 0; $heap->{cm} = POE::Component::Client::Keepalive->new( keep_alive => 1, max_open => 1, max_per_host => 1, resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_first_conn", context => "first", ); } sub got_first_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok(!defined($stuff->{from_cache}), "$which uses a new connection"); ok(defined($conn), "first request honored asynchronously"); $conn->start( InputEvent => 'nothing' ); $conn->close(); undef $conn; $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_second_conn", context => "second" ); } sub got_second_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok(defined($conn), "$which request honored asynchronously"); ok(!defined ($stuff->{from_cache}), "$which uses a new connection"); TestServer->shutdown(); $_[HEAP]->{cm}->shutdown(); } POE::Kernel->run(); exit; MANIFEST.SKIP100600000765000024 32012357030152 20401 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272CVS \.\# \.bak$ \.cvsignore \.git \.gz$ \.orig$ \.patch$ \.ppd$ \.rej$ \.rej$ \.svn \.swo$ \.swp$ ^Makefile$ ^Makefile\.old$ ^\. ^_Inline ^_build ^blib/ ^comptest ^cover_db ^coverage\.report$ ^pm_to_blib$ ~$ 05_errors.t100644000765000024 560312357030152 21014 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Test various error messages. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 12; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); sub test_err { my ($err, $target) = @_; $err =~ s/ at \S+ line \d+.*//s; ok($err eq $target, $target); } eval { my $x = POE::Component::Client::Keepalive->new("one parameter"); }; test_err($@, "new() needs an even number of parameters"); eval { my $x = POE::Component::Client::Keepalive->new(moo => 2); }; test_err($@, "new() doesn't accept: moo"); my $cm = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); eval { $cm->allocate("one parameter"); }; test_err($@, "allocate() needs an even number of parameters"); eval { $cm->allocate(); }; test_err($@, "allocate() needs a 'scheme'"); eval { $cm->allocate( scheme => "http", ); }; test_err($@, "allocate() needs an 'addr'"); eval { $cm->allocate( scheme => "http", addr => "localhost", ); }; test_err($@, "allocate() needs a 'port'"); eval { $cm->allocate( scheme => "http", addr => "localhost", port => 80, ); }; test_err($@, "allocate() needs an 'event'"); eval { $cm->allocate( scheme => "http", addr => "localhost", port => 80, event => "narf", ); }; test_err($@, "allocate() needs a 'context'"); eval { $cm->allocate( scheme => "http", addr => "localhost", port => 80, event => "narf", context => "moo", doodle => "ha ha ha, die", ); }; test_err($@, "allocate() doesn't accept: doodle"); eval { $cm->free(); }; test_err($@, "can't free() undefined socket"); eval { $cm->free("not a socket"); }; test_err($@, "can't free() unallocated socket"); $cm->shutdown(); ### Test the connection. use TestServer; my $server_port = TestServer->spawn(0); POE::Session->create( inline_states => { _start => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "first", ); }, got_conn => sub { my ($kernel, $heap, $response) = @_[KERNEL, HEAP, ARG0]; # Delete here to avoid an extra copy of the connection. my $conn = delete $response->{connection}; eval { $conn->start("moo"); }; test_err($@, "Must call start() with an even number of parameters"); # Free the connection. $conn = undef; TestServer->shutdown(); $heap->{cm}->shutdown(); }, _child => sub { }, _stop => sub { }, }, ); POE::Kernel->run(); 12_extref.t100644000765000024 274212357030152 20774 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # vim: filetype=perl # Make sure that client sessions stay alive while they're waiting for # sockets. Also test the shutdown order, or more appropriately that # Client::Keepalive can be shut down with outstanding sockets, without # the whole program crashing and burning horribly. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 1; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); my $global_cm = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); POE::Session->create( inline_states => { _start => \&start, _stop => \&stop, got_conn => \&got_conn, } ); sub start { my $heap = $_[HEAP]; $global_cm->allocate( scheme => "http", addr => "127.0.0.1", port => $server_port, event => "got_conn", context => "first", ); } sub got_conn { my ($heap, $stuff) = @_[HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok( defined($conn), "got the connection" ); $global_cm->shutdown() unless $heap->{cm_shutdown}++; TestServer->shutdown() unless $heap->{ts_shutdown}++; } sub stop { my $heap = $_[HEAP]; $global_cm->shutdown() unless $heap->{cm_shutdown}++; TestServer->shutdown() unless $heap->{ts_shutdown}++; } POE::Kernel->run(); exit; mylib000755000765000024 012357030152 17514 5ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272cvr.perl100755000765000024 47112357030152 21317 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/mylib# Be warned: Pod::Coverage will add a lot of time to the tests. # Before: Files=8, Tests=51, 74 wallclock secs (...) # After : Files=8, Tests=51, 459 wallclock secs (...) cover -delete HARNESS_PERL_SWITCHES="-MDevel::Cover=+ignore,mylib,-coverage,statement,branch,subroutine,time,condition,path" make test cover 09_timeout.t100644000765000024 443612357030152 21175 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # vim: filetype=perl ts=2 sw=2 expandtab # Test request timeouts. Set the timeout ridiculously small, so # timeouts happen immediately. Request a connection, and watch it # fail. Ha ha ha! use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 6; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); # Listen on a socket, but don't accept connections. use IO::Socket::INET; my $unaccepting_listener = IO::Socket::INET->new( LocalAddr => "127.0.0.1", LocalPort => $server_port + 1, # Cross fingers. Reuse => "yes", ) or die $!; # Session to run tests. POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_conn => \&got_conn, } ); sub start { my $heap = $_[HEAP]; # Connecting to localhost can happen within 0 seconds, so we make # the timeout negative. Connections can't happen in the past. :) $heap->{cm} = POE::Component::Client::Keepalive->new( timeout => -1, resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); { $heap->{cm}->allocate( scheme => "http", addr => "127.0.0.1", port => $server_port, event => "got_conn", context => "first", ); } # Try to connect to a socket we know is listening but won't answer. # Forces the timeout after the wheel is created. { $heap->{cm}->allocate( scheme => "http", addr => "127.0.0.1", port => $server_port+1, event => "got_conn", context => "second", timeout => 0.5, ); } } sub got_conn { my ($heap, $stuff) = @_[HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok(!defined($stuff->{from_cache}), "$which didn't come from cache"); ok(!defined($conn), "$which connection failed"); SKIP: { skip("Connection refused.", 1) if $stuff->{error_num} == Errno::ECONNREFUSED; is( $stuff->{error_num}, Errno::ETIMEDOUT, "$which connection request timed out" ); } return unless ++$heap->{timeout_count} == 2; $heap->{cm}->shutdown(); TestServer->shutdown(); } POE::Kernel->run(); exit; 06_activity.t100644000765000024 544512357030152 21341 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Test activity on idle connections in the pool. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 5; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, check_for_input => \&check_for_input, got_conn => \&got_conn, got_conn2 => \&got_conn2, got_error => \&got_error, got_input => \&got_input, got_timeout => \&got_timeout, shutdown_server => \&shutdown_server, } ); # Start the connection manager, and allocate a connection to our test # server. sub start { my $heap = $_[HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "first", ); } # A connection has been allocated. # Tell the test server to send us something. # Discard the connection before we can retrieve from it. sub got_conn { my ($heap, $stuff) = @_[HEAP, ARG0..$#_]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok(defined($conn), "$which connection established asynchronously"); ok(not (defined ($stuff->{from_cache})), "$which connection request deferred"); TestServer->send_something(); $_[KERNEL]->delay(check_for_input => 1); # The connection goes free when it drops out of scope here. # Everything that was sent to it remains unread. } # Reallocate the free socket. It should be asynchronous because there # was data on the socket and the connection could not be reused. sub check_for_input { my ($kernel, $heap) = @_[KERNEL, HEAP]; $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn2", context => "first", ); $kernel->delay(shutdown_server => 1); } sub got_conn2 { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0..$#_]; $heap->{conn} = $stuff->{connection}; is( $stuff->{from_cache}, undef, "second connection established assynchronously" ); $heap->{conn}->start( InputEvent => "got_input", ); ok(defined($heap->{conn}->wheel()), "connection contains a wheel"); } sub got_input { $_[HEAP]->{got_input} = 1; } sub shutdown_server { my ($kernel, $heap) = @_[KERNEL, HEAP]; ok(!$heap->{got_input}, "didn't receive any input"); delete $heap->{conn}; TestServer->shutdown(); $heap->{cm}->shutdown(); } POE::Kernel->run(); exit; 10_resolver.t100644000765000024 556612357030152 21345 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Test connection reuse. Allocates a connection, frees it, and # allocates another. The second allocation should return right away # because it is honored from the keep-alive pool. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 6; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); my $test_server_use_count = 0; POE::Session->create( inline_states => { _child => sub { }, _start => \&start_with, _stop => sub { }, got_conn => \&got_conn, } ); POE::Session->create( inline_states => { _child => sub { }, _start => \&start_without, _stop => sub { }, got_conn => \&got_conn, } ); sub start_with { my $heap = $_[HEAP]; $_[KERNEL]->alias_set ('WITH'); $heap->{cm} = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "first", ); ++$test_server_use_count; } sub start_without { my $heap = $_[HEAP]; $_[KERNEL]->alias_set ('WITHOUT'); $heap->{cm} = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "second", ); ++$test_server_use_count; } # TODO - I think this callback is polymorphic (first vs. second) # bcause it has common code. It's probably cleaner to implement two # separate callbacks and some helpers to handle their commonalities. sub got_conn{ my ($kernel, $heap, $response) = @_[KERNEL, HEAP, ARG0]; # The delete() ensures only one copy of the connection exists. my $connection = delete $response->{connection}; my $which = $response->{context}; if (defined $connection) { pass "$which request honored asynchronously"; } else { fail( "$which request $response->{function} error $response->{error_num}: " . $response->{error_str} ); } ok( (not defined $response->{'from_cache'}), "$which request not from cache" ); if ($which eq 'first') { ok(1, "$which request from internal resolver"); } elsif ($which eq 'second') { ok(1, "$which request from external resolver"); } TestServer->shutdown() unless --$test_server_use_count; # need this so we don't get trace output about our session having # already died $connection = undef; # and this so we can terminate without having to go through the # idle polling period $heap->{cm}->shutdown; # and this so we terminate at all delete $heap->{cm}; } POE::Kernel->run(); exit; 04_free_each.t100644000765000024 563412357030152 21404 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Testing the bits that keep track of connections per connection key. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 6; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); POE::Session->create( inline_states => { _start => \&start, got_conn => \&got_conn, got_error => \&got_error, got_timeout => \&got_timeout, test_alloc => \&test_alloc, and_free => \&and_free, _child => sub { }, _stop => sub { }, } ); # Allocate two connections. Wait for both to be allocated. Free them # both. sub start { my $heap = $_[HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "first", ); } { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "second", ); } } sub got_conn { my ($heap, $stuff) = @_[HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok(defined($conn), "$which connection created successfully"); ok(not (defined ($stuff->{from_cache})), "$which not from cache"); $heap->{conn}{$which} = $conn; return unless keys(%{$heap->{conn}}) == 2; # Shut this one down. $heap->{conn}{$which}->start(); $heap->{conn}{$which}->wheel()->shutdown_input(); $heap->{conn}{$which}->wheel()->shutdown_output(); # Free all heaped connections. delete $heap->{conn}; # Give the server time to accept the connection. $_[KERNEL]->delay(test_alloc => 1); } # Allocate and free a third connection. It's reused from the free # pool. sub test_alloc { my $heap = $_[HEAP]; $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "and_free", context => "third", ); } sub and_free { my ($heap, $stuff) = @_[HEAP, ARG0]; my $conn = delete $stuff->{connection}; my $which = $stuff->{context}; if (defined $conn) { pass "$which request honored asynchronously"; } else { fail( "$which request $stuff->{function} error $stuff->{error_num}: " . $stuff->{error_str} ); } is( $stuff->{from_cache}, 'immediate', "third connection honored from the pool" ); # Free the connection first. # Close its internal socket before freeing. This will ensure that # the connection manager can cope with such things. close $conn->[POE::Component::Connection::Keepalive::CK_SOCKET]; $conn = undef; TestServer->shutdown(); $heap->{cm}->shutdown(); } POE::Kernel->run(); exit; 03_each_queue.t100644000765000024 751012357030152 21601 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # vim: filetype=perl # Test connection queuing. Set the per-connection queue to be really # small (one in all), and then try to allocate two connections. The # second should queue. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 8; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_error => \&got_error, got_first_conn => \&got_first_conn, got_fourth_conn => \&got_fourth_conn, got_third_conn => \&got_third_conn, got_timeout => \&got_timeout, test_pool_alive => \&test_pool_alive, } ); sub start { my $heap = $_[HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( max_per_host => 1, resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); # Count the number of times test_pool_alive is called. When that's # 2, we actually do the test. $heap->{test_pool_alive} = 0; # Make two identical tests. They're both queued because the free # pool is empty at this point. { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_first_conn", context => "first", ); } { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_first_conn", context => "second", ); } } sub got_first_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; if (defined $conn) { pass "$which request honored asynchronously"; } else { fail( "$which request $stuff->{function} error $stuff->{error_num}: " . $stuff->{error_str} ); } if ($which eq 'first') { ok(not (defined ($stuff->{from_cache})), "$which not from cache"); } else { is($stuff->{from_cache}, 'deferred', "$which deferred from cache"); } $kernel->yield("test_pool_alive"); } sub got_third_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; if (defined $conn) { pass "$which request honored asynchronously"; } else { fail( "$which request $stuff->{function} error $stuff->{error_num}: " . $stuff->{error_str} ); } is($stuff->{from_cache}, 'immediate', "$which connection request honored from pool immediately"); } # We need a free connection pool of 2 or more for this next test. We # want to allocate and free one of them to make sure the pool is not # destroyed. Yay, Devel::Cover, for making me actually do this. sub test_pool_alive { my ($kernel, $heap) = @_[KERNEL, HEAP]; $heap->{test_pool_alive}++; return unless $heap->{test_pool_alive} == 2; $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_third_conn", context => "third", ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_fourth_conn", context => "fourth", ); } sub got_fourth_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = delete $stuff->{connection}; if (defined $conn) { pass "fourth request established asynchronously"; } else { fail( "fourth request $stuff->{function} error $stuff->{error_num}: " . $stuff->{error_str} ); } is ($stuff->{from_cache}, 'deferred', "connection from pool"); $conn = undef; TestServer->shutdown(); $heap->{cm}->shutdown(); } POE::Kernel->run(); exit; 07_keep_alive.t100644000765000024 467312357030152 21614 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Test keepalive. Allocates a connection, frees it, waits for the # keep-alive timeout, allocates an identical connection. The second # allocation should return a different connection. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 6; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_conn => \&got_conn, got_first_conn => \&got_first_conn, kept_alive => \&keepalive_over, second_kept_alive => \&second_kept_alive, } ); sub start { my $heap = $_[HEAP]; $heap->{others} = 0; $heap->{cm} = POE::Component::Client::Keepalive->new( keep_alive => 1, resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_first_conn", context => "first", ); } sub got_first_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; ok(!defined($stuff->{from_cache}), "first connection request deferred"); ok(defined($conn), "first request honored asynchronously"); $kernel->delay(kept_alive => 2); } sub keepalive_over { my $heap = $_[HEAP]; # The second and third requests should be deferred. The first # connection won't be reused because it should have been reaped by # the keep-alive timer. $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "second", ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "third", ); } sub got_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok(defined($conn), "$which request honored asynchronously"); ok(!defined ($stuff->{from_cache}), "$which uses a new connection"); if (++$heap->{others} == 2) { $kernel->delay(second_kept_alive => 2); } } sub second_kept_alive { TestServer->shutdown(); $_[HEAP]->{cm}->shutdown(); } POE::Kernel->run(); exit; 08_quick_reuse.t100644000765000024 634012357030152 22021 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Test rapid connection reuse. Sets the maximum overall connections # to a low number. Allocate up to the maximum. Reuse one of the # connections, and allocate a completely different connection. The # allocation shuld be deferred, and one of the free sockets in the # keep-alive pool should be discarded to make room for it. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 7; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $port_a = TestServer->spawn(0); my $port_b = TestServer->spawn(0); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_another_conn => \&got_another_conn, got_conn => \&got_conn, got_error => \&got_error, } ); sub start { my $heap = $_[HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( max_open => 2, resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{conn_count} = 0; { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $port_a, event => "got_conn", context => "first", ); } { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $port_a, event => "got_conn", context => "second", ); } } sub got_conn { my ($heap, $response) = @_[HEAP, ARG0]; my $conn = delete $response->{connection}; my $which = $response->{context}; if (defined $conn) { pass "$which request established asynchronously"; } else { fail( "$which request $response->{function} error $response->{error_num}: " . $response->{error_str} ); } ok(!defined($response->{from_cache}), "$which connection request deferred"); $conn = undef; return unless ++$heap->{conn_count} == 2; # Re-allocate one of the connections. $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $port_a, event => "got_another_conn", context => "third", ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $port_b, event => "got_another_conn", context => "fourth", ); } sub got_another_conn { my ($heap, $response) = @_[HEAP, ARG0]; # Deleting here to avoid a copy of the connection in %$response. my $conn = delete $response->{connection}; my $which = $response->{context}; if ($which eq 'third') { is( $response->{from_cache}, 'immediate', "$which connection request honored from pool" ); return; } if ($which eq 'fourth') { ok( !defined ($response->{from_cache}), "$which connection request honored from pool" ); if (defined $conn) { pass "$which request established asynchronously"; } else { fail( "$which request $response->{function} error $response->{error_num}: " . $response->{error_str} ); } # Free the connection first. $conn = undef; TestServer->shutdown(); $heap->{cm}->shutdown(); return; } die; } POE::Kernel->run(); exit; 11_dead_socket.t100644000765000024 573212357030152 21745 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Test connection queuing. Set the per-connection queue to be really # small (one in all), and then try to allocate two connections. The # second should queue. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 7; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_error => \&got_error, got_first_conn => \&got_first_conn, cleanup1 => \&cleanup1, cleanup => \&cleanup, error => \&error, input => \&input, } ); sub start { my $heap = $_[HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( max_per_host => 1, resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); # Count the number of times test_pool_alive is called. When that's # 2, we actually do the test. $heap->{test_pool_alive} = 0; # Make two identical tests. They're both queued because the free # pool is empty at this point. { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_first_conn", context => "first", ); } { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_first_conn", context => "second", ); } } sub got_first_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok(defined($conn), "$which connection established asynchronously"); if ($which eq 'first') { ok(not (defined ($stuff->{from_cache})), "$which not from cache"); my $wheel = $conn->start( ErrorEvent => 'error', InputEvent => 'cleanup1', ); $heap->{conn} = $conn; TestServer->send_something; } else { ok(not (defined ($stuff->{from_cache})), "$which not from cache"); my $wheel = $conn->start( ErrorEvent => 'error', InputEvent => 'input', ); TestServer->send_something; $heap->{conn} = $conn; $kernel->delay_add ('cleanup', 1); } } sub cleanup1 { is ($_[ARG1], $_[HEAP]->{conn}->wheel->ID, "input for correct wheel"); $_[HEAP]->{wheelid} = $_[ARG1]; TestServer->shutdown_clients; delete $_[HEAP]->{conn}; } sub cleanup { delete $_[HEAP]->{conn}; TestServer->shutdown; } sub error { my $heap = $_[HEAP]; is ($heap->{wheelid}, $heap->{conn}->wheel->ID, "eof arrives at same wheel"); delete $_[HEAP]->{wheelid}; $heap->{conn}->wheel->shutdown_input; $heap->{conn}->wheel->shutdown_output; delete $heap->{conn}; } sub input { $_[HEAP]->{wheelid} = $_[ARG1]; ok (1, "input arrives from new socket"); TestServer->shutdown_clients; } POE::Kernel->run(); exit; 51_reiss_reuse.t100644000765000024 417012357030152 22027 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # Regression test for a bug which occured because a loop # that would look for existing free connections would reuse # a connection without removing it from a list of connections # that can be closed if we have neared the connection limit. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 5; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); my $another_port = TestServer->spawn(0); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_another_conn => \&got_another_conn, got_conn => \&got_conn, got_error => \&got_error, } ); sub start { my $heap = $_[HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( max_open => 2, max_per_host => 2, resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{conn_count} = 0; for (1..3) { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "first/$_", ); } } sub got_conn { my ($heap, $stuff) = @_[HEAP, ARG0]; my $conn = delete $stuff->{connection}; my $which = $stuff->{context}; if (defined $conn) { pass "$which request established asynchronously"; } else { fail( "$which request $stuff->{function} error $stuff->{error_num}: " . $stuff->{error_str} ); } $conn = undef; if (++$heap->{request_count} == 1) { $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "second-a" ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $another_port, event => "got_conn", context => "second-b" ); } if ($heap->{request_count} == 5) { TestServer->shutdown(); $heap->{cm}->shutdown(); } } POE::Kernel->run(); exit; TestServer.pm100644000765000024 311212357030152 22315 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/mylibpackage TestServer; use warnings; use strict; use POE; use POE::Component::Server::TCP; use Socket qw(sockaddr_in); my %clients; my %servers; my $seq = 0; sub spawn { my ($class, $port) = @_; my $alias = 'TestServer_' . ++$seq; POE::Component::Server::TCP->new( Alias => $alias, Port => $port, # Random one if 0. Address => "127.0.0.1", ClientInput => \&discard_client_input, ClientConnected => \®ister_client, ClientDisconnected => \&unregister_client, Started => sub { # Switch $port to the port this server actually bound on. my $listener_sockname = $_[HEAP]{listener}->getsockname(); if (defined $listener_sockname) { ($port, undef) = sockaddr_in($listener_sockname); } else { $port = undef; } }, InlineStates => { send_something => \&internal_send_something, }, ); $servers{$port} = $alias; return $port; } sub register_client { $clients{$_[SESSION]->ID} = 1; } sub unregister_client { delete $clients{$_[SESSION]->ID}; } sub discard_client_input { # Do nothing. } sub send_something { foreach my $client (keys %clients) { $poe_kernel->call($client, "send_something"); } } sub internal_send_something { $_[HEAP]->{client}->put(scalar localtime); } sub shutdown { foreach my $alias (values(%servers), keys(%clients)) { $poe_kernel->post($alias => "shutdown"); } } sub shutdown_clients { foreach my $session (keys(%clients)) { $poe_kernel->call($session => "shutdown"); } } 1; 01_socket_reuse.t100644000765000024 365712357030152 22176 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # vim: filetype=perl # Test connection reuse. Allocates a connection, frees it, and # allocates another. The second allocation should return right away # because it is honored from the keep-alive pool. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 4; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; my $server_port = TestServer->spawn(0); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_conn => \&got_conn, } ); sub start { my $heap = $_[HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "first", ); } sub got_conn{ my ($heap, $stuff) = @_[HEAP, ARG0]; # The delete() ensures only one copy of the connection exists. my $connection = delete $stuff->{connection}; my $which = $stuff->{context}; if (defined $connection) { pass "$which request honored asynchronously"; } else { fail( "$which request $stuff->{function} error $stuff->{error_num}: " . $stuff->{error_str} ); } my $is_cached = $stuff->{from_cache}; # Destroy the connection, freeing its socket. $connection = undef; if ($which eq 'first') { ok(not (defined ($is_cached)), "$which request not from cache"); $heap->{cm}->allocate( scheme => "http", addr => "localhost", port => $server_port, event => "got_conn", context => "second", ); } elsif ($which eq 'second') { ok(defined $is_cached, "$which request from cache"); TestServer->shutdown(); $heap->{cm}->shutdown(); } } POE::Kernel->run(); exit; 02_socket_queue.t100644000765000024 774312357030152 22200 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # vim: filetype=perl ts=2 sw=2 expandtab # Test connection queuing. Set the max active connection to be really # small (one in all), and then try to allocate two connections. The # second should queue. use warnings; use strict; use lib qw(./mylib ../mylib); use Test::More tests => 9; use Errno qw(ECONNREFUSED ETIMEDOUT); sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); use TestServer; diag("This test may take a long time if your firewall blackholes connections."); my $server_port = TestServer->spawn(0); my $unknown_port = $server_port + 1; # Kludge. Fingers crossed. POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => sub { }, got_error => \&got_error, got_first_conn => \&got_first_conn, got_third_conn => \&got_third_conn, got_fourth_conn => \&got_fourth_conn, got_timeout => \&got_timeout, test_max_queue => \&test_max_queue, } ); sub start { my $heap = $_[HEAP]; $heap->{cm} = POE::Component::Client::Keepalive->new( max_open => 1, resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); # Count the number of times test_max_queue is called. When that's # 2, we actually do the test. $heap->{test_max_queue} = 0; # Make two identical tests. They're both queued because the free # pool is empty at this point. { $heap->{cm}->allocate( scheme => "http", addr => "127.0.0.1", port => $server_port, event => "got_first_conn", context => "first", ); } { $heap->{cm}->allocate( scheme => "http", addr => "127.0.0.1", port => $server_port, event => "got_first_conn", context => "second", ); } } sub got_first_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = delete $stuff->{connection}; my $which = $stuff->{context}; ok(defined($conn), "$which connection honored asynchronously"); if ($which eq 'first') { ok(not (defined ($stuff->{from_cache})), "$which not from cache"); } else { ok(defined ($stuff->{from_cache}), "$which from cache"); } $conn = undef; $kernel->yield("test_max_queue"); } sub got_third_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; my $which = $stuff->{context}; ok( defined($stuff->{from_cache}), "$which connection request honored from pool" ); $conn = undef; } # We need a free connection pool of 2 or more for this next test. We # want to allocate one of them, and then attempt to allocate a # different connection. sub test_max_queue { my ($kernel, $heap) = @_[KERNEL, HEAP]; $heap->{test_max_queue}++; return unless $heap->{test_max_queue} == 2; $heap->{cm}->allocate( scheme => "http", addr => "127.0.0.1", port => $server_port, event => "got_third_conn", context => "third", ); $heap->{cm}->allocate( scheme => "http", addr => "127.0.0.1", port => $unknown_port, event => "got_fourth_conn", context => "fourth", ); } # This connection should fail, actually. sub got_fourth_conn { my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0]; my $conn = $stuff->{connection}; ok(!defined($conn), "fourth connection failed (as it should)"); ok($stuff->{function} eq "connect", "connection failed in connect"); ok( ($stuff->{error_num} == ECONNREFUSED) || ($stuff->{error_num} == ETIMEDOUT), "connection error ECONNREFUSED" ); my $lc_str = lc $stuff->{error_str}; $! = ECONNREFUSED; my @wanted = ( lc "$!" ); $! = ETIMEDOUT; push @wanted, lc "$!"; push @wanted, "unknown error" if $^O eq "MSWin32"; ok( (grep { $lc_str eq $_ } @wanted), "error string: wanted(connection refused) got($lc_str)" ); # Shut things down. TestServer->shutdown(); $heap->{cm}->shutdown(); } POE::Kernel->run(); exit; 50_bisbee_timeout.t100644000765000024 301112357030152 22466 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!/usr/bin/perl # vim: filetype=perl use warnings; use strict; use lib qw(./mylib ../mylib); sub POE::Kernel::ASSERT_DEFAULT () { 1 } use Test::More tests => 2; use POE; use POE::Component::Client::Keepalive; use POE::Component::Resolver; use Socket qw(AF_INET); POE::Session->create( inline_states => { _child => sub { }, _start => \&start, _stop => \&crom_count_the_responses, got_resp => \&got_resp, } ); POE::Kernel->run(); exit; # Start up! Create a Keepalive component. Request one connection. # The request is specially formulated to time out immediately. We # should receive no other response (especially not a resolve error # like "Host has no address." sub start { my $heap = $_[HEAP]; $heap->{errors} = [ ]; $heap->{cm} = POE::Component::Client::Keepalive->new( resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]), ); $heap->{cm}->allocate( scheme => "http", addr => "seriously-hoping-this-never-resolves.fail", port => 80, event => "got_resp", context => "moo", timeout => -1, ); } # We received a response. Count it. sub got_resp { my ($heap, $stuff) = @_[HEAP, ARG0]; push @{$heap->{errors}}, $stuff->{function}; } # End of run. We're good if we receive only one timeout response. sub crom_count_the_responses { my @errors = @{$_[HEAP]{errors}}; ok( @errors == 1, "should have received one response (actual=" . @errors . ")" ); ok( $errors[0] eq "connect", "the one response was a connect error"); } release-pod-syntax.t100644000765000024 45612357030152 22701 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 000-report-versions.t100644000765000024 3127012357030152 22671 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!perl use warnings; use strict; use Test::More 0.94; # Include a cut-down version of YAML::Tiny so we don't introduce unnecessary # dependencies ourselves. package Local::YAML::Tiny; use strict; use Carp 'croak'; # UTF Support? sub HAVE_UTF8 () { $] >= 5.007003 } BEGIN { if ( HAVE_UTF8 ) { # The string eval helps hide this from Test::MinimumVersion eval "require utf8;"; die "Failed to load UTF-8 support" if $@; } # Class structure require 5.004; $YAML::Tiny::VERSION = '1.40'; # Error storage $YAML::Tiny::errstr = ''; } # Printable characters for escapes my %UNESCAPES = ( z => "\x00", a => "\x07", t => "\x09", n => "\x0a", v => "\x0b", f => "\x0c", r => "\x0d", e => "\x1b", '\\' => '\\', ); ##################################################################### # Implementation # Create an empty YAML::Tiny object sub new { my $class = shift; bless [ @_ ], $class; } # Create an object from a file sub read { my $class = ref $_[0] ? ref shift : shift; # Check the file my $file = shift or return $class->_error( 'You did not specify a file name' ); return $class->_error( "File '$file' does not exist" ) unless -e $file; return $class->_error( "'$file' is a directory, not a file" ) unless -f _; return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; # Slurp in the file local $/ = undef; local *CFG; unless ( open(CFG, $file) ) { return $class->_error("Failed to open file '$file': $!"); } my $contents = ; unless ( close(CFG) ) { return $class->_error("Failed to close file '$file': $!"); } $class->read_string( $contents ); } # Create an object from a string sub read_string { my $class = ref $_[0] ? ref shift : shift; my $self = bless [], $class; my $string = $_[0]; unless ( defined $string ) { return $self->_error("Did not provide a string to load"); } # Byte order marks # NOTE: Keeping this here to educate maintainers # my %BOM = ( # "\357\273\277" => 'UTF-8', # "\376\377" => 'UTF-16BE', # "\377\376" => 'UTF-16LE', # "\377\376\0\0" => 'UTF-32LE' # "\0\0\376\377" => 'UTF-32BE', # ); if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) { return $self->_error("Stream has a non UTF-8 BOM"); } else { # Strip UTF-8 bom if found, we'll just ignore it $string =~ s/^\357\273\277//; } # Try to decode as utf8 utf8::decode($string) if HAVE_UTF8; # Check for some special cases return $self unless length $string; unless ( $string =~ /[\012\015]+\z/ ) { return $self->_error("Stream does not end with newline character"); } # Split the file into lines my @lines = grep { ! /^\s*(?:\#.*)?\z/ } split /(?:\015{1,2}\012|\015|\012)/, $string; # Strip the initial YAML header @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; # A nibbling parser while ( @lines ) { # Do we have a document header? if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { # Handle scalar documents shift @lines; if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { push @$self, $self->_read_scalar( "$1", [ undef ], \@lines ); next; } } if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { # A naked document push @$self, undef; while ( @lines and $lines[0] !~ /^---/ ) { shift @lines; } } elsif ( $lines[0] =~ /^\s*\-/ ) { # An array at the root my $document = [ ]; push @$self, $document; $self->_read_array( $document, [ 0 ], \@lines ); } elsif ( $lines[0] =~ /^(\s*)\S/ ) { # A hash at the root my $document = { }; push @$self, $document; $self->_read_hash( $document, [ length($1) ], \@lines ); } else { croak("YAML::Tiny failed to classify the line '$lines[0]'"); } } $self; } # Deparse a scalar string to the actual scalar sub _read_scalar { my ($self, $string, $indent, $lines) = @_; # Trim trailing whitespace $string =~ s/\s*\z//; # Explitic null/undef return undef if $string eq '~'; # Quotes if ( $string =~ /^\'(.*?)\'\z/ ) { return '' unless defined $1; $string = $1; $string =~ s/\'\'/\'/g; return $string; } if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) { # Reusing the variable is a little ugly, # but avoids a new variable and a string copy. $string = $1; $string =~ s/\\"/"/g; $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex; return $string; } # Special cases if ( $string =~ /^[\'\"!&]/ ) { croak("YAML::Tiny does not support a feature in line '$lines->[0]'"); } return {} if $string eq '{}'; return [] if $string eq '[]'; # Regular unquoted string return $string unless $string =~ /^[>|]/; # Error croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines; # Check the indent depth $lines->[0] =~ /^(\s*)/; $indent->[-1] = length("$1"); if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } # Pull the lines my @multiline = (); while ( @$lines ) { $lines->[0] =~ /^(\s*)/; last unless length($1) >= $indent->[-1]; push @multiline, substr(shift(@$lines), length($1)); } my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; return join( $j, @multiline ) . $t; } # Parse an array sub _read_array { my ($self, $array, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { # Inline nested hash my $indent2 = length("$1"); $lines->[0] =~ s/-/ /; push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { # Array entry with a value shift @$lines; push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { shift @$lines; unless ( @$lines ) { push @$array, undef; return 1; } if ( $lines->[0] =~ /^(\s*)\-/ ) { my $indent2 = length("$1"); if ( $indent->[-1] == $indent2 ) { # Null array entry push @$array, undef; } else { # Naked indenter push @$array, [ ]; $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines ); } } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); } else { croak("YAML::Tiny failed to classify line '$lines->[0]'"); } } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { # This is probably a structure like the following... # --- # foo: # - list # bar: value # # ... so lets return and let the hash parser handle it return 1; } else { croak("YAML::Tiny failed to classify line '$lines->[0]'"); } } return 1; } # Parse an array sub _read_hash { my ($self, $hash, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } # Get the key unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) { if ( $lines->[0] =~ /^\s*[?\'\"]/ ) { croak("YAML::Tiny does not support a feature in line '$lines->[0]'"); } croak("YAML::Tiny failed to classify line '$lines->[0]'"); } my $key = $1; # Do we have a value? if ( length $lines->[0] ) { # Yes $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines ); } else { # An indent shift @$lines; unless ( @$lines ) { $hash->{$key} = undef; return 1; } if ( $lines->[0] =~ /^(\s*)-/ ) { $hash->{$key} = []; $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); } elsif ( $lines->[0] =~ /^(\s*)./ ) { my $indent2 = length("$1"); if ( $indent->[-1] >= $indent2 ) { # Null hash entry $hash->{$key} = undef; } else { $hash->{$key} = {}; $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); } } } } return 1; } # Set error sub _error { $YAML::Tiny::errstr = $_[1]; undef; } # Retrieve error sub errstr { $YAML::Tiny::errstr; } ##################################################################### # Use Scalar::Util if possible, otherwise emulate it BEGIN { eval { require Scalar::Util; }; if ( $@ ) { # Failed to load Scalar::Util eval <<'END_PERL'; sub refaddr { my $pkg = ref($_[0]) or return undef; if (!!UNIVERSAL::can($_[0], 'can')) { bless $_[0], 'Scalar::Util::Fake'; } else { $pkg = undef; } "$_[0]" =~ /0x(\w+)/; my $i = do { local $^W; hex $1 }; bless $_[0], $pkg if defined $pkg; $i; } END_PERL } else { Scalar::Util->import('refaddr'); } } ##################################################################### # main test ##################################################################### package main; BEGIN { # Skip modules that either don't want to be loaded directly, such as # Module::Install, or that mess with the test count, such as the Test::* # modules listed here. # # Moose::Role conflicts if Moose is loaded as well, but Moose::Role is in # the Moose distribution and it's certain that someone who uses # Moose::Role also uses Moose somewhere, so if we disallow Moose::Role, # we'll still get the relevant version number. my %skip = map { $_ => 1 } qw( App::FatPacker Class::Accessor::Classy Devel::Cover Module::Install Moose::Role POE::Loop::Tk Template::Test Test::Kwalitee Test::Pod::Coverage Test::Portability::Files Test::YAML::Meta open ); my $Test = Test::Builder->new; $Test->plan(skip_all => "META.yml could not be found") unless -f 'META.yml' and -r _; my $meta = (Local::YAML::Tiny->read('META.yml'))->[0]; my %requires; for my $require_key (grep { /requires/ } keys %$meta) { my %h = %{ $meta->{$require_key} }; $requires{$_}++ for keys %h; } delete $requires{perl}; diag("Testing with Perl $], $^X"); for my $module (sort keys %requires) { if ($skip{$module}) { note "$module doesn't want to be loaded directly, skipping"; next; } local $SIG{__WARN__} = sub { note "$module: $_[0]" }; require_ok $module or BAIL_OUT("can't load $module"); my $version = $module->VERSION; $version = 'undefined' unless defined $version; diag(" $module version is $version"); } done_testing; } release-pod-coverage.t100644000765000024 57212357030152 23145 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); Client000755000765000024 012357030152 22751 5ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/lib/POE/ComponentKeepalive.pm100644000765000024 13003112357030152 25412 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/lib/POE/Component/Clientpackage POE::Component::Client::Keepalive; # vim: ts=2 sw=2 expandtab $POE::Component::Client::Keepalive::VERSION = '0.272'; use warnings; use strict; use Carp qw(croak); use Errno qw(ETIMEDOUT EBADF); use Socket qw(SOL_SOCKET SO_LINGER); use POE; use POE::Wheel::SocketFactory; use POE::Component::Connection::Keepalive; use POE::Component::Resolver; use Net::IP::Minimal qw(ip_is_ipv4); my $ssl_available; eval { require POE::Component::SSLify; $ssl_available = 1; }; use constant DEBUG => 0; use constant { DEBUG_DNS => (DEBUG || 0), DEBUG_DEALLOCATE => (DEBUG || 0), }; use constant TCP_PROTO => scalar(getprotobyname "tcp") || ( die "getprotobyname('tcp') failed: $!" ); # Manage connection request IDs. my $current_id = 0; my %active_req_ids; sub _allocate_req_id { while (1) { last unless exists $active_req_ids{++$current_id}; } return $active_req_ids{$current_id} = $current_id; } sub _free_req_id { my $id = shift; delete $active_req_ids{$id}; } my $default_resolver; my $instances = 0; # The connection manager uses a number of data structures, most of # them arrays. These constants define offsets into those arrays, and # the comments document them. use constant { # @$self = ( SF_POOL => 0, # \%socket_pool, SF_QUEUE => 1, # \@request_queue, SF_USED => 2, # \%sockets_in_use, SF_WHEELS => 3, # \%wheels_by_id, SF_USED_EACH => 4, # \%count_by_triple, SF_MAX_OPEN => 5, # $max_open_count, SF_MAX_HOST => 6, # $max_per_host, SF_SOCKETS => 7, # \%socket_xref, SF_KEEPALIVE => 8, # $keep_alive_secs, SF_TIMEOUT => 9, # $default_request_timeout, SF_RESOLVER => 10, # $poco_client_dns_object, SF_SHUTDOWN => 11, # $shutdown_flag, SF_REQ_INDEX => 12, # \%request_id_to_wheel_id, SF_BIND_ADDR => 13, # $bind_address, SF_ALIAS => 14, # $embedded_session_alias }; # ); use constant { # $socket_xref{$socket} = [ SK_KEY => 0, # $conn_key, SK_TIMER => 1, # $idle_timer, }; # ]; # $count_by_triple{$conn_key} = $conn_count; use constant { # $wheels_by_id{$wheel_id} = [ WHEEL_WHEEL => 0, # $wheel_object, WHEEL_REQUEST => 1, # $request, }; # ]; # $socket_pool{$conn_key}{$socket} = $socket; use constant { # $sockets_in_use{$socket} = ( USED_SOCKET => 0, # $socket_handle, USED_TIME => 1, # $allocation_time, USED_KEY => 2, # $conn_key, }; # ); # @request_queue = ( # $request, # $request, # .... # ); use constant { # $request = [ RQ_SESSION => 0, # $request_session, RQ_EVENT => 1, # $request_event, RQ_SCHEME => 2, # $request_scheme, RQ_ADDRESS => 3, # $request_address, RQ_IP => 4, # $request_ip, RQ_PORT => 5, # $request_port, RQ_CONN_KEY => 6, # $request_connection_key, RQ_CONTEXT => 7, # $request_context, RQ_TIMEOUT => 8, # $request_timeout, RQ_START => 9, # $request_start_time, RQ_TIMER_ID => 10, # $request_timer_id, RQ_WHEEL_ID => 11, # $request_wheel_id, RQ_ACTIVE => 12, # $request_is_active, RQ_ID => 13, # $request_id, RQ_ADDR_FAM => 14, # $request_address_family, RQ_FOR_SCHEME => 15, # $... RQ_FOR_ADDRESS => 16, # $... RQ_FOR_PORT => 17, # $... RQ_RESOLVER_ID => 18, # $resolver_request_id, }; # ]; # Create a connection manager. sub new { my $class = shift; croak "new() needs an even number of parameters" if @_ % 2; my %args = @_; my $max_per_host = delete($args{max_per_host}) || 4; my $max_open = delete($args{max_open}) || 128; my $keep_alive = delete($args{keep_alive}) || 15; my $timeout = delete($args{timeout}) || 120; my $resolver = delete($args{resolver}); my $bind_address = delete($args{bind_address}); my @unknown = sort keys %args; if (@unknown) { croak "new() doesn't accept: @unknown"; } my $alias = "POE::Component::Client::Keepalive::" . ++$current_id; my $self = bless [ { }, # SF_POOL [ ], # SF_QUEUE { }, # SF_USED { }, # SF_WHEELS { }, # SF_USED_EACH $max_open, # SF_MAX_OPEN $max_per_host, # SF_MAX_HOST { }, # SF_SOCKETS $keep_alive, # SF_KEEPALIVE $timeout, # SF_TIMEOUT undef, # SF_RESOLVER undef, # SF_SHUTDOWN undef, # SF_REQ_INDEX $bind_address, # SF_BIND_ADDR undef, # SF_ALIAS ], $class; $default_resolver = $resolver if ( $resolver and eval { $resolver->isa('POE::Component::Resolver') } ); $self->[SF_RESOLVER] = ( $default_resolver ||= POE::Component::Resolver->new() ); my $session = POE::Session->create( object_states => [ $self => { _start => "_ka_initialize", _stop => "_ka_stopped", ka_add_to_queue => "_ka_add_to_queue", ka_cancel_dns_response => "_ka_cancel_dns_response", ka_conn_failure => "_ka_conn_failure", ka_conn_success => "_ka_conn_success", ka_deallocate => "_ka_deallocate", ka_dns_response => "_ka_dns_response", ka_keepalive_timeout => "_ka_keepalive_timeout", ka_reclaim_socket => "_ka_reclaim_socket", ka_relinquish_socket => "_ka_relinquish_socket", ka_request_timeout => "_ka_request_timeout", ka_resolve_request => "_ka_resolve_request", ka_set_timeout => "_ka_set_timeout", ka_shutdown => "_ka_shutdown", ka_socket_activity => "_ka_socket_activity", ka_wake_up => "_ka_wake_up", }, ], ); $self->[SF_ALIAS] = ref($self) . "::" . $session->ID(); return $self; } # Initialize the hidden session behind this component. # Rendezvous with the object via a mutually agreed upon alias. sub _ka_initialize { my ($object, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; $instances++; $heap->{dns_requests} = { }; $kernel->alias_set(ref($object) . "::" . $_[SESSION]->ID()); } # When programs crash, the session may stop in a non-shutdown state. # _ka_stopped and DESTROY catch this either way the death occurs. sub _ka_stopped { $_[OBJECT][SF_SHUTDOWN] = 1; } sub DESTROY { $_[0]->shutdown(); } # Request to wake up. This should only happen during the edge # condition where the component's request queue goes from empty to # having one item. # # It also happens during free(), to see if there are more sockets to # deal with. # # TODO - Make the _ka_wake_up stuff smart enough not to post duplicate # messages to the queue. sub _ka_wake_up { my ($self, $kernel) = @_[OBJECT, KERNEL]; # Scan the list of requests, until we find one that can be met. # Fire off POE::Wheel::SocketFactory to begin the connection # process. my $request_index = 0; my $currently_open = keys(%{$self->[SF_USED]}) + keys(%{$self->[SF_SOCKETS]}); my @splice_list; QUEUED: foreach my $request (@{$self->[SF_QUEUE]}) { DEBUG and warn "WAKEUP: checking for $request->[RQ_CONN_KEY]"; # Sweep away inactive requests. unless ($request->[RQ_ACTIVE]) { push @splice_list, $request_index; next; } # Skip this request if its scheme/address/port triple is maxed # out. my $req_key = $request->[RQ_CONN_KEY]; next if ( ($self->[SF_USED_EACH]{$req_key} || 0) >= $self->[SF_MAX_HOST] ); # Honor the request from the free pool, if possible. The # currently open socket count does not increase. my $existing_connection = $self->_check_free_pool($req_key); if ($existing_connection) { push @splice_list, $request_index; _respond( $request, { connection => $existing_connection, from_cache => "deferred", } ); # Remove the wheel-to-request index. delete $self->[SF_REQ_INDEX]{$request->[RQ_ID]}; _free_req_id($request->[RQ_ID]); next; } # we can't easily take this out of the outer loop since _check_free_pool # can change it from under us my @free_sockets = keys(%{$self->[SF_SOCKETS]}); # Try to free over-committed (but unused) sockets until we're back # under SF_MAX_OPEN sockets. Bail out if we can't free enough. # TODO - Consider removing @free_sockets in least- to # most-recently used order. while ($currently_open >= $self->[SF_MAX_OPEN]) { last QUEUED unless @free_sockets; my $next_to_go = $free_sockets[rand(@free_sockets)]; $self->_remove_socket_from_pool($next_to_go); $currently_open--; } # Start the request. Create a wheel to begin the connection. # Move the wheel and its request into SF_WHEELS. DEBUG and warn "WAKEUP: creating wheel for $req_key"; my $addr = ($request->[RQ_IP] or $request->[RQ_ADDRESS]); my $wheel = POE::Wheel::SocketFactory->new( ( defined($self->[SF_BIND_ADDR]) ? (BindAddress => $self->[SF_BIND_ADDR]) : () ), RemoteAddress => $addr, RemotePort => $request->[RQ_PORT], SuccessEvent => "ka_conn_success", FailureEvent => "ka_conn_failure", SocketDomain => $request->[RQ_ADDR_FAM], ); $self->[SF_WHEELS]{$wheel->ID} = [ $wheel, # WHEEL_WHEEL $request, # WHEEL_REQUEST ]; # store the wheel's ID in the request object $request->[RQ_WHEEL_ID] = $wheel->ID; # Count it as used, so we don't over commit file handles. $currently_open++; $self->[SF_USED_EACH]{$req_key}++; # Temporarily store the SF_USED record under the wheel ID. It # will be moved to the socket when the wheel responds. $self->[SF_USED]{$wheel->ID} = [ undef, # USED_SOCKET time(), # USED_TIME $req_key, # USED_KEY ]; # Mark the request index as one to splice out. push @splice_list, $request_index; } continue { $request_index++; } # The @splice_list is a list of element indices that need to be # spliced out of the request queue. We scan in backwards, from # highest index to lowest, so that each splice does not affect the # indices of the other. # # This removes the request from the queue. It's vastly important # that the request be entered into SF_WHEELS before now. my $splice_index = @splice_list; while ($splice_index--) { splice @{$self->[SF_QUEUE]}, $splice_list[$splice_index], 1; } } sub allocate { my $self = shift; croak "allocate() needs an even number of parameters" if @_ % 2; my %args = @_; # TODO - Validate arguments. my $scheme = delete $args{scheme}; croak "allocate() needs a 'scheme'" unless $scheme; my $address = delete $args{addr}; croak "allocate() needs an 'addr'" unless $address; my $port = delete $args{port}; croak "allocate() needs a 'port'" unless $port; my $event = delete $args{event}; croak "allocate() needs an 'event'" unless $event; my $context = delete $args{context}; croak "allocate() needs a 'context'" unless $context; my $timeout = delete $args{timeout}; $timeout = $self->[SF_TIMEOUT] unless $timeout; my $for_scheme = delete($args{for_scheme}) || $scheme; my $for_address = delete($args{for_addr}) || $address; my $for_port = delete($args{for_port}) || $port; croak "allocate() on shut-down connection manager" if $self->[SF_SHUTDOWN]; my @unknown = sort keys %args; if (@unknown) { croak "allocate() doesn't accept: @unknown"; } my $conn_key = ( "$scheme $address $port for $for_scheme $for_address $for_port" ); # If we have a connection pool for the scheme/address/port triple, # then we can maybe post an available connection right away. my $existing_connection = $self->_check_free_pool($conn_key); if (defined $existing_connection) { $poe_kernel->post( $poe_kernel->get_active_session, $event => { addr => $address, context => $context, port => $port, scheme => $scheme, connection => $existing_connection, from_cache => "immediate", } ); return; } # We can't honor the request immediately, so it's put into a queue. DEBUG and warn "ALLOCATE: enqueuing request for $conn_key"; my $request = [ $poe_kernel->get_active_session(), # RQ_SESSION $event, # RQ_EVENT $scheme, # RQ_SCHEME $address, # RQ_ADDRESS undef, # RQ_IP $port, # RQ_PORT $conn_key, # RQ_CONN_KEY $context, # RQ_CONTEXT $timeout, # RQ_TIMEOUT time(), # RQ_START undef, # RQ_TIMER_ID undef, # RQ_WHEEL_ID 1, # RQ_ACTIVE _allocate_req_id(), # RQ_ID undef, # RQ_ADDR_FAM $for_scheme, # RQ_FOR_SCHEME $for_address, # RQ_FOR_ADDRESS $for_port, # RQ_FOR_PORT undef, # RQ_RESOLVER_ID ]; $self->[SF_REQ_INDEX]{$request->[RQ_ID]} = $request; $poe_kernel->refcount_increment( $request->[RQ_SESSION]->ID(), "poco-client-keepalive" ); $poe_kernel->call($self->[SF_ALIAS], ka_set_timeout => $request); $poe_kernel->call($self->[SF_ALIAS], ka_resolve_request => $request); return $request->[RQ_ID]; } sub deallocate { my ($self, $req_id) = @_; croak "deallocate() requires a request ID" unless( defined($req_id) and exists($active_req_ids{$req_id}) ); my $request = delete $self->[SF_REQ_INDEX]{$req_id}; unless (defined $request) { DEBUG_DEALLOCATE and warn "deallocate could not find request $req_id"; return; } _free_req_id($request->[RQ_ID]); # Now pass the vetted request & its ID into our manager session. $poe_kernel->call($self->[SF_ALIAS], "ka_deallocate", $request, $req_id); } sub _ka_deallocate { my ($self, $heap, $request, $req_id) = @_[OBJECT, HEAP, ARG0, ARG1]; my $conn_key = $request->[RQ_CONN_KEY]; my $existing_connection = $self->_check_free_pool($conn_key); # Existing connection. Remove it from the pool, and delete the socket. if (defined $existing_connection) { $self->_remove_socket_from_pool($existing_connection->{socket}); DEBUG_DEALLOCATE and warn( "deallocate called, deleted already-connected socket" ); return; } # No connection yet. Cancel the request. DEBUG_DEALLOCATE and warn( "deallocate called without an existing connection. ", "cancelling connection request" ); unless (exists $heap->{dns_requests}{$request->[RQ_ADDRESS]}) { DEBUG_DEALLOCATE and warn( "deallocate cannot cancel dns -- no pending request" ); return; } $poe_kernel->call( $self->[SF_ALIAS], ka_cancel_dns_response => $request ); return; } sub _ka_cancel_dns_response { my ($self, $kernel, $heap, $request) = @_[OBJECT, KERNEL, HEAP, ARG0]; my $address = $request->[RQ_ADDRESS]; DEBUG_DNS and warn "DNS: canceling request for $address\n"; my $requests = $heap->{dns_requests}{$address}; # Remove the resolver request for the address of this connection # request my $req_index = @$requests; while ($req_index--) { next unless $requests->[$req_index] == $request; splice(@$requests, $req_index, 1); last; } # Clean up the structure for the address if there are no more # requests to resolve that address. unless (@$requests) { DEBUG_DNS and warn "DNS: canceled all requests for $address"; $self->[SF_RESOLVER]->cancel( $request->[RQ_RESOLVER_ID] ); delete $heap->{dns_requests}{$address}; } # cancel our attempt to connect $poe_kernel->alarm_remove( $request->[RQ_TIMER_ID] ); $poe_kernel->refcount_decrement( $request->[RQ_SESSION]->ID(), "poco-client-keepalive" ); } # Set the request's timeout, in the component's context. sub _ka_set_timeout { my ($kernel, $request) = @_[KERNEL, ARG0]; $request->[RQ_TIMER_ID] = $kernel->delay_set( ka_request_timeout => $request->[RQ_TIMEOUT], $request ); } # The request has timed out. Mark it as defunct, and respond with an # ETIMEDOUT error. sub _ka_request_timeout { my ($self, $kernel, $request) = @_[OBJECT, KERNEL, ARG0]; DEBUG and warn( "CON: request from session ", $request->[RQ_SESSION]->ID, " for address ", $request->[RQ_ADDRESS], " timed out" ); $! = ETIMEDOUT; # The easiest way to do this? Simulate an error from the wheel # itself. if (defined $request->[RQ_WHEEL_ID]) { @_[ARG0..ARG3] = ("connect", $!+0, "$!", $request->[RQ_WHEEL_ID]); goto &_ka_conn_failure; } my ($errnum, $errstr) = ($!+0, "$!"); # No wheel yet. It must have timed out in connect. if ($request->[RQ_RESOLVER_ID]) { $self->[SF_RESOLVER]->cancel( $request->[RQ_RESOLVER_ID] ); $request->[RQ_RESOLVER_ID] = undef; } # But what if there is no wheel? _respond_with_error($request, "connect", $errnum, $errstr), } # Connection failed. Remove the SF_WHEELS record corresponding to the # request. Remove the SF_USED placeholder record so it won't count # anymore. Send a failure notice to the requester. sub _ka_conn_failure { my ($self, $func, $errnum, $errstr, $wheel_id) = @_[OBJECT, ARG0..ARG3]; DEBUG and warn "CON: sending $errstr for function $func"; # Remove the SF_WHEELS record. my $wheel_rec = delete $self->[SF_WHEELS]{$wheel_id}; my $request = $wheel_rec->[WHEEL_REQUEST]; # Remove the SF_USED placeholder. delete $self->[SF_USED]{$wheel_id}; # remove the wheel-to-request index delete $self->[SF_REQ_INDEX]{$request->[RQ_ID]}; _free_req_id($request->[RQ_ID]); # Discount the use by request key, removing the SF_USED record # entirely if it's now moot. my $request_key = $request->[RQ_CONN_KEY]; $self->_decrement_used_each($request_key); # Tell the requester about the failure. _respond_with_error($request, $func, $errnum, $errstr), $self->_ka_wake_up($_[KERNEL]); } # Connection succeeded. Remove the SF_WHEELS record corresponding to # the request. Flesh out the placeholder SF_USED record so it counts. sub _ka_conn_success { my ($self, $socket, $wheel_id) = @_[OBJECT, ARG0, ARG3]; # Remove the SF_WHEELS record. my $wheel_rec = delete $self->[SF_WHEELS]{$wheel_id}; my $request = $wheel_rec->[WHEEL_REQUEST]; # remove the wheel-to-request index delete $self->[SF_REQ_INDEX]{$request->[RQ_ID]}; _free_req_id($request->[RQ_ID]); # Remove the SF_USED placeholder, add in the socket, and store it # properly. my $used = delete $self->[SF_USED]{$wheel_id}; unless ($request->[RQ_SCHEME] eq 'https') { $self->_store_socket($used, $socket); $self->_send_back_socket($request, $socket); return; } # HTTPS here. # Really applies to all SSL schemes. unless ($ssl_available) { die "There is no SSL support, please install POE::Component::SSLify"; } eval { $socket = POE::Component::SSLify::Client_SSLify( $socket, # TODO - To make non-blocking sslify work, I need to somehow # defer the response until the following callback says it's # fine. Or if the callback says there's an error, it needs to # be propagated out. # # Problem is, just setting the callback doesn't seem to get the # connection to complete (successfully or otherwise). There # needs to be something more going on... but what? # sub { # my ($socket, $status, $errval) = @_; # $errval = 'undef' unless defined $errval; # # warn "socket($socket) status($status) errval($errval)"; # # # Connected okay. # if ($status == 1) { # $self->_send_back_socket($request, $socket); # $self = $request = undef; # return; # } # # # Didn't connect okay, or hasn't so far. # # Report the error. # if ($errval == 1) { # # # Get all known errors, but only retain the most recent one. # # I'm not sure this is needed, but the API mentions an error # # queue, which implies that it could contain stale errors. # # my $errnum; # while (my $new_errnum = Net::SSLeay::ERR_get_error()) { # $errnum = $new_errnum; # } # # my $errstr = Net::SSLeay::ERR_error_string($errnum); # warn " ssl_error($errnum) string($errstr)"; # _respond_with_error($request, "sslify", undef, $errstr); # # # TODO - May the circle be broken. # $self = $request = undef; # return; # } # } ); }; if ($@) { _respond_with_error($request, "sslify", undef, "$@"); return; } # TODO - I think for SSL we just need to _store_socket(). The call # to _send_back_socket() should be inside the SSL callback. # # Also, I think the callback might leak. $request and $self may # need to be weakened. $self->_store_socket($used, $socket); $self->_send_back_socket($request, $socket); } sub _store_socket { my ($self, $used, $socket) = @_; $used->[USED_SOCKET] = $socket; $self->[SF_USED]{$socket} = $used; } sub _send_back_socket { my ($self, $request, $socket) = @_; DEBUG and warn( "CON: posting... to $request->[RQ_SESSION] . $request->[RQ_EVENT]" ); # Build a connection object around the socket. my $connection = POE::Component::Connection::Keepalive->new( socket => $socket, manager => $self, ); # Give the socket to the requester. _respond( $request, { connection => $connection, } ); } # The user is done with a socket. Make it available for reuse. sub free { my ($self, $socket) = @_; return if $self->[SF_SHUTDOWN]; DEBUG and warn "FREE: freeing socket"; # Remove the accompanying SF_USED record. croak "can't free() undefined socket" unless defined $socket; my $used = delete $self->[SF_USED]{$socket}; croak "can't free() unallocated socket" unless defined $used; # Reclaim the socket. $poe_kernel->call($self->[SF_ALIAS], "ka_reclaim_socket", $used); # Avoid returning things by mistake. return; } # A sink for deliberately unhandled events. sub _ka_ignore_this_event { # Do nothing. } # An internal method to fetch a socket from the free pool, if one # exists. sub _check_free_pool { my ($self, $conn_key) = @_; return unless exists $self->[SF_POOL]{$conn_key}; my $free = $self->[SF_POOL]{$conn_key}; DEBUG and warn "CHECK: reusing $conn_key"; my $next_socket = (values %$free)[0]; delete $free->{$next_socket}; unless (keys %$free) { delete $self->[SF_POOL]{$conn_key}; } # _check_free_pool() may be operating in another session, so we call # the correct one here. $poe_kernel->call($self->[SF_ALIAS], "ka_relinquish_socket", $next_socket); $self->[SF_USED]{$next_socket} = [ $next_socket, # USED_SOCKET time(), # USED_TIME $conn_key, # USED_KEY ]; delete $self->[SF_SOCKETS]{$next_socket}; $self->[SF_USED_EACH]{$conn_key}++; # Build a connection object around the socket. my $connection = POE::Component::Connection::Keepalive->new( socket => $next_socket, manager => $self, ); return $connection; } sub _decrement_used_each { my ($self, $request_key) = @_; unless (--$self->[SF_USED_EACH]{$request_key}) { delete $self->[SF_USED_EACH]{$request_key}; } } # Reclaim a socket. Put it in the free socket pool, and wrap it with # select_read() to discard any data and detect when it's closed. sub _ka_reclaim_socket { my ($self, $kernel, $used) = @_[OBJECT, KERNEL, ARG0]; my $socket = $used->[USED_SOCKET]; # Decrement the usage counter for the given connection key. my $request_key = $used->[USED_KEY]; $self->_decrement_used_each($request_key); # Socket is closed. We can't reuse it. unless (defined fileno $socket) { DEBUG and warn "RECLAIM: freed socket has previously been closed"; goto &_ka_wake_up; } # Socket is still open. Check for lingering data. DEBUG and warn "RECLAIM: checking if socket still works"; # Check for data on the socket, which implies that the server # doesn't know we're done. That leads to desynchroniziation on the # protocol level, which strongly implies that we can't reuse the # socket. In this case, we'll make a quick attempt at fetching all # the data, then close the socket. my $rin = ''; vec($rin, fileno($socket), 1) = 1; my ($rout, $eout); my $socket_is_active = select ($rout=$rin, undef, $eout=$rin, 0); if ($socket_is_active) { DEBUG and warn "RECLAIM: socket is still active; trying to drain"; use bytes; my $socket_had_data = sysread($socket, my $buf = "", 65536) || 0; DEBUG and warn "RECLAIM: socket had $socket_had_data bytes. 0 means EOF"; DEBUG and warn "RECLAIM: Giving up on socket."; # Avoid common FIN_WAIT_2 issues, but only for valid sockets. #if ($socket_had_data and fileno($socket)) { if ($socket_had_data) { my $opt_result = setsockopt( $socket, SOL_SOCKET, SO_LINGER, pack("sll",1,0,0) ); die "setsockopt: " . ($!+0) . " $!" if (not $opt_result and $! != EBADF); } goto &_ka_wake_up; } # Socket is alive and has no data, so it's in a quiet, theoretically # reclaimable state. DEBUG and warn "RECLAIM: reclaiming socket"; # Watch the socket, and set a keep-alive timeout. $kernel->select_read($socket, "ka_socket_activity"); my $timer_id = $kernel->delay_set( ka_keepalive_timeout => $self->[SF_KEEPALIVE], $socket ); # Record the socket as free to be used. $self->[SF_POOL]{$request_key}{$socket} = $socket; $self->[SF_SOCKETS]{$socket} = [ $request_key, # SK_KEY $timer_id, # SK_TIMER ]; goto &_ka_wake_up; } # Socket timed out. Discard it. sub _ka_keepalive_timeout { my ($self, $socket) = @_[OBJECT, ARG0]; $self->_remove_socket_from_pool($socket); } # Relinquish a socket. Stop selecting on it. sub _ka_relinquish_socket { my ($kernel, $socket) = @_[KERNEL, ARG0]; $kernel->alarm_remove($_[OBJECT][SF_SOCKETS]{$socket}[SK_TIMER]); $kernel->select_read($socket, undef); } # Shut down the component. Release any sockets we're currently # holding onto. Clean up any timers. Remove the alias it's known by. sub shutdown { my $self = shift; return if $self->[SF_SHUTDOWN]; $poe_kernel->call($self->[SF_ALIAS], "ka_shutdown"); } sub _ka_shutdown { my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; return if $self->[SF_SHUTDOWN]; $instances--; # Clean out the request queue. foreach my $request (@{$self->[SF_QUEUE]}) { $self->_shutdown_request($kernel, $request); } $self->[SF_QUEUE] = [ ]; # Clean out the socket pool. foreach my $sockets (values %{$self->[SF_POOL]}) { foreach my $socket (values %$sockets) { $kernel->alarm_remove($self->[SF_SOCKETS]{$socket}[SK_TIMER]); $kernel->select_read($socket, undef); } } # Stop any pending resolver requests. foreach my $host (keys %{$heap->{dns_requests}}) { DEBUG and warn "SHT: Shutting down resolver requests for $host"; foreach my $request (@{$heap->{dns_requests}{$host}}) { $self->_shutdown_request($kernel, $request); } # Technically not needed since the resolver shutdown should do it. # They all share the same host, so canceling the first should get # them all. $self->[SF_RESOLVER]->cancel( $heap->{dns_requests}{$host}[0][RQ_RESOLVER_ID] ); } $heap->{dns_requests} = { }; # Shut down the resolver. DEBUG and warn "SHT: Shutting down resolver"; if ( $self->[SF_RESOLVER] != $default_resolver ) { $self->[SF_RESOLVER]->shutdown(); } $self->[SF_RESOLVER] = undef; if ( $default_resolver and !$instances ) { $default_resolver->shutdown(); $default_resolver = undef; } # Finish keepalive's shutdown. $kernel->alias_remove($self->[SF_ALIAS]); $self->[SF_SHUTDOWN] = 1; return; } sub _shutdown_request { my ($self, $kernel, $request) = @_; if (defined $request->[RQ_TIMER_ID]) { DEBUG and warn "SHT: Shutting down resolver timer $request->[RQ_TIMER_ID]"; $kernel->alarm_remove($request->[RQ_TIMER_ID]); } if (defined $request->[RQ_WHEEL_ID]) { DEBUG and warn "SHT: Shutting down resolver wheel $request->[RQ_TIMER_ID]"; delete $self->[SF_WHEELS]{$request->[RQ_WHEEL_ID]}; # remove the wheel-to-request index delete $self->[SF_REQ_INDEX]{$request->[RQ_ID]}; _free_req_id($request->[RQ_ID]); } if (defined $request->[RQ_SESSION]) { my $session_id = $request->[RQ_SESSION]->ID; DEBUG and warn "SHT: Releasing session $session_id"; $kernel->refcount_decrement($session_id, "poco-client-keepalive"); } } # A socket in the free pool has activity. Read from it and discard # the output. Discard the socket on error or remote closure. sub _ka_socket_activity { my ($self, $kernel, $socket) = @_[OBJECT, KERNEL, ARG0]; if (DEBUG) { my $socket_rec = $self->[SF_SOCKETS]{$socket}; my $key = $socket_rec->[SK_KEY]; warn "CON: Got activity on socket for $key"; } # Any socket activity on a kept-alive socket implies that the socket # is no longer reusable. use bytes; my $socket_had_data = sysread($socket, my $buf = "", 65536) || 0; DEBUG and warn "CON: socket had $socket_had_data bytes. 0 means EOF"; DEBUG and warn "CON: Removing socket from the pool"; $self->_remove_socket_from_pool($socket); } sub _ka_resolve_request { my ($self, $kernel, $heap, $request) = @_[OBJECT, KERNEL, HEAP, ARG0]; my $host = $request->[RQ_ADDRESS]; # Skip DNS resolution if it's already a dotted quad. # ip_is_ipv4() doesn't require quads, so we count the dots. # # TODO - Do the same for IPv6 addresses containing colons? # TODO - Would require AF_INET6 support around the SocketFactory. if ((($host =~ tr[.][.]) == 3) and ip_is_ipv4($host)) { DEBUG_DNS and warn "DNS: $host is a dotted quad; skipping lookup"; $kernel->call($self->[SF_ALIAS], ka_add_to_queue => $request); return; } # It's already pending DNS resolution. Combine this with previous. if (exists $heap->{dns_requests}{$host}) { DEBUG_DNS and warn "DNS: $host is piggybacking on a pending lookup.\n"; # All requests for the same host share the same resolver ID. # TODO - Although it should probably be keyed on host:port. $request->[RQ_RESOLVER_ID] = $heap->{dns_requests}{$host}[0][RQ_RESOLVER_ID]; push @{$heap->{dns_requests}{$host}}, $request; return; } # New request. Start lookup. $heap->{dns_requests}{$host} = [ $request ]; $request->[RQ_RESOLVER_ID] = $self->[SF_RESOLVER]->resolve( event => 'ka_dns_response', host => $host, service => $request->[RQ_PORT], hints => { protocol => TCP_PROTO }, ); DEBUG_DNS and warn "DNS: looking up $host in the background.\n"; } sub _ka_dns_response { my ($self, $kernel, $heap, $response_error, $addresses, $request) = @_[ OBJECT, KERNEL, HEAP, ARG0..ARG2 ]; # We've shut down. Nothing to do here. return if $self->[SF_SHUTDOWN]; my $request_address = $request->{host}; my $requests = delete $heap->{dns_requests}{$request_address}; DEBUG_DNS and warn "DNS: got response for request address $request_address"; # Requests on record. if (defined $requests) { # We can receive responses for canceled requests. Ignore them: we # cannot cancel PoCo::Client::DNS requests, so this is how we reap # them when they're canceled. if ($requests eq 'cancelled') { DEBUG_DNS and warn "DNS: reaping cancelled request for $request_address"; return; } unless (ref $requests eq 'ARRAY') { die "DNS: got an unknown requests for $request_address: $requests"; } } else { die "DNS: Unexpectedly undefined requests for $request_address"; } # This is an error. Cancel all requests for the address. # Tell everybody that their requests failed. if ($response_error) { DEBUG_DNS and warn "DNS: resolver error = $response_error"; foreach my $request (@$requests) { _respond_with_error($request, "resolve", undef, $response_error), } return; } DEBUG_DNS and warn "DNS: got a response"; # A response! foreach my $address_rec (@$addresses) { my $numeric = $self->[SF_RESOLVER]->unpack_addr($address_rec); DEBUG_DNS and warn "DNS: $request_address resolves to $numeric"; foreach my $request (@$requests) { # Don't bother continuing inactive requests. next unless $request->[RQ_ACTIVE]; $request->[RQ_IP] = $numeric; $request->[RQ_ADDR_FAM] = $address_rec->{family}; $kernel->yield(ka_add_to_queue => $request); } # Return after the first good answer. return; } # Didn't return here. No address record for the host? foreach my $request (@$requests) { DEBUG_DNS and warn "DNS: $request_address does not resolve"; _respond_with_error($request, "resolve", undef, "Host has no address."), } } sub _ka_add_to_queue { my ($self, $kernel, $request) = @_[OBJECT, KERNEL, ARG0]; push @{ $self->[SF_QUEUE] }, $request; # If the queue has more than one request in it, then it already has # a wakeup event pending. We don't need to send another one. return if @{$self->[SF_QUEUE]} > 1; # If the component's allocated socket count is maxed out, then it # will check the queue when an existing socket is released. We # don't need to wake it up here. return if keys(%{$self->[SF_USED]}) >= $self->[SF_MAX_OPEN]; # Likewise, we shouldn't awaken the session if there are no # available slots for the given scheme/address/port triple. "|| 0" # to avoid an undef error. my $conn_key = $request->[RQ_CONN_KEY]; return if ( ($self->[SF_USED_EACH]{$conn_key} || 0) >= $self->[SF_MAX_HOST] ); # Wake the session up, and return nothing, signifying sound and fury # yet to come. DEBUG and warn "posting wakeup for $conn_key"; $poe_kernel->post($self->[SF_ALIAS], "ka_wake_up"); return; } # Remove a socket from the free pool, by the socket handle itself. sub _remove_socket_from_pool { my ($self, $socket) = @_; my $socket_rec = delete $self->[SF_SOCKETS]{$socket}; my $key = $socket_rec->[SK_KEY]; # Get the blessed version. DEBUG and warn "removing socket for $key"; $socket = delete $self->[SF_POOL]{$key}{$socket}; unless (keys %{$self->[SF_POOL]{$key}}) { delete $self->[SF_POOL]{$key}; } $poe_kernel->alarm_remove($socket_rec->[SK_TIMER]); $poe_kernel->select_read($socket, undef); # Avoid common FIN_WAIT_2 issues. # Commented out because fileno() will return true for closed # sockets, which makes setsockopt() highly unhappy. Also, SO_LINGER # will cause te socket closure to block, which is less than ideal. # We need to revisit this another way, or just let sockets enter # FIN_WAIT_2. # if (fileno $socket) { # setsockopt($socket, SOL_SOCKET, SO_LINGER, pack("sll",1,0,0)) or die( # "setsockopt: $!" # ); # } } # Internal function. NOT AN EVENT HANDLER. sub _respond_with_error { my ($request, $func, $num, $string) = @_; _respond( $request, { connection => undef, function => $func, error_num => $num, error_str => $string, } ); } sub _respond { my ($request, $fields) = @_; # Bail out early if the request isn't active. return unless $request->[RQ_ACTIVE] and $request->[RQ_SESSION]; $poe_kernel->post( $request->[RQ_SESSION], $request->[RQ_EVENT], { addr => $request->[RQ_ADDRESS], context => $request->[RQ_CONTEXT], port => $request->[RQ_PORT], scheme => $request->[RQ_SCHEME], for_addr => $request->[RQ_FOR_ADDRESS], for_scheme => $request->[RQ_FOR_SCHEME], for_port => $request->[RQ_FOR_PORT], %$fields, } ); # Drop the extra refcount. $poe_kernel->refcount_decrement( $request->[RQ_SESSION]->ID(), "poco-client-keepalive" ); # Remove associated timer. if ($request->[RQ_TIMER_ID]) { $poe_kernel->alarm_remove($request->[RQ_TIMER_ID]); $request->[RQ_TIMER_ID] = undef; } # Deactivate the request. $request->[RQ_ACTIVE] = undef; } 1; __END__ =head1 NAME POE::Component::Client::Keepalive - manage connections, with keep-alive =head1 VERSION version 0.272 =head1 SYNOPSIS use warnings; use strict; use POE; use POE::Component::Client::Keepalive; POE::Session->create( inline_states => { _start => \&start, got_conn => \&got_conn, got_error => \&handle_error, got_input => \&handle_input, } ); POE::Kernel->run(); exit; sub start { $_[HEAP]{ka} = POE::Component::Client::Keepalive->new(); $_[HEAP]{ka}->allocate( scheme => "http", addr => "127.0.0.1", port => 9999, event => "got_conn", context => "arbitrary data (even a reference) here", timeout => 60, ); print "Connection is in progress.\n"; } sub got_conn { my ($kernel, $heap, $response) = @_[KERNEL, HEAP, ARG0]; my $conn = $response->{connection}; my $context = $response->{context}; if (defined $conn) { if ($response->{from_cache}) { print "Connection was established immediately.\n"; } else { print "Connection was established asynchronously.\n"; } $conn->start( InputEvent => "got_input", ErrorEvent => "got_error", ); return; } print( "Connection could not be established: ", "$response->{function} error $response->{error_num}: ", "$response->{error_str}\n" ); } sub handle_input { my $input = $_[ARG0]; print "$input\n"; } sub handle_error { my $heap = $_[HEAP]; delete $heap->{connection}; $heap->{ka}->shutdown(); } =head1 DESCRIPTION POE::Component::Client::Keepalive creates and manages connections for other components. It maintains a cache of kept-alive connections for quick reuse. It is written specifically for clients that can benefit from kept-alive connections, such as HTTP clients. Using it for one-shot connections would probably be silly. =over 2 =item new Creates a new keepalive connection manager. A program may contain several connection managers. Each will operate independently of the others. None will know about the limits set in the others, so it's possible to overrun your file descriptors for a process if you're not careful. new() takes up to five parameters. All of them are optional. To limit the number of simultaneous connections to a particular host (defined by a combination of scheme, address and port): max_per_host => $max_simultaneous_host_connections, # defaults to 4 To limit the overall number of connections that may be open at once, use max_open => $maximum_open_connections, # defaults to 128 Programs are required to give connections back to the manager when they are done. See the free() method for how that works. The connection manager will keep connections alive for a period of time before recycling them. The maximum keep-alive time may be set with keep_alive => $seconds_to_keep_free_conns_alive, # defaults to 15 Programs may not want to wait a long time for a connection to be established. They can set the request timeout to alter how long the component holds a request before generating an error. timeout => $seconds_to_process_a_request, # defaults to 120 Specify a bind_address to bind all client sockets to a particular local address. The value of bind_address will be passed directly to POE::Wheel::SocketFactory. See that module's documentation for implementation details. =item allocate Allocate a new connection. Allocate() will return a request ID immediately. The allocated connection, however, will be posted back to the requesting session. This happens even if the connection was found in the component's keep-alive cache. It's a bit slower, but the use cases are cleaner that way. Allocate() requires five parameters and has an optional sixth. Specify the scheme that will be used to communicate on the connection (typically http or https). The scheme is required, but you're free to make something up here. It's used internally to differentiate different types of socket (e.g., ssl vs. cleartext) on the same address and port. scheme => $connection_scheme, Request a connection to a particular address and port. The address and port must be numeric. Both the address and port are required. address => $remote_address, port => $remote_port, Specify an name of the event to post when an asynchronous response is ready. This is of course required. event => $return_event, Set the connection timeout, in seconds. The connection manager will post back an error message if it can't establish a connection within the requested time. This parameter is optional. It will default to the master timeout provided to the connection manager's constructor. timeout => $connect_timeout, Specify additional contextual data. The context defines the connection's purpose. It is used to maintain continuity between a call to allocate() and an asynchronous response. A context is extremely handy, but it's optional. context => $context_data, In summary: $mgr->allocate( scheme => "http", address => "127.0.0.1", port => 80, event => "got_a_connection", context => \%connection_context, ); The response event ("got_a_connection" in this example) contains several fields, passed as a list of key/value pairs. The list may be assigned to a hash for convenience: sub got_a_connection { my %response = @_[ARG0..$#_]; ...; } Four of the fields exist to echo back your data: $response{address} = $your_request_address; $response{context} = $your_request_context; $response{port} = $your_request_port; $response{scheme} = $your_request_scheme; One field returns the connection object if the connection was successful, or undef if there was a failure: $response{connection} = $new_socket_handle; On success, another field tells you whether the connection contains all new materials. That is, whether the connection has been recycled from the component's cache or created anew. $response{from_cache} = $status; The from_cache status may be "immediate" if the connection was immediately available from the cache. It will be "deferred" if the connection was reused, but another user had to release it first. Finally, from_cache will be false if the connection had to be created to satisfy allocate(). Three other fields return error information if the connection failed. They are not present if the connection was successful. $response{function} = $name_of_failing_function; $response{error_num} = $! as a number; $response{error_str} = $! as a string; =item free Free() notifies the connection manager when connections are free to be reused. Freed connections are entered into the keep-alive pool and may be returned by subsequent allocate() calls. $mgr->free($socket); For now free() is called with a socket, not a connection object. This is usually not a problem since POE::Component::Connection::Keepalive objects call free() for you when they are destroyed. Not calling free() will cause a program to leak connections. This is also not generally a problem, since free() is called automatically whenever connection objects are destroyed. =item deallocate Cancel a connection that has not yet been established. Requires one parameter, the request ID returned by allocate(). =item shutdown The keep-alive pool requires connections to be active internally. This may keep a program active even when all connections are idle. The shutdown() method forces the connection manager to clear its keep-alive pool, allowing a program to terminate gracefully. $mgr->shutdown(); =back =head1 SEE ALSO L L =head1 LICENSE This distribution is copyright 2004-2009 by Rocco Caputo. All rights are reserved. This distribution is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Rocco Caputo =head1 CONTRIBUTORS Rob Bloodgood helped out a lot. Thank you. Joel Bernstein solved some nasty race conditions. Portugal Telecom L was kind enough to support his contributions. =head1 BUG TRACKER https://rt.cpan.org/Dist/Display.html?Queue=POE-Component-Client-Keepalive =head1 REPOSITORY http://gitorious.org/poe-component-client-keepalive http://github.com/rcaputo/poe-component-client-keepalive =head1 OTHER RESOURCES http://search.cpan.org/dist/POE-Component-Client-Keepalive/ =cut Connection000755000765000024 012357030152 23632 5ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/lib/POE/ComponentKeepalive.pm100644000765000024 1225712357030152 26264 0ustar00trocstaff000000000000POE-Component-Client-Keepalive-0.272/lib/POE/Component/Connection# This is a proxy object for a socket. Its most important feature is # that it passes the socket back to POE::Component::Client::Keepalive # when it's destroyed. package POE::Component::Connection::Keepalive; $POE::Component::Connection::Keepalive::VERSION = '0.272'; use warnings; use strict; use Carp qw(croak); use POE::Wheel::ReadWrite; use constant DEBUG => 0; use constant CK_SOCKET => 0; # The socket we're hiding. use constant CK_MANAGER => 1; # The connection manager that owns the socket. use constant CK_WHEEL => 2; # The wheel we're hiding. # Assimilate a socket on construction, and the keep-alive connection # so that free() may be called at destruction time. sub new { my ($class, %args) = @_; my $self = bless [ $args{socket}, # CK_SOCKET $args{manager}, # CK_MANAGER undef, # CK_WHEEL ], $class; return $self; } # Free the socket on destruction. sub DESTROY { my $self = shift; $self->[CK_WHEEL] = undef; $self->[CK_MANAGER] and $self->[CK_MANAGER]->free($self->[CK_SOCKET]); } # Start a Read/Write wheel on the hidden socket. sub start { my $self = shift; croak "Must call start() with an even number of parameters" if @_ % 2; my %args = @_; # Override the read/write handle with our own. $args{Handle} = $self->[CK_SOCKET]; $self->[CK_WHEEL] = POE::Wheel::ReadWrite->new(%args); } # Wheel accessor, for modifying the wheel directly. sub wheel { my $self = shift; return $self->[CK_WHEEL]; } # For getting rid of the connection prematurely sub close { my $self = shift; DEBUG and warn "closing $self ($self->[CK_WHEEL]) ($self->[CK_SOCKET])"; if (defined $self->wheel) { $self->wheel->shutdown_input(); $self->wheel->shutdown_output(); $self->[CK_WHEEL] = undef; } DEBUG and warn "about to close potentially tied socket/ tied = ", ( tied(*{$self->[CK_SOCKET]}) || 'no' ); close $self->[CK_SOCKET]; my $is_tied = defined tied(*{$self->[CK_SOCKET]}); # this is necessary so defined fileno() does the right thing # on SSLified sockets if ($is_tied) { DEBUG and warn "about to untie"; untie(*{$self->[CK_SOCKET]}); } if (DEBUG) { if (defined(fileno($self->[CK_SOCKET]))) { warn "*** BUG: fileno still defined: " . fileno($self->[CK_SOCKET]); } } } 1; __END__ =head1 NAME POE::Component::Connection::Keepalive - a wheel wrapper around a kept-alive socket =head1 VERSION version 0.272 =head1 SYNOPSIS See the SYNOPSIS for POE::Component::Client::Keepalive for a complete working example. my $connection = $response->{connection}; $heap->{connection} = $connection; $connection->start( InputEvent => "got_input" ); delete $heap->{connection}; # When done with it. =head1 DESCRIPTION POE::Component::Connection::Keepalive is a helper class for POE::Component::Client::Keepalive. It wraps managed sockets, providing a few extra features. Connection objects free their underlying sockets when they are DESTROYed. This eliminates the need to explicitly free sockets when you are done with them. Connection objects manage POE::Wheel::ReadWrite objects internally, saving a bit of effort. =over 2 =item new Creates a new POE::Component::Connection::Keepalive instance. It accepts two parameters: A socket handle (socket) and a reference to a POE::Component::Client::Keepalive object to manage the socket when the connection is destroyed. my $conn = POE::Component::Connection::Keepalive->new( socket => $socket_handle, manager => $poe_component_client_keepalive, ); new() is usually called by a POE::Component::Client::Keepalive object. =item start Starts a POE::Wheel::ReadWrite object. All parameters except Handle for start() are passed directly to POE::Wheel::ReadWrite's constructor. Handle is provided by the connection object. start() returns a reference to the new POE::Wheel::ReadWrite object, but it is not necessary to save a copy of that wheel. The connection object keeps a copy of the reference internally, so the wheel will persist as long as the connection does. The POE::Wheel::ReadWrite object will be DESTROYed when the connection object is. # Asynchronous connection from Client::Keepalive. sub handle_connection { my $connection_info = $_[ARG0]; $_[HEAP]->{connection} = $connection_info->{connection}; $heap->{connection}->start( InputEvent => "got_input", ErrorEvent => "got_error", ); } # Stop the connection (and the wheel) when an error occurs. sub handle_error { delete $_[HEAP]->{connection}; } =item wheel Returns a reference to the internal POE::Wheel::ReadWrite object, so that methods may be called upon it. $heap->{connection}->wheel()->pause_input(); =item close Closes the connection immediately. Calls shutdown_input() and shutdown_output() on the wheel also. =back =head1 SEE ALSO L L L =head1 BUGS None known. =head1 LICENSE This distribution is copyright 2004-2009 by Rocco Caputo. All rights are reserved. This distribution is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Rocco Caputo Special thanks to Rob Bloodgood. =cut