POE-Component-Client-HTTP-0.948/000755 000765 000024 00000000000 12141763331 016225 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/CHANGES000644 000765 000024 00000005554 12141763331 017231 0ustar00trocstaff000000 000000 ================================================== Changes from 2012-05-06 00:00:00 +0000 to present. ================================================== ------------------------------------------ version 0.948 at 2013-05-06 17:22:31 +0000 ------------------------------------------ Change: c60d4d55461318cf20937748bae218db00f53418 Author: Rocco Caputo Date : 2013-05-06 13:17:29 +0000 Return a "400 Bad Request" error if we're redirected to a URI with a bad scheme. Sean Brunnock reported the issue when a link redirected his program to . This triggered an internal confess() we had put there to trap a strange case we couldn't reproduce. His test case and patch were instrumental in helping me resolve this on a deeper level. Change: ced552540af225632756d5696aafee17e0876cf8 Author: Theron Stanford Date : 2013-01-13 15:19:55 +0000 Fix a doc type; (GET x, y) is not (GET(x), y). ------------------------------------------ version 0.947 at 2012-06-03 07:21:46 +0000 ------------------------------------------ Change: 944c66f2149bc39a24db854d0310522b1d1697ed Author: Rocco Caputo Date : 2012-06-03 03:21:46 +0000 [rt.cpan.org 76542] Fix a double close in PoCo::Client::HTTP. Florian Schlichting found POE throwing an error on an undefined file descriptor. POE::Component::Client::HTTP was closing a filehandle before destroying the wheel that was managing it. When it was time for the wheel to remove the filehandle's watcher, fileno() failed, and trouble ensued. Change: 7628a0aa4c7097a54d46773d3bdc3000362a0fd1 Author: Rocco Caputo Date : 2012-06-03 02:27:03 +0000 [rt.cpan.org 77601] Switch to Socket's getaddrinfo(). AVENJ reported that Socket::GetSockAddr's :newapi was deprecated. Switch to Socket for a more future-proof API. ------------------------------------------ version 0.946 at 2012-05-15 01:47:32 +0000 ------------------------------------------ Change: eacdcf93f62f566011a8c29637d10f27d0aad28a Author: Rocco Caputo Date : 2012-05-14 21:47:32 +0000 Rely upon the latest POE::Component::Client::Keepalive. Change: 567c9bf1b2a7ac5aa057baaefa545055548dafc2 Author: Rocco Caputo Date : 2012-04-29 19:50:38 +0000 [rt.cpan.org 76543] Help out Debian with a NAME and SYNOPSIS for an internal module. Florian sent in a patch written by Krzysztof Krzyzaniak to add NAME and SYNOPSIS sections to POE::Component::Client::HTTP::RequestFactory. This is reported to help Debian automatically build a "whatis" entry for the module. Thanks for the patch! Please send any others upstream. ================================================= Plus 58 releases after 2012-05-06 00:00:00 +0000. ================================================= POE-Component-Client-HTTP-0.948/CHANGES.OLD000644 000765 000024 00000006602 12141763331 017641 0ustar00trocstaff000000 000000 ============ Things to do ============ Nothing at the moment. ================================================= Revision history for POE::Component::Client::HTTP ================================================= Changes marked with "(!!!)" may break backward compatibility. Changes marked with "(???)" are just information. Note to self: Don't forget to tag the version after a new distribution is released. For example: `cvs tag -Rc v1_00 .' --------------- 0.41 2002.03.25 --------------- Just 0.4001 after people confirmed that it actually works. :) ----------------------------- 0.4001 (private test release) ----------------------------- Frank Konen discovered that this component's Content-Length and header size calculations were incorrect before Erick Calder. Hopefully 0.41 will fix things for everyone. Erick Calder discovered a site that didn't work with 0.40. This release patches the fix in 0.40 so both his test cases work, but it's not generally relased in case he discovers another problem. 0.41 should be released in a couple days if all goes well. --------------- 0.40 2002.03.17 --------------- Erick Calder discovered that Client::HTTP was cutting responses short. It turns out that 0.39 was counting the headers towards the content length. Rocco reset the received octets count at the end of the headers. --------------- 0.39 2001.12.06 --------------- Rocco installed Client::HTTP in a live program, and it promptly broke. This release fixes the new timer code in 0.38. --------------- 0.38 2001.12.06 --------------- Fixed the SYNOPSIS per Jason Boxman's recommendation. Made the Timeout parameter significant. There was no code behind it before now. --------------- 0.37 2001.10.15 --------------- Add a MaxSize parameter to the Component's constructor. When used, it can prevent the world from blowing up when someone hands you . --------------- 0.36 2001.05.29 --------------- Martijn van Beers sent in a patch to have the client send an entire query, parameters and all, and not just the path. Some servers return bad newlines in the headers. Detect the newline style in the status line, and use that throughout the headers. Added a new parameter to the 'request' event: A tag that can be used to match requests to responses regardless of the URL. The tag will be passed back with a response, in offset 1 of the request packet. Removed the requirement that an HTTP status line have a protocol type and version. Added the HTTP::Request to the HTTP::Response this module returns. The CookieJar needs this, as does everyone who expects this module to work properly. --------------- 0.35 2000.09.20 --------------- Added cookies support, and documented the CookieJar parameter for PoCo::Client::HTTP->spawn(). --------------- 0.34 2000.09.02 --------------- On crysflame's recommendation, I moved the HTTP.pm file out of POE/Component/Client and added a PM directive to Makefile.PL. Now HTTP.pm gets installed. Fixed the MANIFEST and cleaned up Makefile.PL a little while I was in there. --------------- 0.33 2000.09.01 --------------- Initial release. Arbitrarily versioned at 0.33 to indicate the author's confidence in its completion (that is, it's about 1/3 of the way). It works for simple GET and POST requests; others may also work, but they haven't been tested. =========================== EOF: Thank you for reading. =========================== POE-Component-Client-HTTP-0.948/dist.ini000644 000765 000024 00000002466 12141763331 017701 0ustar00trocstaff000000 000000 name = POE-Component-Client-HTTP author = Rocco Caputo license = Perl_5 copyright_holder = Rocco Caputo [Prereqs] HTTP::Headers = 5.810 HTTP::Request = 5.811 HTTP::Request::Common = 5.811 HTTP::Response = 5.813 HTTP::Status = 5.811 Net::HTTP::Methods = 5.812 POE = 1.312 POE::Component::Client::Keepalive = 0.271 Socket = 2.001 Test::More = 0.96 Test::POE::Server::TCP = 1.14 URI = 1.37 [MetaResources] bugtracker = http://rt.cpan.org/Public/Dist/Display.html?Name=POE-Component-Client-HTTP repository = http://github.com/rcaputo/poe-component-client-http [Repository] git_remote = gh [ReadmeFromPod] [ReadmeMarkdownFromPod] [ReportVersions] ; Require everything to be checked in. [Git::Check] allow_dirty = Dist-Zilla-Plugin-ChangelogFromGit-*.*/* ; Calculate the release version. [Git::NextVersion] first_version = 0.945 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] POE-Component-Client-HTTP-0.948/examples/000755 000765 000024 00000000000 12141763331 020043 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/lib/000755 000765 000024 00000000000 12141763331 016773 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/LICENSE000644 000765 000024 00000043514 12141763331 017241 0ustar00trocstaff000000 000000 This software is copyright (c) 2013 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) 2013 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. 59 Temple Place, Suite 330, Boston, MA 02111-1307, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by 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 POE-Component-Client-HTTP-0.948/Makefile.PL000644 000765 000024 00000002543 12141763331 020203 0ustar00trocstaff000000 000000 use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "a HTTP user-agent component", "AUTHOR" => "Rocco Caputo ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "POE-Component-Client-HTTP", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "POE::Component::Client::HTTP", "PREREQ_PM" => { "HTTP::Headers" => "5.810", "HTTP::Request" => "5.811", "HTTP::Request::Common" => "5.811", "HTTP::Response" => "5.813", "HTTP::Status" => "5.811", "Net::HTTP::Methods" => "5.812", "POE" => "1.312", "POE::Component::Client::Keepalive" => "0.271", "Socket" => "2.001", "Test::More" => "0.96", "Test::POE::Server::TCP" => "1.14", "URI" => "1.37" }, "VERSION" => "0.948", "test" => { "TESTS" => "t/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); POE-Component-Client-HTTP-0.948/MANIFEST000644 000765 000024 00000001575 12141763331 017366 0ustar00trocstaff000000 000000 CHANGES CHANGES.OLD LICENSE MANIFEST MANIFEST.SKIP META.yml Makefile.PL README README.mkdn dist.ini examples/pcchget.perl lib/POE/Component/Client/HTTP.pm lib/POE/Component/Client/HTTP/Request.pm lib/POE/Component/Client/HTTP/RequestFactory.pm lib/POE/Filter/HTTPChunk.pm lib/POE/Filter/HTTPHead.pm t/000-report-versions.t t/01_request.t t/01_ssl.t t/01_stream.t t/02_keepalive.t t/03_head_filter.t t/04_chunk_filter.t t/05_request.t t/06_factory.t t/07_proxy.t t/08_discard.t t/10_shutdown.t t/11_cancel.t t/12_pod.t t/13_pod_coverage.t t/14_gzipped_content.t t/50_davis_zerolength.t t/51_santos_status.t t/52_reiss_bad_length.t t/53_response_parser.t t/54_hzheng_head_redir.t t/55_reiss_double_resp.t t/56_redirect_excess.t t/57_pravus_progress.t t/58_joel_cancel_multi.t t/59_incomplete_b.t t/60_rt50231_pending.t t/60_rt50231_pending_many.t t/release-pod-coverage.t t/release-pod-syntax.t POE-Component-Client-HTTP-0.948/MANIFEST.SKIP000600 000765 000024 00000000320 12141763331 020106 0ustar00trocstaff000000 000000 CVS \.\# \.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$ ~$ POE-Component-Client-HTTP-0.948/META.yml000644 000765 000024 00000001552 12141763331 017501 0ustar00trocstaff000000 000000 --- abstract: 'a HTTP user-agent component' author: - 'Rocco Caputo ' build_requires: {} configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300020, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: POE-Component-Client-HTTP requires: HTTP::Headers: 5.810 HTTP::Request: 5.811 HTTP::Request::Common: 5.811 HTTP::Response: 5.813 HTTP::Status: 5.811 Net::HTTP::Methods: 5.812 POE: 1.312 POE::Component::Client::Keepalive: 0.271 Socket: 2.001 Test::More: 0.96 Test::POE::Server::TCP: 1.14 URI: 1.37 resources: bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=POE-Component-Client-HTTP repository: git://github.com/rcaputo/poe-component-client-http.git version: 0.948 POE-Component-Client-HTTP-0.948/README000644 000765 000024 00000047160 12141763331 017115 0ustar00trocstaff000000 000000 NAME POE::Component::Client::HTTP - a HTTP user-agent component VERSION version 0.948 SYNOPSIS use POE qw(Component::Client::HTTP); POE::Component::Client::HTTP->spawn( Agent => 'SpiffCrawler/0.90', # defaults to something long Alias => 'ua', # defaults to 'weeble' From => 'spiffster@perl.org', # defaults to undef (no header) Protocol => 'HTTP/0.9', # defaults to 'HTTP/1.1' Timeout => 60, # defaults to 180 seconds MaxSize => 16384, # defaults to entire response Streaming => 4096, # defaults to 0 (off) FollowRedirects => 2, # defaults to 0 (off) Proxy => "http://localhost:80", # defaults to HTTP_PROXY env. variable NoProxy => [ "localhost", "127.0.0.1" ], # defs to NO_PROXY env. variable BindAddr => "12.34.56.78", # defaults to INADDR_ANY ); $kernel->post( 'ua', # posts to the 'ua' alias 'request', # posts to ua's 'request' state 'response', # which of our states will receive the response $request, # an HTTP::Request object ); # This is the sub which is called when the session receives a # 'response' event. sub response_handler { my ($request_packet, $response_packet) = @_[ARG0, ARG1]; # HTTP::Request my $request_object = $request_packet->[0]; # HTTP::Response my $response_object = $response_packet->[0]; my $stream_chunk; if (! defined($response_object->content)) { $stream_chunk = $response_packet->[1]; } print( "*" x 78, "\n", "*** my request:\n", "-" x 78, "\n", $request_object->as_string(), "*" x 78, "\n", "*** their response:\n", "-" x 78, "\n", $response_object->as_string(), ); if (defined $stream_chunk) { print "-" x 40, "\n", $stream_chunk, "\n"; } print "*" x 78, "\n"; } DESCRIPTION POE::Component::Client::HTTP is an HTTP user-agent for POE. It lets other sessions run while HTTP transactions are being processed, and it lets several HTTP transactions be processed in parallel. It supports keep-alive through POE::Component::Client::Keepalive, which in turn uses POE::Component::Resolver for asynchronous IPv4 and IPv6 name resolution. HTTP client components are not proper objects. Instead of being created, as most objects are, they are "spawned" as separate sessions. To avoid confusion (and hopefully not cause other confusion), they must be spawned with a "spawn" method, not created anew with a "new" one. CONSTRUCTOR spawn PoCo::Client::HTTP's "spawn" method takes a few named parameters: Agent => $user_agent_string Agent => \@list_of_agents If a UserAgent header is not present in the HTTP::Request, a random one will be used from those specified by the "Agent" parameter. If none are supplied, POE::Component::Client::HTTP will advertise itself to the server. "Agent" may contain a reference to a list of user agents. If this is the case, PoCo::Client::HTTP will choose one of them at random for each request. Alias => $session_alias "Alias" sets the name by which the session will be known. If no alias is given, the component defaults to "weeble". The alias lets several sessions interact with HTTP components without keeping (or even knowing) hard references to them. It's possible to spawn several HTTP components with different names. ConnectionManager => $poco_client_keepalive "ConnectionManager" sets this component's connection pool manager. It expects the connection manager to be a reference to a POE::Component::Client::Keepalive object. The HTTP client component will call "allocate()" on the connection manager itself so you should not have done this already. my $pool = POE::Component::Client::Keepalive->new( keep_alive => 10, # seconds to keep connections alive max_open => 100, # max concurrent connections - total max_per_host => 20, # max concurrent connections - per host timeout => 30, # max time (seconds) to establish a new connection ); POE::Component::Client::HTTP->spawn( # ... ConnectionManager => $pool, # ... ); See POE::Component::Client::Keepalive for more information, including how to alter the connection manager's resolver configuration (for example, to force IPv6 or prefer it before IPv4). CookieJar => $cookie_jar "CookieJar" sets the component's cookie jar. It expects the cookie jar to be a reference to a HTTP::Cookies object. From => $admin_address "From" holds an e-mail address where the client's administrator and/or maintainer may be reached. It defaults to undef, which means no From header will be included in requests. MaxSize => OCTETS "MaxSize" specifies the largest response to accept from a server. The content of larger responses will be truncated to OCTET octets. This has been used to return the section of web pages without the need to wade through . NoProxy => [ $host_1, $host_2, ..., $host_N ] NoProxy => "host1,host2,hostN" "NoProxy" specifies a list of server hosts that will not be proxied. It is useful for local hosts and hosts that do not properly support proxying. If NoProxy is not specified, a list will be taken from the NO_PROXY environment variable. NoProxy => [ "localhost", "127.0.0.1" ], NoProxy => "localhost,127.0.0.1", BindAddr => $local_ip Specify "BindAddr" to bind all client sockets to a particular local address. The value of BindAddr will be passed through POE::Component::Client::Keepalive to POE::Wheel::SocketFactory (as "bind_address"). See that module's documentation for implementation details. BindAddr => "12.34.56.78" Protocol => $http_protocol_string "Protocol" advertises the protocol that the client wishes to see. Under normal circumstances, it should be left to its default value: "HTTP/1.1". Proxy => [ $proxy_host, $proxy_port ] Proxy => $proxy_url Proxy => $proxy_url,$proxy_url,... "Proxy" specifies one or more proxy hosts that requests will be passed through. If not specified, proxy servers will be taken from the HTTP_PROXY (or http_proxy) environment variable. No proxying will occur unless Proxy is set or one of the environment variables exists. The proxy can be specified either as a host and port, or as one or more URLs. Proxy URLs must specify the proxy port, even if it is 80. Proxy => [ "127.0.0.1", 80 ], Proxy => "http://127.0.0.1:80/", "Proxy" may specify multiple proxies separated by commas. PoCo::Client::HTTP will choose proxies from this list at random. This is useful for load balancing requests through multiple gateways. Proxy => "http://127.0.0.1:80/,http://127.0.0.1:81/", Streaming => OCTETS "Streaming" changes allows Client::HTTP to return large content in chunks (of OCTETS octets each) rather than combine the entire content into a single HTTP::Response object. By default, Client::HTTP reads the entire content for a response into memory before returning an HTTP::Response object. This is obviously bad for applications like streaming MP3 clients, because they often fetch songs that never end. Yes, they go on and on, my friend. When "Streaming" is set to nonzero, however, the response handler receives chunks of up to OCTETS octets apiece. The response handler accepts slightly different parameters in this case. ARG0 is also an HTTP::Response object but it does not contain response content, and ARG1 contains a a chunk of raw response content, or undef if the stream has ended. sub streaming_response_handler { my $response_packet = $_[ARG1]; my ($response, $data) = @$response_packet; print SAVED_STREAM $data if defined $data; } FollowRedirects => $number_of_hops_to_follow "FollowRedirects" specifies how many redirects (e.g. 302 Moved) to follow. If not specified defaults to 0, and thus no redirection is followed. This maintains compatibility with the previous behavior, which was not to follow redirects at all. If redirects are followed, a response chain should be built, and can be accessed through $response_object->previous(). See HTTP::Response for details here. Timeout => $query_timeout "Timeout" sets how long POE::Component::Client::HTTP has to process an application's request, in seconds. "Timeout" defaults to 180 (three minutes) if not specified. It's important to note that the timeout begins when the component receives an application's request, not when it attempts to connect to the web server. Timeouts may result from sending the component too many requests at once. Each request would need to be received and tracked in order. Consider this: $_[KERNEL]->post(component => request => ...) for (1..15_000); 15,000 requests are queued together in one enormous bolus. The component would receive and initialize them in order. The first socket activity wouldn't arrive until the 15,000th request was set up. If that took longer than "Timeout", then the requests that have waited too long would fail. "ConnectionManager"'s own timeout and concurrency limits also affect how many requests may be processed at once. For example, most of the 15,000 requests would wait in the connection manager's pool until sockets become available. Meanwhile, the "Timeout" would be counting down. Applications may elect to control concurrency outside the component's "Timeout". They may do so in a few ways. The easiest way is to limit the initial number of requests to something more manageable. As responses arrive, the application should handle them and start new requests. This limits concurrency to the initial request count. An application may also outsource job throttling to another module, such as POE::Component::JobQueue. In any case, "Timeout" and "ConnectionManager" may be tuned to maximize timeouts and concurrency limits. This may help in some cases. Developers should be aware that doing so will increase memory usage. POE::Component::Client::HTTP and KeepAlive track requests in memory, while applications are free to keep pending requests on disk. ACCEPTED EVENTS Sessions communicate asynchronously with PoCo::Client::HTTP. They post requests to it, and it posts responses back. request Requests are posted to the component's "request" state. They include an HTTP::Request object which defines the request. For example: $kernel->post( 'ua', 'request', # http session alias & state 'response', # my state to receive responses GET('http://poe.perl.org'), # a simple HTTP request 'unique id', # a tag to identify the request 'progress', # an event to indicate progress 'http://1.2.3.4:80/' # proxy to use for this request ); Requests include the state to which responses will be posted. In the previous example, the handler for a 'response' state will be called with each HTTP response. The "progress" handler is optional and if installed, the component will provide progress metrics (see sample handler below). The "proxy" parameter is optional and if not defined, a default proxy will be used if configured. No proxy will be used if neither a default one nor a "proxy" parameter is defined. pending_requests_count There's also a pending_requests_count state that returns the number of requests currently being processed. To receive the return value, it must be invoked with $kernel->call(). my $count = $kernel->call('ua' => 'pending_requests_count'); NOTE: Sometimes the count might not be what you expected, because responses are currently in POE's queue and you haven't processed them. This could happen if you configure the "ConnectionManager"'s concurrency to a high enough value. cancel Cancel a specific HTTP request. Requires a reference to the original request (blessed or stringified) so it knows which one to cancel. See "progress handler" below for notes on canceling streaming requests. To cancel a request based on its blessed HTTP::Request object: $kernel->post( component => cancel => $http_request ); To cancel a request based on its stringified HTTP::Request object: $kernel->post( component => cancel => "$http_request" ); shutdown Responds to all pending requests with 408 (request timeout), and then shuts down the component and all subcomponents. SENT EVENTS response handler In addition to all the usual POE parameters, HTTP responses come with two list references: my ($request_packet, $response_packet) = @_[ARG0, ARG1]; $request_packet contains a reference to the original HTTP::Request object. This is useful for matching responses back to the requests that generated them. my $http_request_object = $request_packet->[0]; my $http_request_tag = $request_packet->[1]; # from the 'request' post $response_packet contains a reference to the resulting HTTP::Response object. my $http_response_object = $response_packet->[0]; Please see the HTTP::Request and HTTP::Response manpages for more information. progress handler The example progress handler shows how to calculate a percentage of download completion. sub progress_handler { my $gen_args = $_[ARG0]; # args passed to all calls my $call_args = $_[ARG1]; # args specific to the call my $req = $gen_args->[0]; # HTTP::Request object being serviced my $tag = $gen_args->[1]; # Request ID tag from. my $got = $call_args->[0]; # Number of bytes retrieved so far. my $tot = $call_args->[1]; # Total bytes to be retrieved. my $oct = $call_args->[2]; # Chunk of raw octets received this time. my $percent = $got / $tot * 100; printf( "-- %.0f%% [%d/%d]: %s\n", $percent, $got, $tot, $req->uri() ); # To cancel the request: # $_[KERNEL]->post( component => cancel => $req ); } DEPRECATION WARNING The third return argument (the raw octets received) has been deprecated. Instead of it, use the Streaming parameter to get chunks of content in the response handler. REQUEST CALLBACKS The HTTP::Request object passed to the request event can contain a CODE reference as "content". This allows for sending large files without wasting memory. Your callback should return a chunk of data each time it is called, and an empty string when done. Don't forget to set the Content-Length header correctly. Example: my $request = HTTP::Request->new( PUT => 'http://...' ); my $file = '/path/to/large_file'; open my $fh, '<', $file; my $upload_cb = sub { if ( sysread $fh, my $buf, 4096 ) { return $buf; } else { close $fh; return ''; } }; $request->content_length( -s $file ); $request->content( $upload_cb ); $kernel->post( ua => request, 'response', $request ); CONTENT ENCODING AND COMPRESSION Transparent content decoding has been disabled as of version 0.84. This also removes support for transparent gzip requesting and decompression. To re-enable gzip compression, specify the gzip Content-Encoding and use HTTP::Response's decoded_content() method rather than content(): my $request = HTTP::Request->new( GET => "http://www.yahoo.com/", [ 'Accept-Encoding' => 'gzip' ] ); # ... time passes ... my $content = $response->decoded_content(); The change in POE::Component::Client::HTTP behavior was prompted by changes in HTTP::Response that surfaced a bug in the component's transparent gzip handling. Allowing the application to specify and handle content encodings seems to be the most reliable and flexible resolution. For more information about the problem and discussions regarding the solution, see: and CLIENT HEADERS POE::Component::Client::HTTP sets its own response headers with additional information. All of its headers begin with "X-PCCH". X-PCCH-Errmsg POE::Component::Client::HTTP may fail because of an internal client error rather than an HTTP protocol error. X-PCCH-Errmsg will contain a human readable reason for client failures, should they occur. The text of X-PCCH-Errmsg may also be repeated in the response's content. X-PCCH-Peer X-PCCH-Peer contains the remote IPv4 address and port, separated by a period. For example, "127.0.0.1.8675" represents port 8675 on localhost. Proxying will render X-PCCH-Peer nearly useless, since the socket will be connected to a proxy rather than the server itself. This feature was added at Doreen Grey's request. Doreen wanted a means to find the remote server's address without having to make an additional request. ENVIRONMENT POE::Component::Client::HTTP uses two standard environment variables: HTTP_PROXY and NO_PROXY. HTTP_PROXY sets the proxy server that Client::HTTP will forward requests through. NO_PROXY sets a list of hosts that will not be forwarded through a proxy. See the Proxy and NoProxy constructor parameters for more information about these variables. SEE ALSO This component is built upon HTTP::Request, HTTP::Response, and POE. Please see its source code and the documentation for its foundation modules to learn more. If you want to use cookies, you'll need to read about HTTP::Cookies as well. Also see the test program, t/01_request.t, in the PoCo::Client::HTTP distribution. BUGS There is no support for CGI_PROXY or CgiProxy. Secure HTTP (https) proxying is not supported at this time. There is no object oriented interface. See POE::Component::Client::Keepalive and POE::Component::Resolver for examples of a decent OO interface. AUTHOR, COPYRIGHT, & LICENSE POE::Component::Client::HTTP is * Copyright 1999-2009 Rocco Caputo * Copyright 2004 Rob Bloodgood * Copyright 2004-2005 Martijn van Beers All rights are reserved. POE::Component::Client::HTTP is free software; you may redistribute it and/or modify it under the same terms as Perl itself. CONTRIBUTORS Joel Bernstein solved some nasty race conditions. Portugal Telecom was kind enough to support his contributions. Jeff Bisbee added POD tests and documentation to pass several of them to version 0.79. He's a kwalitee-increasing machine! BUG TRACKER https://rt.cpan.org/Dist/Display.html?Queue=POE-Component-Client-HTTP REPOSITORY Github: . Gitorious: . OTHER RESOURCES POE-Component-Client-HTTP-0.948/README.mkdn000644 000765 000024 00000045164 12141763331 020047 0ustar00trocstaff000000 000000 # NAME POE::Component::Client::HTTP - a HTTP user-agent component # VERSION version 0.948 # SYNOPSIS use POE qw(Component::Client::HTTP); POE::Component::Client::HTTP->spawn( Agent => 'SpiffCrawler/0.90', # defaults to something long Alias => 'ua', # defaults to 'weeble' From => 'spiffster@perl.org', # defaults to undef (no header) Protocol => 'HTTP/0.9', # defaults to 'HTTP/1.1' Timeout => 60, # defaults to 180 seconds MaxSize => 16384, # defaults to entire response Streaming => 4096, # defaults to 0 (off) FollowRedirects => 2, # defaults to 0 (off) Proxy => "http://localhost:80", # defaults to HTTP_PROXY env. variable NoProxy => [ "localhost", "127.0.0.1" ], # defs to NO_PROXY env. variable BindAddr => "12.34.56.78", # defaults to INADDR_ANY ); $kernel->post( 'ua', # posts to the 'ua' alias 'request', # posts to ua's 'request' state 'response', # which of our states will receive the response $request, # an HTTP::Request object ); # This is the sub which is called when the session receives a # 'response' event. sub response_handler { my ($request_packet, $response_packet) = @_[ARG0, ARG1]; # HTTP::Request my $request_object = $request_packet->[0]; # HTTP::Response my $response_object = $response_packet->[0]; my $stream_chunk; if (! defined($response_object->content)) { $stream_chunk = $response_packet->[1]; } print( "*" x 78, "\n", "*** my request:\n", "-" x 78, "\n", $request_object->as_string(), "*" x 78, "\n", "*** their response:\n", "-" x 78, "\n", $response_object->as_string(), ); if (defined $stream_chunk) { print "-" x 40, "\n", $stream_chunk, "\n"; } print "*" x 78, "\n"; } # DESCRIPTION POE::Component::Client::HTTP is an HTTP user-agent for POE. It lets other sessions run while HTTP transactions are being processed, and it lets several HTTP transactions be processed in parallel. It supports keep-alive through POE::Component::Client::Keepalive, which in turn uses POE::Component::Resolver for asynchronous IPv4 and IPv6 name resolution. HTTP client components are not proper objects. Instead of being created, as most objects are, they are "spawned" as separate sessions. To avoid confusion (and hopefully not cause other confusion), they must be spawned with a `spawn` method, not created anew with a `new` one. # CONSTRUCTOR ## spawn PoCo::Client::HTTP's `spawn` method takes a few named parameters: - Agent => $user_agent_string - Agent => \@list_of_agents If a UserAgent header is not present in the HTTP::Request, a random one will be used from those specified by the `Agent` parameter. If none are supplied, POE::Component::Client::HTTP will advertise itself to the server. `Agent` may contain a reference to a list of user agents. If this is the case, PoCo::Client::HTTP will choose one of them at random for each request. - Alias => $session_alias `Alias` sets the name by which the session will be known. If no alias is given, the component defaults to "weeble". The alias lets several sessions interact with HTTP components without keeping (or even knowing) hard references to them. It's possible to spawn several HTTP components with different names. - ConnectionManager => $poco_client_keepalive `ConnectionManager` sets this component's connection pool manager. It expects the connection manager to be a reference to a POE::Component::Client::Keepalive object. The HTTP client component will call `allocate()` on the connection manager itself so you should not have done this already. my $pool = POE::Component::Client::Keepalive->new( keep_alive => 10, # seconds to keep connections alive max_open => 100, # max concurrent connections - total max_per_host => 20, # max concurrent connections - per host timeout => 30, # max time (seconds) to establish a new connection ); POE::Component::Client::HTTP->spawn( # ... ConnectionManager => $pool, # ... ); See [POE::Component::Client::Keepalive](http://search.cpan.org/perldoc?POE::Component::Client::Keepalive) for more information, including how to alter the connection manager's resolver configuration (for example, to force IPv6 or prefer it before IPv4). - CookieJar => $cookie_jar `CookieJar` sets the component's cookie jar. It expects the cookie jar to be a reference to a HTTP::Cookies object. - From => $admin_address `From` holds an e-mail address where the client's administrator and/or maintainer may be reached. It defaults to undef, which means no From header will be included in requests. - MaxSize => OCTETS `MaxSize` specifies the largest response to accept from a server. The content of larger responses will be truncated to OCTET octets. This has been used to return the section of web pages without the need to wade through . - NoProxy => [ $host_1, $host_2, ..., $host_N ] - NoProxy => "host1,host2,hostN" `NoProxy` specifies a list of server hosts that will not be proxied. It is useful for local hosts and hosts that do not properly support proxying. If NoProxy is not specified, a list will be taken from the NO_PROXY environment variable. NoProxy => [ "localhost", "127.0.0.1" ], NoProxy => "localhost,127.0.0.1", - BindAddr => $local_ip Specify `BindAddr` to bind all client sockets to a particular local address. The value of BindAddr will be passed through POE::Component::Client::Keepalive to POE::Wheel::SocketFactory (as `bind_address`). See that module's documentation for implementation details. BindAddr => "12.34.56.78" - Protocol => $http_protocol_string `Protocol` advertises the protocol that the client wishes to see. Under normal circumstances, it should be left to its default value: "HTTP/1.1". - Proxy => [ $proxy_host, $proxy_port ] - Proxy => $proxy_url - Proxy => $proxy_url,$proxy_url,... `Proxy` specifies one or more proxy hosts that requests will be passed through. If not specified, proxy servers will be taken from the HTTP_PROXY (or http_proxy) environment variable. No proxying will occur unless Proxy is set or one of the environment variables exists. The proxy can be specified either as a host and port, or as one or more URLs. Proxy URLs must specify the proxy port, even if it is 80. Proxy => [ "127.0.0.1", 80 ], Proxy => "http://127.0.0.1:80/", `Proxy` may specify multiple proxies separated by commas. PoCo::Client::HTTP will choose proxies from this list at random. This is useful for load balancing requests through multiple gateways. Proxy => "http://127.0.0.1:80/,http://127.0.0.1:81/", - Streaming => OCTETS `Streaming` changes allows Client::HTTP to return large content in chunks (of OCTETS octets each) rather than combine the entire content into a single HTTP::Response object. By default, Client::HTTP reads the entire content for a response into memory before returning an HTTP::Response object. This is obviously bad for applications like streaming MP3 clients, because they often fetch songs that never end. Yes, they go on and on, my friend. When `Streaming` is set to nonzero, however, the response handler receives chunks of up to OCTETS octets apiece. The response handler accepts slightly different parameters in this case. ARG0 is also an HTTP::Response object but it does not contain response content, and ARG1 contains a a chunk of raw response content, or undef if the stream has ended. sub streaming_response_handler { my $response_packet = $_[ARG1]; my ($response, $data) = @$response_packet; print SAVED_STREAM $data if defined $data; } - FollowRedirects => $number_of_hops_to_follow `FollowRedirects` specifies how many redirects (e.g. 302 Moved) to follow. If not specified defaults to 0, and thus no redirection is followed. This maintains compatibility with the previous behavior, which was not to follow redirects at all. If redirects are followed, a response chain should be built, and can be accessed through $response_object->previous(). See HTTP::Response for details here. - Timeout => $query_timeout `Timeout` sets how long POE::Component::Client::HTTP has to process an application's request, in seconds. `Timeout` defaults to 180 (three minutes) if not specified. It's important to note that the timeout begins when the component receives an application's request, not when it attempts to connect to the web server. Timeouts may result from sending the component too many requests at once. Each request would need to be received and tracked in order. Consider this: $_[KERNEL]->post(component => request => ...) for (1..15_000); 15,000 requests are queued together in one enormous bolus. The component would receive and initialize them in order. The first socket activity wouldn't arrive until the 15,000th request was set up. If that took longer than `Timeout`, then the requests that have waited too long would fail. `ConnectionManager`'s own timeout and concurrency limits also affect how many requests may be processed at once. For example, most of the 15,000 requests would wait in the connection manager's pool until sockets become available. Meanwhile, the `Timeout` would be counting down. Applications may elect to control concurrency outside the component's `Timeout`. They may do so in a few ways. The easiest way is to limit the initial number of requests to something more manageable. As responses arrive, the application should handle them and start new requests. This limits concurrency to the initial request count. An application may also outsource job throttling to another module, such as POE::Component::JobQueue. In any case, `Timeout` and `ConnectionManager` may be tuned to maximize timeouts and concurrency limits. This may help in some cases. Developers should be aware that doing so will increase memory usage. POE::Component::Client::HTTP and KeepAlive track requests in memory, while applications are free to keep pending requests on disk. # ACCEPTED EVENTS Sessions communicate asynchronously with PoCo::Client::HTTP. They post requests to it, and it posts responses back. ## request Requests are posted to the component's "request" state. They include an HTTP::Request object which defines the request. For example: $kernel->post( 'ua', 'request', # http session alias & state 'response', # my state to receive responses GET('http://poe.perl.org'), # a simple HTTP request 'unique id', # a tag to identify the request 'progress', # an event to indicate progress 'http://1.2.3.4:80/' # proxy to use for this request ); Requests include the state to which responses will be posted. In the previous example, the handler for a 'response' state will be called with each HTTP response. The "progress" handler is optional and if installed, the component will provide progress metrics (see sample handler below). The "proxy" parameter is optional and if not defined, a default proxy will be used if configured. No proxy will be used if neither a default one nor a "proxy" parameter is defined. ## pending_requests_count There's also a pending_requests_count state that returns the number of requests currently being processed. To receive the return value, it must be invoked with $kernel->call(). my $count = $kernel->call('ua' => 'pending_requests_count'); NOTE: Sometimes the count might not be what you expected, because responses are currently in POE's queue and you haven't processed them. This could happen if you configure the `ConnectionManager`'s concurrency to a high enough value. ## cancel Cancel a specific HTTP request. Requires a reference to the original request (blessed or stringified) so it knows which one to cancel. See L below for notes on canceling streaming requests. To cancel a request based on its blessed HTTP::Request object: $kernel->post( component => cancel => $http_request ); To cancel a request based on its stringified HTTP::Request object: $kernel->post( component => cancel => "$http_request" ); ## shutdown Responds to all pending requests with 408 (request timeout), and then shuts down the component and all subcomponents. # SENT EVENTS ## response handler In addition to all the usual POE parameters, HTTP responses come with two list references: my ($request_packet, $response_packet) = @_[ARG0, ARG1]; `$request_packet` contains a reference to the original HTTP::Request object. This is useful for matching responses back to the requests that generated them. my $http_request_object = $request_packet->[0]; my $http_request_tag = $request_packet->[1]; # from the 'request' post `$response_packet` contains a reference to the resulting HTTP::Response object. my $http_response_object = $response_packet->[0]; Please see the HTTP::Request and HTTP::Response manpages for more information. ## progress handler The example progress handler shows how to calculate a percentage of download completion. sub progress_handler { my $gen_args = $_[ARG0]; # args passed to all calls my $call_args = $_[ARG1]; # args specific to the call my $req = $gen_args->[0]; # HTTP::Request object being serviced my $tag = $gen_args->[1]; # Request ID tag from. my $got = $call_args->[0]; # Number of bytes retrieved so far. my $tot = $call_args->[1]; # Total bytes to be retrieved. my $oct = $call_args->[2]; # Chunk of raw octets received this time. my $percent = $got / $tot * 100; printf( "-- %.0f%% [%d/%d]: %s\n", $percent, $got, $tot, $req->uri() ); # To cancel the request: # $_[KERNEL]->post( component => cancel => $req ); } ### DEPRECATION WARNING The third return argument (the raw octets received) has been deprecated. Instead of it, use the Streaming parameter to get chunks of content in the response handler. # REQUEST CALLBACKS The HTTP::Request object passed to the request event can contain a CODE reference as `content`. This allows for sending large files without wasting memory. Your callback should return a chunk of data each time it is called, and an empty string when done. Don't forget to set the Content-Length header correctly. Example: my $request = HTTP::Request->new( PUT => 'http://...' ); my $file = '/path/to/large_file'; open my $fh, '<', $file; my $upload_cb = sub { if ( sysread $fh, my $buf, 4096 ) { return $buf; } else { close $fh; return ''; } }; $request->content_length( -s $file ); $request->content( $upload_cb ); $kernel->post( ua => request, 'response', $request ); # CONTENT ENCODING AND COMPRESSION Transparent content decoding has been disabled as of version 0.84. This also removes support for transparent gzip requesting and decompression. To re-enable gzip compression, specify the gzip Content-Encoding and use HTTP::Response's decoded_content() method rather than content(): my $request = HTTP::Request->new( GET => "http://www.yahoo.com/", [ 'Accept-Encoding' => 'gzip' ] ); # ... time passes ... my $content = $response->decoded_content(); The change in POE::Component::Client::HTTP behavior was prompted by changes in HTTP::Response that surfaced a bug in the component's transparent gzip handling. Allowing the application to specify and handle content encodings seems to be the most reliable and flexible resolution. For more information about the problem and discussions regarding the solution, see: [http://www.perlmonks.org/?node_id=683833](http://www.perlmonks.org/?node_id=683833) and [http://rt.cpan.org/Ticket/Display.html?id=35538](http://rt.cpan.org/Ticket/Display.html?id=35538) # CLIENT HEADERS POE::Component::Client::HTTP sets its own response headers with additional information. All of its headers begin with "X-PCCH". ## X-PCCH-Errmsg POE::Component::Client::HTTP may fail because of an internal client error rather than an HTTP protocol error. X-PCCH-Errmsg will contain a human readable reason for client failures, should they occur. The text of X-PCCH-Errmsg may also be repeated in the response's content. ## X-PCCH-Peer X-PCCH-Peer contains the remote IPv4 address and port, separated by a period. For example, "127.0.0.1.8675" represents port 8675 on localhost. Proxying will render X-PCCH-Peer nearly useless, since the socket will be connected to a proxy rather than the server itself. This feature was added at Doreen Grey's request. Doreen wanted a means to find the remote server's address without having to make an additional request. # ENVIRONMENT POE::Component::Client::HTTP uses two standard environment variables: HTTP_PROXY and NO_PROXY. HTTP_PROXY sets the proxy server that Client::HTTP will forward requests through. NO_PROXY sets a list of hosts that will not be forwarded through a proxy. See the Proxy and NoProxy constructor parameters for more information about these variables. # SEE ALSO This component is built upon HTTP::Request, HTTP::Response, and POE. Please see its source code and the documentation for its foundation modules to learn more. If you want to use cookies, you'll need to read about HTTP::Cookies as well. Also see the test program, t/01_request.t, in the PoCo::Client::HTTP distribution. # BUGS There is no support for CGI_PROXY or CgiProxy. Secure HTTP (https) proxying is not supported at this time. There is no object oriented interface. See [POE::Component::Client::Keepalive](http://search.cpan.org/perldoc?POE::Component::Client::Keepalive) and [POE::Component::Resolver](http://search.cpan.org/perldoc?POE::Component::Resolver) for examples of a decent OO interface. # AUTHOR, COPYRIGHT, & LICENSE POE::Component::Client::HTTP is - Copyright 1999-2009 Rocco Caputo - Copyright 2004 Rob Bloodgood - Copyright 2004-2005 Martijn van Beers All rights are reserved. POE::Component::Client::HTTP is free software; you may redistribute it and/or modify it under the same terms as Perl itself. # CONTRIBUTORS Joel Bernstein solved some nasty race conditions. Portugal Telecom [http://www.sapo.pt/](http://www.sapo.pt/) was kind enough to support his contributions. Jeff Bisbee added POD tests and documentation to pass several of them to version 0.79. He's a kwalitee-increasing machine! # BUG TRACKER https://rt.cpan.org/Dist/Display.html?Queue=POE-Component-Client-HTTP # REPOSITORY Github: [http://github.com/rcaputo/poe-component-client-http](http://github.com/rcaputo/poe-component-client-http) . Gitorious: [http://gitorious.org/poe-component-client-http](http://gitorious.org/poe-component-client-http) . # OTHER RESOURCES [http://search.cpan.org/dist/POE-Component-Client-HTTP/](http://search.cpan.org/dist/POE-Component-Client-HTTP/)POE-Component-Client-HTTP-0.948/t/000755 000765 000024 00000000000 12141763331 016470 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/t/000-report-versions.t000644 000765 000024 00000031270 12141763331 022336 0ustar00trocstaff000000 000000 #!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; } POE-Component-Client-HTTP-0.948/t/01_request.t000644 000765 000024 00000011153 12141763331 020646 0ustar00trocstaff000000 000000 # vim: filetype=perl sw=2 ts=2 expandtab use strict; use Test::More; use POE qw( Filter::Stream Filter::HTTPD Component::Client::HTTP Component::Client::Keepalive ); use Test::POE::Server::TCP; my @requests; my $long = < Test Page

This page exists to test POE web components.

EOF use HTTP::Request::Common qw(GET POST); #my $cm = POE::Component::Client::Keepalive->new; POE::Component::Client::HTTP->spawn( #MaxSize => MAX_BIG_REQUEST_SIZE, MaxSize => 200, Timeout => 3, #Protocol => 'HTTP/1.1', #default #ConnectionManager => $cm, #default ); POE::Session->create( package_states => [ main => [qw( _start testd_registered testd_client_input got_response send_after_timeout )], ] ); $poe_kernel->run; exit 0; sub _start { $_[HEAP]->{testd} = Test::POE::Server::TCP->spawn( filter => POE::Filter::Stream->new, address => 'localhost', ); my $port = $_[HEAP]->{testd}->port; my @badrequests = ( GET("http://not.localhost.but.invalid/badhost"), GET("file:///from/a/local/filesystem"), ); my @fields = ('field1=111&', 'field2=222'); @requests = ( GET("http://localhost:$port/test", Connection => 'close'), GET("http://localhost:$port/timeout", Connection => 'close'), POST("http://localhost:$port/post1", [field1 => '111', field2 => '222']), GET("http://localhost:$port/long", Connection => 'close'), HTTP::Request->new( POST => "http://localhost:$port/post2", [], sub { return shift @fields } ), @badrequests, ); plan tests => @requests * 2 - @badrequests; } sub testd_registered { my ($kernel) = $_[KERNEL]; foreach my $r (@requests) { $kernel->post( 'weeble', request => 'got_response', $r, ); } } sub send_after_timeout { my ($heap, $id) = @_[HEAP, ARG0]; $heap->{testd}->send_to_client($id, $data); $heap->{testd}->shutdown; $_[KERNEL]->post( weeble => 'shutdown' ); } sub testd_client_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; $heap->{input_buffer} .= $input; my $buffer = $heap->{input_buffer}; if ($buffer =~ /^GET \/test/) { pass("got test request"); $heap->{input_buffer} = ""; $heap->{testd}->send_to_client($id, $data); } elsif ($buffer =~ /^GET \/timeout/) { pass("got test request we will let timeout"); $heap->{input_buffer} = ""; $kernel->delay_add('send_after_timeout', 3.3, $id); } elsif ($buffer =~ /^POST \/post1.*field.*field/s) { pass("got post request with content"); $heap->{input_buffer} = ""; $heap->{testd}->send_to_client($id, $data); } elsif ($buffer =~ /^POST \/post(\d)/) { if ($buffer =~ /field.*field/) { pass("got content for post request with callback"); $heap->{input_buffer} = ""; $heap->{testd}->send_to_client($id, $data); } } elsif ($buffer =~ /^GET \/long/) { pass("sending too much data as requested"); $heap->{input_buffer} = ""; $heap->{testd}->send_to_client($id, $long); } else { diag("INPUT: $input"); diag("unexpected test"); } } sub got_response { my ($kernel, $heap, $request_packet, $response_packet) = @_[KERNEL, HEAP, ARG0, ARG1]; my $request = $request_packet->[0]; my $response = $response_packet->[0]; my $request_path = $request->uri->path . ''; # stringify if ($request_path =~ m/\/test$/ and $response->code == 200) { pass('got 200 response for test request') } elsif ($request_path =~ m/timeout$/ and $response->code == 408) { pass('got 408 response for timed out request') } elsif ($request_path =~ m/\/post\d$/ and $response->code == 200) { pass('got 200 response for post request') } elsif ($request_path =~ m/\/long$/ and $response->code == 406) { pass('got 400 response for long request') } elsif ( $request_path =~ m/badhost$/ and ( $response->code == 500 or $response->code == 408 or $response->code == 303 # some DNS's redirect bad hosts ) ) { pass("got " . $response->code . " response for request on bad host") } elsif ($request_path =~ m/filesystem$/ and $response->code == 400) { pass('got 400 response for request with unsupported scheme') } else { fail("unexpected response"); diag("path($request_path) code(" . $response->code() . ")"); diag("response((("); diag($response->as_string); diag(")))"); } } POE-Component-Client-HTTP-0.948/t/01_ssl.t000644 000765 000024 00000003423 12141763331 017760 0ustar00trocstaff000000 000000 # vim: filetype=perl sw=2 ts=2 expandtab use strict; sub POE::Kernel::ASSERT_DEFAULT () { 1 } sub DEBUG () { 0 } use POE qw(Component::Client::HTTP Component::Client::Keepalive); use HTTP::Request::Common qw(GET POST); use Test::More; unless (grep /SSLify/, keys %INC) { plan skip_all => 'Need POE::Component::SSLify to test SSL'; } if ( $^O eq 'MSWin32' ) { plan skip_all => 'POE::Component::SSLify does not work on MSWin32. Please help the author if you can fix this!'; } plan tests => 1; $| = 1; sub client_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG and warn "client starting...\n"; my $secure_request = GET( 'https://thirdlobe.com/', Connection => 'close', ); $kernel->post( weeble => request => got_response => $secure_request, ); } sub client_stop { DEBUG and warn "client stopped...\n"; } sub client_got_response { my ($heap, $kernel, $request_packet, $response_packet) = @_[ HEAP, KERNEL, ARG0, ARG1 ]; my $http_request = $request_packet->[0]; my $http_response = $response_packet->[0]; DEBUG and do { warn "client got request...\n"; warn $http_request->as_string; my $response_string = $http_response->as_string(); $response_string =~ s/^/| /mg; warn ",", '-' x 78, "\n"; warn $response_string; warn "`", '-' x 78, "\n"; }; is ($http_response->code, 200, 'Got OK response'); $kernel->post( weeble => 'shutdown' ); } # Create a weeble component. POE::Component::Client::HTTP->spawn( Timeout => 60, ); # Create a session that will make some requests. POE::Session->create( inline_states => { _start => \&client_start, _stop => \&client_stop, got_response => \&client_got_response, } ); # Run it all until done. $poe_kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/01_stream.t000644 000765 000024 00000010112 12141763331 020443 0ustar00trocstaff000000 000000 # vim: filetype=perl sw=2 ts=2 expandtab use strict; use Test::More; use POE qw( Filter::Stream Filter::HTTPD Component::Client::HTTP Component::Client::Keepalive ); use Test::POE::Server::TCP; my @requests; my $long = <new; POE::Component::Client::HTTP->spawn( Streaming => 256, Timeout => 2, ); POE::Session->create( package_states => [ main => [qw( _start testd_registered testd_client_input got_response send_after_timeout )], ] ); $poe_kernel->run; exit 0; sub _start { $_[HEAP]->{testd} = Test::POE::Server::TCP->spawn( filter => POE::Filter::Stream->new, address => 'localhost', ); my $port = $_[HEAP]->{testd}->port; @requests = ( GET("http://localhost:$port/stream", Connection => 'close'), ); plan tests => @requests * 6; } sub testd_registered { my ($kernel) = $_[KERNEL]; foreach my $r (@requests) { $kernel->post( 'weeble', request => 'got_response', $r, ); } } sub send_after_timeout { my ($heap, $id) = @_[HEAP, ARG0]; $heap->{testd}->send_to_client($id, $data); } sub testd_client_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; if ($input =~ /^GET \/stream/) { ok(1, "got test request"); $heap->{testd}->send_to_client($id, $data); } elsif ($input =~ /^GET \/timeout/) { ok(1, "got test request we will let timeout"); $kernel->delay_add('send_after_timeout', 1.1, $id); } elsif ($input =~ /^POST \/post.*field/s) { ok(1, "got post request with content"); $heap->{testd}->send_to_client($id, $data); } elsif ($input =~ /^GET \/long/) { ok(1, "sending too much data as requested"); $heap->{testd}->send_to_client($id, $long); } else { die "unexpected test"; } } sub got_response { my ($kernel, $heap, $request_packet, $response_packet) = @_[KERNEL, HEAP, ARG0, ARG1]; my $request = $request_packet->[0]; my $response = $response_packet->[0]; my $chunk = $response_packet->[1]; my $request_path = $request->uri->path . ''; # stringify #warn $request_path; #warn $response->as_string; if ($request_path =~ m/\/stream$/ and $response->code == 200) { if (defined $chunk) { if (my $next = shift @expect) { is(substr($chunk, 0, 1), $next , "chunk starts with $next"); } } else { ok(@expect == 0, "got end of stream"); $heap->{testd}->shutdown; $kernel->post( weeble => 'shutdown' ); } } elsif ($request_path =~ m/timeout$/ and $response->code == 408) { ok(1, 'got 408 response for timed out request') } elsif ($request_path =~ m/\/post$/ and $response->code == 200) { ok(1, 'got 200 response for post request') } elsif ($request_path =~ m/\/long$/ and $response->code == 406) { ok(1, 'got 406 response for long request') } elsif ($request_path =~ m/badhost$/ and $response->code == 500) { ok(1, 'got 500 response for request on bad host') } elsif ($request_path =~ m/filesystem$/ and $response->code == 400) { ok(1, 'got 400 response for request with unsupported scheme') } else { ok(0, "unexpected response"); } } POE-Component-Client-HTTP-0.948/t/02_keepalive.t000644 000765 000024 00000010375 12141763331 021131 0ustar00trocstaff000000 000000 # vim: filetype=perl sw=2 ts=2 expandtab use strict; sub DEBUG () { 0 } #sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE qw(Component::Client::HTTP Component::Client::Keepalive); use Test::POE::Server::TCP; use HTTP::Request::Common qw(GET); use Test::More; $| = 1; # set max_per_host, so we can more easily determine whether we're # reusing connections when expected. my $cm = POE::Component::Client::Keepalive->new( max_per_host => 1 ); my @requests; my $data = < Test Page

This page exists to test POE web components.

EOF sub client_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG and warn "client starting...\n"; $_[HEAP]->{testd} = Test::POE::Server::TCP->spawn( filter => POE::Filter::Stream->new, address => 'localhost', ); my $port = $_[HEAP]->{testd}->port; @requests = ( GET("http://localhost:$port/test.cgi?FIRST", Connection => "Keep-Alive"), GET("http://localhost:$port/test.cgi?TEST2", Connection => "Keep-Alive"), GET("http://localhost:$port/test.cgi?TEST3"), GET("http://localhost:$port/test.cgi?TEST4", Connection => "Close"), GET("http://localhost:$port/test.cgi?TEST5"), ); #plan 'no_plan'; plan tests => scalar @requests * 2; } sub testd_registered { my ($kernel) = $_[KERNEL]; my $r = shift @requests; $kernel->post( weeble => request => got_response => $r ); } my $ka = "Connection: Keep-Alive\nKeep-Alive: timeout=2, max=100"; my $cl = "Connection: Close"; sub testd_disconnected { my ($kernel, $heap, $id) = @_[KERNEL, HEAP, ARG0]; if ($heap->{do_shutdown}) { $heap->{testd}->shutdown; } else { is($heap->{prevtype}, 'close', "shutting down a 'close' connection"); } #warn "disconnected $id"; } sub timeout { my ($kernel, $heap, $id) = @_[KERNEL, HEAP, ARG0]; #warn "terminating"; $heap->{do_shutdown} = 1; $heap->{testd}->terminate($id); } sub testd_client_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; #warn $id; if (defined $heap->{previd}) { if ($heap->{prevtype} eq 'reuse') { is($id, $heap->{previd}, "reused connection"); } else { isnt($id, $heap->{previd}, "new connection"); } } ##warn $input; my $tosend = $data; if ($input =~ /Close/) { $heap->{testd}->disconnect($id); $heap->{prevtype} = 'close'; $tosend =~ s/CONNECTION/$cl/; } else { $kernel->delay('timeout', 2, $id); $heap->{prevtype} = 'reuse'; $tosend =~ s/CONNECTION/$ka/; } $heap->{previd} = $id; $heap->{testd}->send_to_client($id, $tosend); } sub client_stop { DEBUG and warn "client stopped...\n"; } sub client_got_response { my ($heap, $kernel, $request_packet, $response_packet) = @_[ HEAP, KERNEL, ARG0, ARG1 ]; my $http_request = $request_packet->[0]; my $http_response = $response_packet->[0]; # DEBUG and "client SECOND_RESPONSE: START"; DEBUG and do { warn "client got request...\n"; my $response_string = $http_response->as_string(); $response_string =~ s/^/| /mg; warn ",", '-' x 78, "\n"; warn $response_string; warn "`", '-' x 78, "\n"; }; my $request_path = $http_request->uri->path . ''; # stringify my $request_uri = $http_request->uri . ''; # stringify is($http_response->code, 200, "got OK response code"); if (@requests) { $kernel->post(weeble => request => got_response => shift @requests); } else { # TODO: figure out why this doesn't trigger an immediate # disconnect on the testd. $cm->shutdown; $cm = undef; } } #------------------------------------------------------------------------------ # Create a weeble component. POE::Component::Client::HTTP->spawn( #MaxSize => MAX_BIG_REQUEST_SIZE, Timeout => 2, ConnectionManager => $cm, ); # Create a session that will make some requests. POE::Session->create( inline_states => { _start => \&client_start, _stop => \&client_stop, got_response => \&client_got_response, }, package_states => [main => [qw( testd_registered testd_client_input testd_disconnected timeout )]], ); # Run it all until done. $poe_kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/03_head_filter.t000644 000765 000024 00000006113 12141763331 021426 0ustar00trocstaff000000 000000 # vim: filetype=perl ts=2 sw=2 expandtab use strict; use warnings; use IO::Handle; use Test::More; plan tests => 10; use_ok('POE::Filter::HTTPHead'); autoflush STDOUT 1; autoflush STDERR 1; my $request_number = 1; my $filter = POE::Filter::HTTPHead->new; my @content = qw(content); my $state = 'head'; while () { #warn "($state) LINE: $_"; if (substr ($_, 0, 5) eq '--end') { my $data = $filter->get_one; $data = $data->[0]; isa_ok($data, 'HTTP::Response'); #warn $data->as_string; if ($request_number == 4) { isnt(defined($data->header('Connection')), 'ignore bogus header'); } if ($state eq 'data') { my $data = $filter->get_pending; use Data::Dumper; $data = $data->[0]; chomp($data); is($data, shift @content, 'got the right content'); #warn Dumper $data; $filter = POE::Filter::HTTPHead->new; } elsif ($request_number == 1) { my $data = $filter->get_pending; cmp_ok(@$data, '==', 0, "Nothing left"); } $state = 'head'; $request_number++; } elsif (substr ($_, 0, 6) eq '--data') { $state = 'data'; } else { $filter->get_one_start([$_]); } } # below is a list of the heads of HTTP responses (i.e with no content) # these are used to drive the tests. # Note that the last one does have a line of content, so we get more # coverage because we switch filters for it # If you want to add a head to test, put it as the first one, # and add a $response_number == n and ok(1, foo) statement to the # input subroutine n should be the number $response_number gets # initialized to right now. Then increase the initialization and # the number of tests planned. __DATA__ HTTP/1.1 202 Accepted --end-- HTTP/1.1 203 Ok Date: Mon, 08 Nov 2004 21:37:20 GMT Server: Apache/2.0.50 (Debian GNU/Linux) DAV/2 SVN/1.0.1-dev mod_ssl/2.0.50 OpenSSL/0.9.7d Last-Modified: Sat, 24 Nov 2001 16:48:12 GMT ETag: "6e-100e-18d96b00" Accept-Ranges: bytes Content-Length: 4110 Connection: close Content-Type: text/html; charset=ISO-8859-1 --end-- this gets treated as a HTTP/0.9 response. 0.9 was silly. garble --end-- HTTP/1.1 204 Ok Date: Mon, 08 Nov 2004 21:37:20 GMT Server: Apache/2.0.50 (Debian GNU/Linux) DAV/2 SVN/1.0.1-dev mod_ssl/2.0.50 OpenSSL/0.9.7d Last-Modified: Sat, 24 Nov 2001 16:48:12 GMT ETag: "6e-100e-18d96b00" Accept-Ranges: bytes Content-Length: 4110 Connection close Content-Type: text/html; charset=ISO-8859-1 --end-- 209 Ok Date: Mon, 08 Nov 2004 21:37:20 GMT Server: Apache/2.0.50 (Debian GNU/Linux) DAV/2 SVN/1.0.1-dev mod_ssl/2.0.50 OpenSSL/0.9.7d Last-Modified: Sat, 24 Nov 2001 16:48:12 GMT ETag: "6e-100e-18d96b00" Accept-Ranges: bytes Content-Length: 4110 Connection: close Content-Type: text/html; charset=ISO-8859-1 --end-- HTTP/1.1 210 Ok Date: Mon, 08 Nov 2004 21:37:20 GMT Server: Apache/2.0.50 (Debian GNU/Linux) DAV/2 SVN/1.0.1-dev mod_ssl/2.0.50 OpenSSL/0.9.7d Last-Modified: Sat, 24 Nov 2001 16:48:12 GMT ETag: "6e-100e-18d96b00" Accept-Ranges: bytes Content-Length: 4110 Connection: close Content-Type: text/html; charset=ISO-8859-1 --data-- content --end-- POE-Component-Client-HTTP-0.948/t/04_chunk_filter.t000644 000765 000024 00000013340 12141763331 021636 0ustar00trocstaff000000 000000 # vim: filetype=perl ts=2 sw=2 expandtab use strict; use warnings; use Test::More; use HTTP::Headers; sub DEBUG () { 0 } plan tests => 20; use_ok ('POE::Filter::HTTPChunk'); { # all chunks in one go. my @results = qw( chunk_333 chunk_4444); my @input = ("9\nchunk_333\nA\nchunk_4444\n0\n"); my $filter = POE::Filter::HTTPChunk->new; my $pending = $filter->get_pending; is ($pending, undef, "got no pending data"); foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is_deeply($output, \@results, "got expected chunks"); } } $pending = $filter->get_pending; # TODO: ugh, must fix this is_deeply ($pending, [''], "got no pending data"); } { # with a fabricated chunk-extension. the filter doesn't handle # those, but they do get ignored, as required. my @results = qw( chunk_333 chunk_4444); my @input = ("9\nchunk_333\nA;foo=bar\nchunk_4444\n0\n"); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is_deeply($output, \@results, "got expected chunks"); } } } { # with garbage before the chunk length my @results = qw( chunk_333 chunk_4444); my @input = ("9\nchunk_333\ngarbage\nA\nchunk_4444\n0\n"); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is(shift @$output, shift @results, "got expected chunk"); } } } { # with trailing headers my @results = ( qw( chunk_1 chunk_22 ), HTTP::Headers->new(Server => 'Apache/1.3.31 (Unix) DAV/1.0.3 mod_gzip/1.3.26.1a PHP/4.3.5 mod_ssl/2.8.19 OpenSSL/0.9.6c'), ); my @input = ("7\nchunk_1\n8\nchunk_22\n0\nServer: Apache/1.3.31 (Unix) DAV/1.0.3 mod_gzip/1.3.26.1a PHP/4.3.5 mod_ssl/2.8.19 OpenSSL/0.9.6c\n\n"); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is_deeply($output, \@results, "got expected chunks"); } } } { # with trailing headers and garbage after my @results = ( qw( chunk_1 chunk_22 ), HTTP::Headers->new(Server => 'Apache/1.3.31 (Unix) DAV/1.0.3 mod_gzip/1.3.26.1a PHP/4.3.5 mod_ssl/2.8.19 OpenSSL/0.9.6c'), ); my @input = ("7\nchunk_1\n8\nchunk_22\n0\nServer: Apache/1.3.31 (Unix) DAV/1.0.3 mod_gzip/1.3.26.1a PHP/4.3.5 mod_ssl/2.8.19 OpenSSL/0.9.6c\n\ngarbage"); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is_deeply($output, \@results, "got expected chunks"); } } my $pending = $filter->get_pending; is (shift @$pending, 'garbage', "got expected pending data"); } { # with whitespace after the chunksize my @results = qw(regular_chunk chunk_length_with_trailing_whitespace); my @input = ("d\nregular_chunk\n25 \nchunk_length_with_trailing_whitespace\n0\n", ); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is_deeply($output, \@results, "got expected chunks"); } } } { # several pieces of input, this time cleverly split so the size # marker can't be read immediately because the ending newline is # in the next piece. my @results = qw( chunk_333 chunk_4444); my @input = ("9\nchunk_333\nA", "\nchunk_4444\n0\n"); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is(shift @$output, shift @results, "got expected chunk"); } } } { # with garbage before the chunk length and some strategic # splits for coverage my @results = qw( chunk_333 chunk_4444); my @input = ("9\nchunk_333\n","garbage","\nA\nchunk_4444\n0\n"); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is(shift @$output, shift @results, "got expected chunk"); } } } { # several pieces of input cleverly split for coverage. my @results = qw( chunk_333 chunk_4444); my @input = ("9\nchunk_333", "\n", "A\nchun", "k_4444\n0\n"); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is(shift @$output, shift @results, "got expected chunk"); } } } { # extra garbage at the end gets retrieved by get_pending() my @results = qw( chunk_333 chunk_4444); my @input = ("9\nchunk_333\nA\nchunk_4444\n0\ngarbage"); my $filter = POE::Filter::HTTPChunk->new; foreach my $data (@input) { $filter->get_one_start( [$data] ); my $output; while ($output = $filter->get_one and @$output > 0) { is_deeply($output, \@results, "got expected chunks"); } } my $pending = $filter->get_pending; is (shift @$pending, 'garbage', "got expected pending data"); } { # extra-extra garbage at the end gets retrieved by get_pending() my @input = ("9\nchunk_333\nA\nchunk_4444\n", "0\n", "7\ngarbage\n", "0\n"); my $filter = POE::Filter::HTTPChunk->new; $filter->get_one_start( \@input ); my $output = $filter->get_one(); is_deeply($output, [qw/chunk_333 chunk_4444/], "got expected chunks"); my $pending = $filter->get_pending; is_deeply($pending, ["7\ngarbage\n0\n"], "got expected pending data"); } POE-Component-Client-HTTP-0.948/t/05_request.t000644 000765 000024 00000002530 12141763331 020651 0ustar00trocstaff000000 000000 # vim: filetype=perl sw=2 ts=2 expandtab use strict; use warnings; use Test::More tests => 7; use POE::Component::Client::HTTP::Request; use HTTP::Request; ok (defined $INC{"POE/Component/Client/HTTP/Request.pm"}, "loaded"); eval {POE::Component::Client::HTTP::Request->new ('one')}; like($@, qr/expects its arguments/, "parameter style"); eval {POE::Component::Client::HTTP::Request->new (one => 'two')}; like($@, qr/need a Request/, "Request parameter"); eval {POE::Component::Client::HTTP::Request->new (Request => 'two')}; like($@, qr/must be a HTTP::Request/, "Request parameter"); ## Commented out in Request.pm #eval { # POE::Component::Client::HTTP::Request->new( # Request => HTTP::Request->new ('http://localhost/') # ) #}; #like($@, qr/need a Tag/, "Tag parameter"); eval { POE::Component::Client::HTTP::Request->new( Request => HTTP::Request->new(GET => 'file:///localhost/') ) }; like($@, qr/need a Factory/, "Factory parameter"); eval { POE::Component::Client::HTTP::Request->new( Request => HTTP::Request->new(GET => 'file:///localhost/'), Factory => 1 ) }; like($@, qr/Can't locate object method "port"/, "Appropriate Request"); my $r = POE::Component::Client::HTTP::Request->new( Request => HTTP::Request->new(GET => 'http://localhost/'), Factory => 1 ); isa_ok ($r, 'POE::Component::Client::HTTP::Request'); POE-Component-Client-HTTP-0.948/t/06_factory.t000644 000765 000024 00000003353 12141763331 020635 0ustar00trocstaff000000 000000 # vim: filetype=perl sw=2 ts=2 expandtab use strict; use warnings; use Test::More tests => 13; use POE::Component::Client::HTTP::RequestFactory; #use HTTP::Request; ok (defined $INC{"POE/Component/Client/HTTP/RequestFactory.pm"}, "loaded"); eval {POE::Component::Client::HTTP::RequestFactory->new('foo')}; like($@, qr/expects its arguments/, "Argument format"); eval {POE::Component::Client::HTTP::RequestFactory->new([])}; like($@, qr/expects its arguments/, "Argument format"); eval {POE::Component::Client::HTTP::RequestFactory->new({Agent => {}})}; like($@, qr/Agent must be/, "Agent parameter"); my $f = POE::Component::Client::HTTP::RequestFactory->new; isa_ok ($f, 'POE::Component::Client::HTTP::RequestFactory'); like ($f->[0]->[0], qr/^POE-Component-Client-HTTP/, 'Agent string'); $f = POE::Component::Client::HTTP::RequestFactory->new({Agent => 'foo'}); is ($f->[0]->[0], 'foo', 'custom Agent string'); eval {POE::Component::Client::HTTP::RequestFactory->new({Proxy => ['foo']})}; like($@, qr/Proxy must contain/, "Proxy parameter as list"); eval {POE::Component::Client::HTTP::RequestFactory->new({Proxy => 'foo'})}; like($@, qr/Proxy must contain/, "Proxy parameter as string"); $f = POE::Component::Client::HTTP::RequestFactory->new({Proxy => 'foo:80'}); is_deeply ($f->[7]->[0], ['foo', 80], 'correct Proxy string'); $f = POE::Component::Client::HTTP::RequestFactory->new({Proxy => ['foo',80]}); is_deeply ($f->[7]->[0], ['foo', 80], 'correct Proxy list'); $f = POE::Component::Client::HTTP::RequestFactory->new( {Protocol => 'HTTP/1.0'} ); is ($f->[3], 'HTTP/1.0', 'Protocol string'); # especially for coverage :) $f = POE::Component::Client::HTTP::RequestFactory->new({Protocol => ''}); is ($f->[3], 'HTTP/1.1', 'empty Protocol string'); POE-Component-Client-HTTP-0.948/t/07_proxy.t000644 000765 000024 00000020272 12141763331 020347 0ustar00trocstaff000000 000000 #! /usr/bin/perl # -*- perl -*- # vim: filetype=perl sw=2 ts=2 expandtab # Contributed by Yuri Karaban. Thank you! use strict; use warnings; use Test::More tests => 9; $SIG{PIPE} = 'IGNORE'; use Socket; use POE; use POE::Session; use POE::Component::Server::TCP; use POE::Component::Client::HTTP; use POE::Filter::HTTPD; use HTTP::Request; use HTTP::Request::Common qw(GET PUT); use HTTP::Response; # We need some control over proxying here. BEGIN { delete $ENV{HTTP_PROXY}; for (qw /HTTP_PROXY http_proxy NO_PROXY no_proxy/) { delete $ENV{$_}; } } POE::Session->create( inline_states => { _child => sub { undef }, _stop => sub { undef }, _start => sub { my $kernel = $_[KERNEL]; $kernel->alias_set('main'); spawn_http('proxy1'); spawn_http('proxy2'); spawn_http('host'); spawn_rproxy(); }, set_port => sub { my ($kernel, $heap, $name, $port) = @_[KERNEL, HEAP, ARG0, ARG1]; $heap->{$name} = "http://127.0.0.1:$port/"; if (++ $_[HEAP]->{ready_cnt} == 4) { $_[KERNEL]->yield('begin_tests'); } }, begin_tests => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; POE::Component::Client::HTTP->spawn(Alias => 'DefProxy', Proxy => $heap->{proxy1}); POE::Component::Client::HTTP->spawn(Alias => 'NoProxy', FollowRedirects => 3); # Test is default proxy working $kernel->post(DefProxy => request => test1_resp => GET $heap->{host}); }, test1_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'proxy1'); # Test is default proxy override working $kernel->post(DefProxy => request => test2_resp => (GET $heap->{host}), undef, undef, $heap->{proxy2}); }, test2_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'proxy2'); # Test per request proxy setting (override with no default proxy) $kernel->post(NoProxy => request => test3_resp => (GET $heap->{host}), undef, undef, $heap->{proxy1}); }, test3_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'proxy1'); # Test when no proxy set at all $kernel->post(NoProxy => request => test4_resp => GET $heap->{host}); }, test4_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'host'); # Test is default proxy works for POST $heap->{cookie} = rand; my $req = HTTP::Request->new(POST => $heap->{host}, ['Content-Length' => length($heap->{cookie})], $heap->{cookie}); $kernel->post(DefProxy => request => test5_resp => $req); }, test5_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; if ($resp->is_success) { my ($name, $content) = split(':', $resp->content); ok($name eq 'proxy1' && $content eq $heap->{cookie}); } else { fail(); } # Test is default proxy override works for POST $heap->{cookie} = rand; my $req = HTTP::Request->new(POST => $heap->{host}, ['Content-Length' => length($heap->{cookie})], $heap->{cookie}); $kernel->post(DefProxy => request => test6_resp => $req, undef, undef, $heap->{proxy2}); }, test6_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; if ($resp->is_success) { my ($name, $content) = split(':', $resp->content); ok($name eq 'proxy2' && $content eq $heap->{cookie}); } else { fail(); } # Test is per request proxy works for POST $heap->{cookie} = rand; my $req = HTTP::Request->new(POST => $heap->{host}, ['Content-Length' => length($heap->{cookie})], $heap->{cookie}); $kernel->post(NoProxy => request => test7_resp => $req, undef, undef, $heap->{proxy1}); }, test7_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; if ($resp->is_success) { my ($name, $content) = split(':', $resp->content); ok($name eq 'proxy1' && $content eq $heap->{cookie}); } else { fail(); } # Test is no for POST $heap->{cookie} = rand; my $req = HTTP::Request->new(POST => $heap->{host}, ['Content-Length' => length($heap->{cookie})], $heap->{cookie}); $kernel->post(NoProxy => request => test8_resp => $req); }, test8_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; if ($resp->is_success) { my ($name, $content) = split(':', $resp->content); ok($name eq 'host' && $content eq $heap->{cookie}); } else { fail(); } $kernel->post(NoProxy => request => test9_resp => (GET 'http://redirect.me/'), undef, undef, $heap->{rproxy}); }, test9_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'rproxy'); $kernel->post(proxy1 => 'shutdown'); $kernel->post(proxy2 => 'shutdown'); $kernel->post(rproxy => 'shutdown'); $kernel->post(host => 'shutdown'); $kernel->post(DefProxy => 'shutdown'); $kernel->post(NoProxy => 'shutdown'); } }, heap => { ready_cnt => 0 } ); POE::Kernel->run(); exit 0; sub spawn_http { my $name = shift; POE::Component::Server::TCP->new( Alias => $name, Address => '127.0.0.1', Port => 0, ClientFilter => 'POE::Filter::HTTPD', ClientInput => sub { unshift @_, $name; &handle_request }, Started => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = (sockaddr_in($heap->{listener}->getsockname))[0]; $kernel->post('main', 'set_port', $name, $port); } ); } sub spawn_rproxy { POE::Component::Server::TCP->new( Alias => 'rproxy', Address => '127.0.0.1', Port => 0, ClientFilter => 'POE::Filter::HTTPD', ClientInput => \&handle_rproxy_request, Started => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = (sockaddr_in($heap->{listener}->getsockname))[0]; $kernel->post('main', 'set_port', 'rproxy', $port); } ); } sub handle_request { my $name = shift; my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0]; if ( $request->isa("HTTP::Response") ) { $heap->{client}->put($request); $kernel->yield("shutdown"); return; } my ($body, $host); if ( ( ( $name =~ /^proxy/ && defined($host = $kernel->alias_resolve('main')->get_heap->{host}) && $request->uri->canonical ne $host ) || ( $name !~ /^proxy/ && $request->uri->canonical ne '/' ) ) ) { $body = 'url does not match'; } else { $body = $name; } if ($request->method eq "POST") { # passthrough cookie $body .= ':' . $request->content; } my $r = HTTP::Response->new( 200, 'OK', ['Connection' => 'Close', 'Content-Type' => 'text/plain'], $body ); $heap->{client}->put($r) if defined $heap->{client}; $kernel->yield("shutdown"); } sub handle_rproxy_request { my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0]; if ($request->isa("HTTP::Response")) { $heap->{client}->put($request); $kernel->yield("shutdown"); return; } my $host = $kernel->alias_resolve('main')->get_heap->{host}; my $r; if ($request->uri->canonical eq 'http://redirect.me/') { $r = HTTP::Response->new (302, 'Moved', ['Connection' => 'Close', 'Content-Type' => 'text/plain', 'Location' => $host ]); } else { $r = HTTP::Response->new ( 200, 'OK', ['Connection' => 'Close', 'Content-Type' => 'text/plain'], $request->uri->canonical eq $host ? 'rproxy' : 'fail' ); } $heap->{client}->put($r) if defined $heap->{client}; $kernel->yield("shutdown"); } POE-Component-Client-HTTP-0.948/t/08_discard.t000644 000765 000024 00000003431 12141763331 020576 0ustar00trocstaff000000 000000 #! /usr/bin/perl # -*- perl -*- # vim: ts=2 sw=2 filetype=perl expandtab use strict; use warnings; use Test::More tests => 1; use POE; use POE::Component::Client::HTTP; use POE::Component::Server::TCP; use HTTP::Request::Common qw(GET); use Socket; POE::Component::Client::HTTP->spawn( Alias => 'ua', Timeout => 2, ); # We are testing against a localhost server. # Don't proxy, because localhost takes on new meaning. BEGIN { delete $ENV{HTTP_PROXY}; delete $ENV{http_proxy}; } POE::Session->create( inline_states => { _start => sub { my ($kernel) = $_[KERNEL]; $kernel->alias_set('Main'); # Spawn discard TCP server POE::Component::Server::TCP->new ( Alias => 'Discard', Address => '127.0.0.1', Port => 0, ClientInput => sub {}, # discard Started => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = (sockaddr_in($heap->{listener}->getsockname))[0]; $kernel->post('Main', 'set_port', $port); } ); }, set_port => sub { my ($kernel, $port) = @_[KERNEL, ARG0]; my $url = "http://127.0.0.1:$port/"; $kernel->post(ua => request => response => GET $url); $kernel->delay(no_response => 10); }, response => sub { my ($kernel, $rspp) = @_[KERNEL, ARG1]; my $rsp = $rspp->[0]; $kernel->delay('no_response'); # Clear timer ok($rsp->code == 408, "received error " . $rsp->code . " (wanted 408)"); $kernel->post(Discard => 'shutdown'); $kernel->post(ua => 'shutdown'); }, no_response => sub { my $kernel = $_[KERNEL]; fail("didn't receive error 408"); $kernel->post(Discard => 'shutdown'); $kernel->post(ua => 'shutdown'); } } ); POE::Kernel->run; exit; POE-Component-Client-HTTP-0.948/t/10_shutdown.t000644 000765 000024 00000005004 12141763331 021027 0ustar00trocstaff000000 000000 #!/usr/bin/perl -w # vim: ts=2 sw=2 filetype=perl expandtab use strict; sub DEBUG () { 0 } sub POE::Kernel::ASSERT_DEFAULT () { DEBUG } use HTTP::Request::Common qw(GET); use Test::More; use Test::POE::Server::TCP; use POE qw(Component::Client::HTTP); plan tests => 2; # Create a weeble component. POE::Component::Client::HTTP->spawn( Timeout => 2 ); # Create a session that will make some requests. POE::Session->create( inline_states => { _start => \&client_start, stop_httpd => \&client_stop, got_response => \&client_got_response, do_shutdown => \&client_got_shutdown, testd_registered => \&testd_got_setup, testd_connected => \&testd_got_input, }, ); # Run it all until done. $poe_kernel->run(); exit; sub client_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG and warn "client starting...\n"; # run a server just in case of a screwup and we *do* get requests. $heap->{testd} = Test::POE::Server::TCP->spawn( Filter => POE::Filter::Stream->new, address => 'localhost', ); $kernel->yield("do_shutdown"); } sub testd_got_setup { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG and warn "client got setup...\n"; my $port = $heap->{testd}->port; for (1..2) { $kernel->post( weeble => request => got_response => GET("http://localhost:$port/test.html", Connection => 'close'), ); } } sub testd_got_input { BAIL_OUT('There should be NO requests'); } sub client_got_shutdown { my $kernel = $_[KERNEL]; DEBUG and warn "client got shutdown...\n"; $kernel->post(weeble => "shutdown"); } sub client_stop { my $heap = $_[HEAP]; DEBUG and warn "client stopped...\n"; if ($heap->{testd}) { $heap->{testd}->shutdown; delete $heap->{testd}; } } sub client_got_response { my ($heap, $kernel, $request_packet, $response_packet) = @_[ HEAP, KERNEL, ARG0, ARG1 ]; my $http_request = $request_packet->[0]; my $http_response = $response_packet->[0]; DEBUG and do { warn "client got response...\n"; warn $http_request->as_string; my $response_string = $http_response->as_string(); $response_string =~ s/^/| /mg; warn ",", '-' x 78, "\n"; warn $response_string; warn "`", '-' x 78, "\n"; }; # Track how many of each response code we get. # Should be two 408s, indicating two connection timeouts. is ($http_response->code, 408, "Got the expected timeout"); # wrong place really, but works since we're not getting anything $kernel->yield('stop_httpd'); } POE-Component-Client-HTTP-0.948/t/11_cancel.t000644 000765 000024 00000006701 12141763331 020407 0ustar00trocstaff000000 000000 #!/usr/bin/perl -w # vim: ts=2 sw=2 filetype=perl expandtab use strict; use HTTP::Request::Common qw(GET); use Test::More; sub DEBUG () { 0 } sub POE::Kernel::ASSERT_DEFAULT () { DEBUG } use POE qw(Component::Client::HTTP Filter::Stream); use Test::POE::Server::TCP; sub MAX_BIG_REQUEST_SIZE () { 4096 } sub MAX_STREAM_CHUNK_SIZE () { 1024 } # Needed for agreement with test CGI. plan tests => 1; # Create the HTTP client session. POE::Component::Client::HTTP->spawn( Streaming => MAX_STREAM_CHUNK_SIZE, Alias => "streamer", ); # Create a session that will make and handle some requests. POE::Session->create( inline_states => { _start => \&client_start, _stop => \&client_stop, got_response => \&client_got_response, got_timeout => \&client_timeout, testd_registered => \&testd_start, testd_client_input => \&testd_input, testd_disconnected => \&testd_disc, testd_client_flushed => \&testd_out, } ); # Run it all until done. my $head = <run(); exit; ### Event handlers begin here. sub client_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG and warn "client starting...\n"; $heap->{testd} = Test::POE::Server::TCP->spawn( Filter => POE::Filter::Stream->new, address => 'localhost', ); } sub testd_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = $heap->{testd}->port; $kernel->post( streamer => request => got_response => GET( "http://localhost:$port/misc/chunk-test.cgi", Connection => 'close', ), ); } sub testd_out { my ($kernel, $heap, $id) = @_[KERNEL, HEAP, ARG0]; return unless ($heap->{datachar} < 26); my $data = "200\n"; my $chr = ord('A') + $heap->{datachar}++; $data .= chr($chr) x 512 . "\n"; $heap->{testd}->send_to_client($id, $data); } sub testd_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; $heap->{testd}->send_to_client($id, $head); $heap->{datachar} = 0; } sub client_stop { DEBUG and warn "client stopped...\n"; } sub testd_disc { DEBUG and warn "server got disconnected..."; $_[HEAP]->{testd}->shutdown; delete $_[HEAP]->{testd}; } my $total_octets_got = 0; my $chunk_buffer = ""; my $next_chunk_character = "A"; sub client_got_response { my ($heap, $request_packet, $response_packet) = @_[HEAP, ARG0, ARG1]; my $http_request = $request_packet->[0]; my ($http_headers, $chunk) = @$response_packet; DEBUG and do { warn "client got stream response...\n"; my $response_string = $http_headers->as_string(); $response_string =~ s/^/| /mg; warn ( ",", '-' x 78, "\n", $response_string, "`", '-' x 78, "\n", ($chunk ? $chunk : "(undef)"), "\n", "`", '-' x 78, "\n", ); }; if (defined $chunk) { $chunk_buffer .= $chunk; $total_octets_got += length($chunk); while (length($chunk_buffer) >= MAX_STREAM_CHUNK_SIZE) { my $next_chunk = substr($chunk_buffer, 0, MAX_STREAM_CHUNK_SIZE); substr($chunk_buffer, 0, MAX_STREAM_CHUNK_SIZE) = ""; $next_chunk_character++; } $_[KERNEL]->call( streamer => cancel => $_[ARG0][0] ); $_[KERNEL]->delay( got_timeout => 2 ); return; } $total_octets_got += length($chunk_buffer); is($total_octets_got, MAX_STREAM_CHUNK_SIZE, "Got the right amount of data"); } sub client_timeout { $_[KERNEL]->post( weeble => 'shutdown' ); } POE-Component-Client-HTTP-0.948/t/12_pod.t000644 000765 000024 00000000265 12141763331 017744 0ustar00trocstaff000000 000000 #!perl -T # vim: ts=2 sw=2 filetype=perl expandtab use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); POE-Component-Client-HTTP-0.948/t/13_pod_coverage.t000644 000765 000024 00000000325 12141763331 021615 0ustar00trocstaff000000 000000 #!perl -T # vim: ts=2 sw=2 filetype=perl expandtab use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); POE-Component-Client-HTTP-0.948/t/14_gzipped_content.t000644 000765 000024 00000010406 12141763331 022356 0ustar00trocstaff000000 000000 #!/usr/bin/perl # vim: filetype=perl ts=2 sw=2 expandtab # Test gzip'd content encoding. use warnings; use strict; use IO::Socket::INET; use Socket '$CRLF', '$LF', '$CR'; use HTTP::Request::Common 'GET'; sub DEBUG () { 0 } # The number of tests must match scalar(@tests). use Test::More; use POE; use POE::Component::Client::HTTP; use POE::Component::Server::TCP; use Net::HTTP::Methods; if ( eval { Net::HTTP::Methods::zlib_ok() } or eval { Net::HTTP::Methods::gunzip_ok() } ) { plan tests => 1; } else { plan skip_all => 'Compress::Zlib no present'; } # eval this so that if it's NOT present we don't barf before we can # call zlib_ok() eval "use Compress::Zlib"; my $test_number = 0; my @server_ports; # A list of test responses, each paired with a subroutine to check # whether the response was parsed. # use YAML; my $original_content = < Sample Document Sample content DONE ## content compression lifted from Apache::Dynagzip ## this is functionally equivalent to mod_gzip, etc. ## so we have a "real-world" piece of encoded content my $gzipped_content; GZIP: { use constant MAGIC1 => 0x1f ; use constant MAGIC2 => 0x8b ; use constant OSCODE => 3 ; use constant MIN_HDR_SIZE => 10 ; # minimum gzip header size use bytes; # Create the first outgoing portion of the content: my $gzipHeader = pack( "C" . MIN_HDR_SIZE, MAGIC1, MAGIC2, Z_DEFLATED(), 0,0,0,0,0,0, OSCODE ); $gzipped_content = $gzipHeader; my $gzip_handler = deflateInit( -Level => Z_BEST_COMPRESSION(), -WindowBits => - MAX_WBITS(), ); $_ = $original_content; my ($out, $status) = $gzip_handler->deflate(\$_); unless (length($out)) { ($out, $status) = $gzip_handler->flush(); } $gzipped_content .= $out; # almost the same thing, but I wanted to go thru all the hoops: if (0) { $_ = $original_content; $gzipped_content = Compress::Zlib::memGzip($_); } } my @tests = ( # Gzipped content decoded correctly. [ ( "HTTP/1.1 200 OK$CRLF" . "Connection: close$CRLF" . "Content-Encoding: gzip$CRLF" . "Content-type: text/plain$CRLF" . $CRLF . "$gzipped_content$CRLF" ), sub { my $response = shift; ok( $response->code() == 200 && $response->decoded_content eq $original_content, "gzip encoded transfers decode correctly" ); }, ], ); # We are testing against a localhost server. # Don't proxy, because localhost takes on new meaning. BEGIN { delete $ENV{HTTP_PROXY}; } # Spawn one server per test response. { foreach (@tests) { POE::Component::Server::TCP->new( Alias => "server_$_", Address => "127.0.0.1", Port => 0, Started => \®ister_port, ClientInputFilter => "POE::Filter::Line", ClientOutputFilter => "POE::Filter::Stream", ClientInput => \&parse_next_request, ); } sub register_port { push( @server_ports, (sockaddr_in($_[HEAP]->{listener}->getsockname()))[0] ); } sub parse_next_request { my $input = $_[ARG0]; DEBUG and diag "got line: [$input]"; return if $input ne ""; my $response = $tests[$test_number][0]; $_[HEAP]->{client}->put($response); $response =~ s/$CRLF/{CRLF}/g; DEBUG and diag "sending: [$response]"; $_[KERNEL]->yield("shutdown"); } } # Spawn the HTTP user-agent component. POE::Component::Client::HTTP->spawn(); # Create a client session to drive the HTTP component. POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->yield("run_next_test"); }, run_next_test => sub { my $port = $server_ports[$test_number]; $_[KERNEL]->post( weeble => request => response => GET "http://127.0.0.1:${port}/" ); }, response => sub { my $response = $_[ARG1][0]; my $test = $tests[$test_number][1]; $test->($response); $_[KERNEL]->post("server_$tests[$test_number]", "shutdown"); if (++$test_number < @tests) { $_[KERNEL]->yield("run_next_test"); } else { $_[KERNEL]->post("weeble", "shutdown"); } }, _stop => sub { undef }, } ); POE::Kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/50_davis_zerolength.t000644 000765 000024 00000004423 12141763331 022533 0ustar00trocstaff000000 000000 #!/usr/bin/perl # vim: ts=2 sw=2 filetype=perl expandtab # Dave Davis' test case for rt.cpan.org ticket #13557: # "Zero length content header causes request to not post back". use warnings; use strict; use Test::More; use Test::POE::Server::TCP; use POE qw(Filter::Stream Component::Client::HTTP); use HTTP::Request::Common qw(GET); POE::Component::Client::HTTP->spawn( Alias => 'ua' ); plan tests => 6; POE::Session->create( inline_states => { _start => \&start, testd_registered => \&testd_start, testd_client_input => \&testd_input, zero_length_response => \&zero_length_response, nonzero_length_response => \&nonzero_length_response, }, ); sub start { my $heap = $_[HEAP]; $heap->{testd} = Test::POE::Server::TCP->spawn( Filter => POE::Filter::Stream->new, address => 'localhost', ); } sub testd_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = $heap->{testd}->port; # Fetch a URL that has no content. $kernel->post( 'ua', 'request', 'zero_length_response', GET "http://localhost:$port/misc/no-content.html" ); # Control test: Fetch a URL that has some content. $kernel->post( 'ua', 'request', 'nonzero_length_response', GET "http://localhost:$port/misc/test.html" ); } sub testd_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; pass("Got request; sending reply"); my $data; if ($input =~ /no-content/) { $data = <<'EOF'; HTTP/1.1 200 OK Connection: close Content-Length: 0 EOF } else { $data = <<'EOF'; HTTP/1.1 200 OK Connection: close Content-Length: 7 content EOF } $heap->{testd}->send_to_client($id, $data); } sub zero_length_response { my ($request_packet, $response_packet) = @_[ARG0, ARG1]; my $request_object = $request_packet->[0]; my $response_object = $response_packet->[0]; pass("... got a response"); is($response_object->content, '', "... and it has no content"); } sub nonzero_length_response { my ($request_packet, $response_packet) = @_[ARG0, ARG1]; my $request_object = $request_packet->[0]; my $response_object = $response_packet->[0]; pass("... got a response"); isnt($response_object, '', "... and it has content"); $_[HEAP]->{testd}->shutdown; $_[KERNEL]->post( ua => 'shutdown' ); } POE::Kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/51_santos_status.t000644 000765 000024 00000001514 12141763331 022075 0ustar00trocstaff000000 000000 # vim: filetype=perl ts=2 sw=2 expandtab use strict; use warnings; use Test::More tests => 4; use_ok("POE::Filter::Line"); use_ok("POE::Filter::HTTPHead"); use IO::Handle; use IO::File; STDOUT->autoflush(1); my $request_number = 8; my $http_head_filter = POE::Filter::HTTPHead->new(); sysseek(DATA, tell(DATA), 0); while () { $http_head_filter->get_one_start([ $_ ]); } my $http_header = $http_head_filter->get_one()->[0]; ok($http_header->isa("HTTP::Response"), "headers received"); my $line_filter = POE::Filter::Line->new(); $line_filter->get_one_start( $http_head_filter->get_pending() || [] ); my $line_data = $line_filter->get_one()->[0]; is($line_data, "Test Content.", "content received"); # Below is an HTTP response that consists solely of a status line and # some content. __DATA__ HTTP/1.0 200 OK Test Content. POE-Component-Client-HTTP-0.948/t/52_reiss_bad_length.t000644 000765 000024 00000006467 12141763331 022474 0ustar00trocstaff000000 000000 #!/usr/bin/perl # vim: ts=2 sw=2 filetype=perl expandtab # There are cases where POE::Component::Client::HTTP generates no # responses. This exercises some of them. # This also test cases where, after the above bug was fix, # the HTTP::Response objects would be incomplete. use warnings; use strict; use IO::Socket::INET; use Socket '$CRLF'; use HTTP::Request::Common 'GET'; sub POE_ASSERT_DEFAULT() { 1 } sub DEBUG () { 0 } # The number of tests must match scalar(@responses) * 2. use Test::More tests => 8; use POE; use POE::Component::Client::HTTP; use POE::Component::Server::TCP; my @server_ports; my @done_responses; my @responses = ( # Content-Length > length of actual content. ( "HTTP/1.1 200 OK$CRLF" . "Connection: close$CRLF" . "Content-Length: 8$CRLF" . "Content-type: text/plain$CRLF" . $CRLF . "Content" ), # No Content-Length header at all. ( "HTTP/1.1 200 OK$CRLF" . "Connection: close$CRLF" . "Content-type: text/plain$CRLF" . $CRLF . "Content" ), # Response is "HTTP::Response" ( "HTTP/1.1 200 OK$CRLF" . "Connection: close$CRLF" . "Content-Length: " . length("HTTP::Response") . $CRLF . "Content-type: text/plain$CRLF" . $CRLF . "HTTP::Response" ), # The status line here causes PoCo::Client::HTTP to crash. There's # the space after the status code but no "OK". ( "HTTP/1.1 200 " . $CRLF . "Content-type: text/plain" . $CRLF . "Connection: close" . $CRLF . $CRLF . "Content" ), ); # Spawn one server per test response. { foreach (@responses) { POE::Component::Server::TCP->new( Alias => "server_$_", Address => "127.0.0.1", Port => 0, Started => \®ister_port, ClientInputFilter => "POE::Filter::Line", ClientOutputFilter => "POE::Filter::Stream", ClientInput => \&parse_next_request, ); } sub register_port { push( @server_ports, (sockaddr_in($_[HEAP]->{listener}->getsockname()))[0] ); } sub parse_next_request { my $input = $_[ARG0]; DEBUG and diag "got line: [$input]"; return if $input ne ""; my $response = pop @responses; push @done_responses, $response; $_[HEAP]->{client}->put($response); $response =~ s/$CRLF/{CRLF}/g; DEBUG and diag "sending: [$response]"; $_[KERNEL]->yield("shutdown"); } } # Spawn the HTTP user-agent component. POE::Component::Client::HTTP->spawn(); # Create a client session to drive the HTTP component. POE::Session->create( inline_states => { _start => sub { foreach my $port (@server_ports) { $_[KERNEL]->post( weeble => request => response => GET "http://127.0.0.1:${port}/" ); } }, response => sub { my $response = $_[ARG1][0]; my $content = $response->content(); $content =~ s/\x0D/{CR}/g; $content =~ s/\x0A/{LF}/g; pass "got a response, content = ($content)"; ok( defined($response->request), "response has corresponding request object set" ); return if @responses; foreach (@done_responses) { $_[KERNEL]->post("server_$_", "shutdown"); } $_[KERNEL]->post('weeble', 'shutdown'); }, _stop => sub { undef }, } ); POE::Kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/53_response_parser.t000644 000765 000024 00000011212 12141763331 022373 0ustar00trocstaff000000 000000 #!/usr/bin/perl # vim: filetype=perl ts=2 sw=2 expandtab # Generic response parser testing, especially for cases where # POE::Component::Client::HTTP generates the wrong response. use warnings; use strict; use IO::Socket::INET; use Socket '$CRLF', '$LF'; use HTTP::Request::Common 'GET'; sub DEBUG () { 0 } # The number of tests must match scalar(@tests). use Test::More tests => 5; use POE; use POE::Component::Client::HTTP; use POE::Component::Server::TCP; my $test_number = 0; my @server_ports; # A list of test responses, each paired with a subroutine to check # whether the response was parsed. my @tests = ( # Unknown transfer encodings must be preserved. [ ( "HTTP/1.1 200 OK$CRLF" . "Connection: close$CRLF" . "Transfer-Encoding: poit,narf,chunked$CRLF" . "Content-type: text/plain$CRLF" . $CRLF . "7$CRLF" . "chunk 1$CRLF" . "0$CRLF" ), sub { my $response = shift; ok( $response->header("X-PCCH-Peer") =~ /^127\.0\.0\.1.\d+$/, "peer address header" ); ok( $response->code() == 200 && $response->header("Transfer-Encoding") eq "poit, narf", "unknown transfer encodings preserved" ); }, ], # An HTTP/0.9 response without LF. [ ( "Test" . "HTTP/0.9 Allows documents with no status and no headers!" . "" ), sub { my $response = shift; ok( $response->code() == 200 && $response->content() =~ /Allows documents/ && $response->protocol() eq 'HTTP/0.9' && $response->header('Content-Type') =~ /html/, "HTTP 0.9 supports no status and no headers, no LF" ); }, ], # A multi-line HTTP/0.9 response. [ ( "Test" . $LF . "HTTP/0.9 Allows documents with no status and no headers!" . $LF . "" . $LF ), sub { my $response = shift; ok( $response->code() == 200 && $response->content() =~ /Allows documents/ && $response->protocol() eq 'HTTP/0.9' && $response->header('Content-Type') =~ /html/ && $response->content() =~ m!!, "HTTP 0.9 supports no status and no headers, multiple lines" ) }, ], # A response with no known transfer encoding. [ ( "HTTP/1.1 200 OK$CRLF" . "Connection: close$CRLF" . "Transfer-Encoding: zort,poit,narf$CRLF" . "Content-type: text/plain$CRLF" . $CRLF . "7$CRLF" . "chunk 1$CRLF" . "0$CRLF" ), sub { my $response = shift; ok( $response->code() == 200 && $response->header("Transfer-Encoding") eq "zort, poit, narf", "no known transfer encodings" ); }, ], ); # We are testing against a localhost server. # Don't proxy, because localhost takes on new meaning. BEGIN { delete $ENV{HTTP_PROXY}; } # Spawn one server per test response. { foreach (@tests) { POE::Component::Server::TCP->new( Alias => "server_$_", Address => "127.0.0.1", Port => 0, Started => \®ister_port, ClientInputFilter => "POE::Filter::Line", ClientOutputFilter => "POE::Filter::Stream", ClientInput => \&parse_next_request, ); } sub register_port { push( @server_ports, (sockaddr_in($_[HEAP]->{listener}->getsockname()))[0] ); } sub parse_next_request { my $input = $_[ARG0]; DEBUG and diag "got line: [$input]"; return if $input ne ""; my $response = $tests[$test_number][0]; $_[HEAP]->{client}->put($response); $response =~ s/$CRLF/{CRLF}/g; DEBUG and diag "sending: [$response]"; $_[KERNEL]->yield("shutdown"); } } # Spawn the HTTP user-agent component. POE::Component::Client::HTTP->spawn(); # Create a client session to drive the HTTP component. POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->yield("run_next_test"); }, run_next_test => sub { my $port = $server_ports[$test_number]; $_[KERNEL]->post( weeble => request => response => GET "http://127.0.0.1:${port}/" ); }, response => sub { my $response = $_[ARG1][0]; my $test = $tests[$test_number][1]; $test->($response); $_[KERNEL]->post("server_$tests[$test_number]", "shutdown"); if (++$test_number < @tests) { $_[KERNEL]->yield("run_next_test"); } else { $_[KERNEL]->post("weeble", "shutdown"); } }, _stop => sub { undef }, } ); POE::Kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/54_hzheng_head_redir.t000644 000765 000024 00000004522 12141763331 022621 0ustar00trocstaff000000 000000 #! /usr/bin/perl # vim: ts=2 sw=2 filetype=perl expandtab # Test case for POE::Component::Client::HTTP failing to redirect HEAD # requests. use strict; use warnings; sub DEBUG () { 0 }; use Test::More tests => 2; use Test::POE::Server::TCP; use POE qw(Component::Client::HTTP); use HTTP::Request::Common qw(HEAD); POE::Component::Client::HTTP->spawn( Alias => 'no_redir' ); POE::Component::Client::HTTP->spawn( Alias => 'redir', FollowRedirects => 5 ); POE::Session->create( inline_states => { _start => \&start, testd_registered => \&testd_start, testd_client_input => \&testd_input, manual => \&manual, automatic => \&automatic, } ); sub start { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG and warn "client starting...\n"; $heap->{testd} = Test::POE::Server::TCP->spawn( Filter => POE::Filter::Stream->new, address => 'localhost', ); } sub testd_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = $heap->{testd}->port; $kernel->post( no_redir => request => manual => HEAD "http://localhost:$port/redir" ); } sub testd_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; my $port = $heap->{testd}->port; my $data; if ($input =~ /redir/) { $data = <<"EOF"; HTTP/1.1 303 See Other Location: http://localhost:$port/destination EOF } else { $data = <<'EOF'; HTTP/1.1 200 Ok Host: EOF } $heap->{testd}->send_to_client($id, $data); } sub manual { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $response = $_[ARG1][0]; my $code = $response->code(); if ($code =~ /^3/) { $kernel->post( no_redir => request => manual => HEAD $response->header("location") ); return; } $heap->{destination} = $_[ARG0][0]->header("host"); my $port = $heap->{testd}->port; $kernel->post( redir => request => automatic => HEAD "http://localhost:$port/redir" ); } sub automatic { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $rsp = $_[ARG1][0]; my $code = $rsp->code(); is($code, 200, "got correct response code"); my $rsp_host = $rsp->request->header("host"); my $exp_host = $heap->{destination}; is( $rsp_host, $exp_host, "automatic redirect host matches manual result"); $heap->{testd}->shutdown; $kernel->post( no_redir => 'shutdown' ); $kernel->post( redir => 'shutdown' ); } POE::Kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/55_reiss_double_resp.t000644 000765 000024 00000012054 12141763331 022700 0ustar00trocstaff000000 000000 #!/usr/bin/perl # vim: ts=2 sw=2 filetype=perl expandtab # This tests cases where a socket it reused in spite of # the entire response not having been read off the socket. use warnings; use strict; use IO::Socket::INET; use Socket '$CRLF'; use HTTP::Request::Common 'GET'; sub POE_ASSERT_DEFAULT () { 1 } sub DEBUG () { 0 } use Test::More tests => 9; use POE; use POE::Component::Client::HTTP; use POE::Component::Server::TCP; my $port; my @responses; my @cases = ( { number => 1, tries_left => 1, request => sub { [ "HTTP/1.1 302 Moved$CRLF" . "Location: http://127.0.0.1:${port}/stuff$CRLF" . "Connection: close$CRLF" . "Content-type: text/plain$CRLF" . $CRLF . "Line 1 of the redirect", "Line 2 of the redirect", "Line 3 of the redirect", "", # keep the connection open, maybe "", "", "", ]; }, }, { number => 2, tries_left => 2, request => sub { [ "HTTP/1.1 200 OK$CRLF" . "Connection: close$CRLF" . "Content-type: text/plain$CRLF$CRLF" . ("Too Much" x 64), "", "", "", "", "", "", "", "should not appear", "should not appear", "should not appear", "should not appear", "should not appear" ]; }, } ); my $case = shift @cases; spawn_server(); sub set_responses { # Sub call to create a new copy each time. @responses = $case->{request}->(); } ### Server. my $server_alias; sub spawn_server { $server_alias = "server_$case->{number}"; POE::Component::Server::TCP->new( Alias => $server_alias, Address => "127.0.0.1", Port => 0, Started => \®ister_port, ClientConnected => \&connected, ClientInputFilter => "POE::Filter::Line", ClientOutputFilter => "POE::Filter::Stream", ClientInput => \&parse_next_request, Concurrency => 1, InlineStates => {next_part => \&next_part}, ); } sub connected { DEBUG and diag "server: received new connection - shutting down"; $_[KERNEL]->post($server_alias => 'shutdown'); } sub register_port { $port = (sockaddr_in($_[HEAP]->{listener}->getsockname()))[0]; set_responses(); } sub next_part { my $left = $_[ARG0]; my $next = shift @$left; if (!$_[HEAP]->{client}) { $_[KERNEL]->yield('shutdown'); return; } $_[HEAP]->{client}->put($next); DEBUG and diag "server: sent [$next]\n"; if (@$left) { $_[KERNEL]->delay(next_part => 0.1 => $left); } else { $_[KERNEL]->yield('shutdown'); } } sub parse_next_request { my $input = $_[ARG0]; DEBUG and diag "server: received [$input]"; return if $input ne ""; if (!$_[HEAP]->{in_progress}++) { my $response = pop @responses; $_[KERNEL]->yield(next_part => [@$response]); } } ### CLIENT # Spawn the HTTP user-agent component. POE::Component::Client::HTTP->spawn( FollowRedirects => 3, MaxSize => 512, Timeout => 2, ); # Create a client session to drive the HTTP component. POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->yield('begin'); }, begin => sub { # Request a redirect. $_[KERNEL]->post( weeble => request => response => GET "http://127.0.0.1:${port}/" ); }, response => sub { my $response = $_[ARG1][0]; my $content = $response->content(); $content =~ s/\x0D/{CR}/g; $content =~ s/\x0A/{LF}/g; pass "got a response, content = ($content)"; ok( defined $response->request, "response has corresponding request object set" ); if ($case->{number} == 1) { # Case 1 redirects to a dead port. We should get a 400. ok( ($response->code == 500) || ($response->code == 408), "case 1 redirect to dead server returns 500" ); } elsif ($case->{number} == 2) { if ($case->{tries_left} == 2) { # Case 2.2 tests whether excess content triggers socket reuse. is($response->code, 406, "case 2.2 response is too long"); } elsif ($case->{tries_left} == 1) { # Case 2.1 redirects to a dead port. We should get a 400. is($response->code, 500, "case 2.1 redirect to dead server = 500"); } } $case->{tries_left}--; # Somehow we got too many responses. if ($case->{tries_left} < 0) { fail("too many responses"); return; } # There are tries remaining in this case. Try again. if ($case->{tries_left}) { DEBUG and diag "client: requests left in this set"; $_[KERNEL]->delay('begin' => 0.6); return; } # We're done if no cases remain. unless (@cases) { $_[KERNEL]->post(weeble => 'shutdown'); return; } # Next case, please. $case = shift @cases; spawn_server(); $_[KERNEL]->yield('begin'); }, } ); POE::Kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/56_redirect_excess.t000644 000765 000024 00000004723 12141763331 022350 0ustar00trocstaff000000 000000 #!/usr/bin/perl # vim: ts=2 sw=2 filetype=perl expandtab # This tests for a case where a redirect and incorrect content-length # will cause two responses to be generated for one request. use warnings; use strict; use IO::Socket::INET; use Socket '$CRLF'; use HTTP::Request::Common 'GET'; sub POE_ASSERT_DEFAULT() { 1 } sub DEBUG () { 0 } use Test::More tests => 3; use POE; use POE::Component::Client::HTTP; use POE::Component::Server::TCP; my $port; my $response; sub fix_response { $response = "HTTP/1.1 302 Moved$CRLF" . "Connection: close$CRLF" . "Content-length: 0$CRLF" . "Content-type: text/plain$CRLF" . "Location: http://127.0.0.1:${port}$CRLF" . $CRLF . "Not really content$CRLF" } # Spawn one server per test response. { POE::Component::Server::TCP->new( Alias => "tcp_server", Address => "127.0.0.1", Port => 0, Started => \®ister_port, ClientInputFilter => "POE::Filter::Line", ClientOutputFilter => "POE::Filter::Stream", ClientInput => \&parse_next_request, ); sub register_port { $port = (sockaddr_in($_[HEAP]->{listener}->getsockname()))[0]; fix_response(); } sub parse_next_request { my $input = $_[ARG0]; DEBUG and diag "got line: [$input]"; return if $input ne ""; $_[HEAP]->{client}->put($response); DEBUG and diag "sending"; $_[KERNEL]->yield("shutdown"); } } # Spawn the HTTP user-agent component. POE::Component::Client::HTTP->spawn( FollowRedirects => 1 ); # Create a client session to drive the HTTP component. POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->post( weeble => request => response => GET "http://127.0.0.1:${port}/" ); }, response => sub { my $response = $_[ARG1][0]; my $content = $response->content(); ++$_[HEAP]->{response_num}; $content =~ s/\x0D/{CR}/g; $content =~ s/\x0A/{LF}/g; pass "got a response, content = ($content)"; ok(defined $response->request, "response has corresponding request object set"); $_[KERNEL]->delay(dummy => 1.0); # so we can get any belated stupidity }, dummy=> sub { $_[KERNEL]->post("tcp_server", "shutdown"); $_[KERNEL]->post("weeble", "shutdown"); }, _stop => sub { is( 1, $_[HEAP]->{response_num}, 'correct number of responses recieved' ); }, } ); POE::Kernel->run(); exit; POE-Component-Client-HTTP-0.948/t/57_pravus_progress.t000644 000765 000024 00000003227 12141763331 022440 0ustar00trocstaff000000 000000 # See rt.cpan.org ticket 36627. # vim: filetype=perl ts=2 sw=2 expandtab use warnings; use strict; use Test::More tests => 2; use HTTP::Request::Common qw(GET); use POE; use POE::Component::Client::HTTP; use Test::POE::Server::TCP; POE::Component::Client::HTTP->spawn( Alias => 'ua', Streaming => 4000, FollowRedirects => 32, ); POE::Session->create( package_states => [ main => [ qw( _start http_response http_progress _stop testd_registered testd_client_input idle_timeout ) ], ], ); POE::Kernel->run(); exit 0; sub _start { $_[HEAP]{testd} = Test::POE::Server::TCP->spawn( filter => POE::Filter::Stream->new(), address => 'localhost', ); $_[HEAP]{got_response} = 0; $_[HEAP]{got_progress} = 0; } sub testd_registered { my $port = $_[HEAP]{testd}->port(); $_[KERNEL]->post( ua => request => 'http_response', GET("http://localhost:$port/"), 'id', 'http_progress' ); } sub testd_client_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; $heap->{testd}->send_to_client( $id, "HTTP/1.0 200 OK\x0d\x0a" . "Content-Length: 100000\x0d\x0a" . "Content-Type: text/html\x0d\x0a" . "\x0d\x0a" . "!" x 100_000 ); } sub http_response { $_[HEAP]{got_response}++; $_[KERNEL]->delay(idle_timeout => 1); } sub http_progress { $_[HEAP]{got_progress}++; $_[KERNEL]->delay(idle_timeout => 1); } sub idle_timeout { $_[HEAP]{testd}->shutdown(); $_[KERNEL]->post(ua => "shutdown"); } sub _stop { ok($_[HEAP]{got_response}, "got response: $_[HEAP]{got_response}"); ok($_[HEAP]{got_progress}, "got progress: $_[HEAP]{got_progress}"); } POE-Component-Client-HTTP-0.948/t/58_joel_cancel_multi.t000644 000765 000024 00000004700 12141763331 022642 0ustar00trocstaff000000 000000 #!perl # vim: ts=2 sw=2 filetype=perl expandtab # simple test case to exhibit behaviour where PoCoClHTTP fails when cancelling # a request before connection pool connections have been established use strict; use warnings; use HTTP::Request; use HTTP::Status; use Test::More; plan tests => 4; use constant DEBUG => 0; sub POE::Kernel::TRACE_EVENTS () { 0 } sub POE::Kernel::TRACE_REFCNT () { 0 } sub POE::Kernel::CATCH_EXCEPTIONS () { 0 } use Test::POE::Server::TCP; use POE qw(Filter::Stream Component::Client::HTTP); POE::Component::Client::HTTP->spawn( Alias => 'ua' ); POE::Session->create( inline_states => { _start => \&client_start, response => \&response_handler, testd_registered => \&testd_start, testd_client_input => \&testd_input, } ); our %responses; eval { POE::Kernel->run(); }; ok (!$@, "cancelling req before connection succeeds does not die"); diag($@) if $@; exit; sub client_start{ my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG and warn "client starting...\n"; $heap->{testd} = Test::POE::Server::TCP->spawn( Filter => POE::Filter::Stream->new, address => 'localhost', ); } sub testd_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = $heap->{testd}->port; my $request = HTTP::Request->new('GET', "http://localhost:$port/cancel"); my $req2 = HTTP::Request->new('GET', "http://localhost:$port/one"); $_[KERNEL]->post( ua => request => response => $request ); $_[KERNEL]->post( ua => request => response => $req2 ); $_[KERNEL]->post( ua => cancel => $request ); } sub testd_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; my $data = <<'EOF'; HTTP/1.1 204 OK EOF if ($input =~ /(?:one|two)/) { pass("got expected request"); $heap->{testd}->send_to_client($id, $data); } elsif ($input =~ /cancel/) { fail("got request that was supposed to be cancelled"); $heap->{testd}->send_to_client($id, $data); } else { BAIL_OUT("got a request that isn't even supposed to exist"); } } sub response_handler { my $heap = $_[HEAP]; my $response = $_[ARG1][0]; my $request = $_[ARG0][0]; my $path = $request->uri->path; if ($path eq '/cancel') { is ($response->code, 408, "got a correct response code for the cancelled request"); } elsif ($path eq '/one') { is ($response->code, 204, "got a correct response code for the non-cancelled request"); $heap->{testd}->shutdown; $_[KERNEL]->post( ua => 'shutdown' ); } } POE-Component-Client-HTTP-0.948/t/59_incomplete_b.t000644 000765 000024 00000004754 12141763331 021644 0ustar00trocstaff000000 000000 # vim: filetype=perl ts=2 sw=2 expandtab use strict; use warnings; use HTTP::Request; use HTTP::Status; use Test::More; plan tests => 4; use constant DEBUG => 0; sub POE::Kernel::TRACE_EVENTS () { 0 } sub POE::Kernel::TRACE_REFCNT () { 0 } sub POE::Kernel::CATCH_EXCEPTIONS () { 0 } use Test::POE::Server::TCP; use POE qw(Filter::Stream Component::Client::HTTP); POE::Component::Client::HTTP->spawn( Alias => 'ua', MaxSize => 50, Timeout => 2, ); POE::Session->create( inline_states => { _start => \&client_start, response => \&response_handler, testd_registered => \&testd_start, testd_client_input => \&testd_input, } ); our %responses; POE::Kernel->run; exit; sub client_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG and warn "client starting...\n"; $heap->{testd} = Test::POE::Server::TCP->spawn( Filter => POE::Filter::Stream->new, address => 'localhost', ); } sub testd_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = $heap->{testd}->port; $kernel->post( ua => request => response => HTTP::Request->new('GET', "http://localhost:$port/content_length") ); $kernel->post( ua => request => response => HTTP::Request->new('GET', "http://localhost:$port/no_length") ); $heap->{query_count} = 2; } sub testd_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; my $content_length_data = <<'EOF'; HTTP/1.1 200 OK Content-Length: 60 123456789 123456789 123456789 123456789 123456789 123456789 EOF my $no_content_length_data = <<'EOF'; HTTP/1.1 200 OK 123456789 123456789 123456789 123456789 123456789 123456789 EOF if ($input =~ /(?:content_length)/) { pass("got expected content-length request"); $heap->{testd}->send_to_client($id, $content_length_data); } elsif ($input =~ /(?:no_length)/) { pass("got expected no-content-length request"); $heap->{testd}->send_to_client($id, $no_content_length_data); } else { BAIL_OUT("got a request that isn't even supposed to exist"); } } sub response_handler { my $heap = $_[HEAP]; my $response = $_[ARG1][0]; my $request = $_[ARG0][0]; my $path = $request->uri->path; if ($path eq '/content_length') { is($response->code, 406, 'content-length triggered 406'); } elsif ($path eq '/no_length') { is($response->code, 406, 'length(content) triggered 406'); } return if --$heap->{query_count}; $heap->{testd}->shutdown(); $_[KERNEL]->post( ua => 'shutdown' ); } POE-Component-Client-HTTP-0.948/t/60_rt50231_pending.t000644 000765 000024 00000006022 12141763331 021706 0ustar00trocstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use POE qw( Filter::Stream Component::Client::HTTP Component::Client::Keepalive ); use HTTP::Request::Common qw(GET); use Test::More; use Test::POE::Server::TCP; plan tests => 2 * 3; my $data = < Test Page

This page exists to test POE web components.

EOF # limit parallelism to 1 request at a time my $pool = POE::Component::Client::Keepalive->new( keep_alive => 10, # seconds to keep connections alive max_open => 1, # max concurrent connections - total max_per_host => 1, # max concurrent connections - per host timeout => 30, # max time (seconds) to establish a new connection ); my $http_alias = 'ua'; POE::Component::Client::HTTP->spawn( Alias => $http_alias, Timeout => 30, FollowRedirects => 1, ConnectionManager => $pool, ); POE::Session->create( inline_states => { _start => \&_start, _response => \&_response, testd_registered => \&testd_reg, testd_client_input => \&testd_input, }, heap => { pending_requests => 0, }, ); POE::Kernel->run; sub _start { my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; $_[HEAP]->{testd} = Test::POE::Server::TCP->spawn( filter => POE::Filter::Stream->new, address => 'localhost', ); return; } sub testd_reg { my ($kernel) = $_[KERNEL]; for ( 1 .. 2 ) { $kernel->post( $http_alias, request => '_response', GET( "http://localhost:" . $_[HEAP]->{testd}->port . "/test", Connection => 'close' ), $_, ); $_[HEAP]->{pending_requests}++; } return; } sub testd_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; $heap->{input_buffer} .= $input; my $buffer = $heap->{input_buffer}; if ($buffer =~ /^GET \/test/) { pass("got test request"); $heap->{input_buffer} = ""; $heap->{testd}->send_to_client($id, $data); } else { diag("INPUT: $input"); diag("unexpected test"); } } sub _response { my ( $heap, $kernel, $request_packet, $response_packet ) = @_[ HEAP, KERNEL, ARG0, ARG1 ]; $heap->{pending_requests}--; my $request = $request_packet->[0]; my $id = $request_packet->[1]; my $response = $response_packet->[0]; my $ua_pending = $kernel->call($http_alias => 'pending_requests_count'); my $actual_pending = $heap->{pending_requests}; cmp_ok( $ua_pending, '==', $actual_pending, "pending count matches reality for $id" ); if ( $response->is_success ) { pass("got response data"); } else { fail("got response data"); diag( ' HTTP Error: ' . $response->code . ' ' . ( $response->message || '' ) ); } # lets shut down if its the last response if ( $heap->{pending_requests} == 0 ) { $kernel->call( $http_alias => 'shutdown' ); $heap->{testd}->shutdown; } return; } POE-Component-Client-HTTP-0.948/t/60_rt50231_pending_many.t000644 000765 000024 00000006443 12141763331 022741 0ustar00trocstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use POE qw( Filter::Stream Component::Client::HTTP Component::Client::Keepalive ); use HTTP::Request::Common qw(GET); use Test::More; use Test::POE::Server::TCP; plan tests => 5 * 3; my $data = < Test Page

This page exists to test POE web components.

EOF # limit parallelism to 10 requests at a time my $pool = POE::Component::Client::Keepalive->new( keep_alive => 10, # seconds to keep connections alive max_open => 10, # max concurrent connections - total max_per_host => 10, # max concurrent connections - per host timeout => 30, # max time (seconds) to establish a new connection ); my $http_alias = 'ua'; POE::Component::Client::HTTP->spawn( Alias => $http_alias, Timeout => 30, FollowRedirects => 1, ConnectionManager => $pool, ); POE::Session->create( inline_states => { _start => \&_start, _response => \&_response, testd_registered => \&testd_reg, testd_client_input => \&testd_input, }, heap => { pending_requests => 0, }, ); POE::Kernel->run; sub _start { my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; $_[HEAP]->{testd} = Test::POE::Server::TCP->spawn( filter => POE::Filter::Stream->new, address => 'localhost', ); return; } sub testd_reg { my ($kernel) = $_[KERNEL]; for ( 1 .. 5 ) { $kernel->post( $http_alias, request => '_response', GET( "http://localhost:" . $_[HEAP]->{testd}->port . "/test", Connection => 'close' ), $_, ); $_[HEAP]->{pending_requests}++; } return; } sub testd_input { my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1]; $heap->{input_buffer} .= $input; my $buffer = $heap->{input_buffer}; if ($buffer =~ /^GET \/test/) { pass("got test request"); $heap->{input_buffer} = ""; $heap->{testd}->send_to_client($id, $data); } else { diag("INPUT: $input"); diag("unexpected test"); } } sub _response { my ( $heap, $kernel, $request_packet, $response_packet ) = @_[ HEAP, KERNEL, ARG0, ARG1 ]; $heap->{pending_requests}--; my $request = $request_packet->[0]; my $id = $request_packet->[1]; my $response = $response_packet->[0]; my $ua_pending = $kernel->call($http_alias => 'pending_requests_count'); my $actual_pending = $heap->{pending_requests}; TODO: { # TODO Generally the count matches up, but sometimes we're off by 1 because it's still in the POE queue # Nothing much we can do, this test is here just for kicks, really... local $TODO = "Setting parallelism screws with timing"; cmp_ok( $ua_pending, '==', $actual_pending, "pending count matches reality for $id" ); }; if ( $response->is_success ) { pass("got response data"); } else { fail("got response data"); diag( ' HTTP Error: ' . $response->code . ' ' . ( $response->message || '' ) ); } # lets shut down if its the last response if ( $heap->{pending_requests} == 0 ) { $kernel->call( $http_alias => 'shutdown' ); $heap->{testd}->shutdown; } return; } POE-Component-Client-HTTP-0.948/t/release-pod-coverage.t000644 000765 000024 00000000765 12141763331 022656 0ustar00trocstaff000000 000000 #!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; eval "use Pod::Coverage::TrustPod"; plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" if $@; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); POE-Component-Client-HTTP-0.948/t/release-pod-syntax.t000644 000765 000024 00000000450 12141763331 022400 0ustar00trocstaff000000 000000 #!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); POE-Component-Client-HTTP-0.948/lib/POE/000755 000765 000024 00000000000 12141763331 017416 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/lib/POE/Component/000755 000765 000024 00000000000 12141763331 021360 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/lib/POE/Filter/000755 000765 000024 00000000000 12141763331 020643 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/lib/POE/Filter/HTTPChunk.pm000644 000765 000024 00000020217 12141763331 022753 0ustar00trocstaff000000 000000 package POE::Filter::HTTPChunk; { $POE::Filter::HTTPChunk::VERSION = '0.948'; } # vim: ts=2 sw=2 expandtab use warnings; use strict; use Carp; use bytes; use base 'POE::Filter'; use HTTP::Response; use constant FRAMING_BUFFER => 0; use constant CURRENT_STATE => 1; use constant CHUNK_SIZE => 2; use constant CHUNK_BUFFER => 3; use constant TRAILER_HEADERS => 4; use constant STATE_SIZE => 0x01; # waiting for a status line use constant STATE_DATA => 0x02; # received status, looking for header or end use constant STATE_TRAILER => 0x04; # received status, looking for header or end use constant DEBUG => 0; sub new { my ($class) = @_; my $self = bless [ [], # FRAMING_BUFFER STATE_SIZE, # CURRENT_STATE 0, # CHUNK_SIZE '', # CHUNK_BUFFER undef, # TRAILER_HEADERS ], $class; return $self; } my $HEX = qr/[\dA-Fa-f]/o; =for later my $TEXT = qr/[^[:cntrl:]]/o; my $qdtext = qr/[^[:cntrl:]\"]/o; #> my $quoted_pair = qr/\\[[:ascii:]]/o; my $quoted_string = qr/\"(?:$qdtext|$quoted_pair)\"/o; my $separators = "[^()<>@,;:\\"\/\[\]\?={} \t"; my $notoken = qr/(?:[[:cntrl:]$separators]/o; my $chunk_ext_name = $token; my $chunk_ext_val = qr/(?:$token|$quoted_string)/o; my $chunk_extension = qr/(?:;$chunk_ext_name(?:$chunk_ext_val)?)/o; =cut sub get_one_start { my ($self, $chunks) = @_; #warn "GOT MORE DATA"; push (@{$self->[FRAMING_BUFFER]}, @$chunks); #warn "NUMBER OF CHUNKS is now ", scalar @{$self->[FRAMING_BUFFER]}; } sub get_one { my $self = shift; my $retval = []; while (defined (my $chunk = shift (@{$self->[FRAMING_BUFFER]}))) { #warn "CHUNK IS SIZE ", length($chunk); #warn join( # ",", map {sprintf("%02X", ord($_))} split (//, substr ($chunk, 0, 10)) #); #warn "NUMBER OF CHUNKS is ", scalar @{$self->[FRAMING_BUFFER]}; DEBUG and warn "STATE is ", $self->[CURRENT_STATE]; # if we're not in STATE_DATA, we need to have a newline sequence # in our hunk of content to find out how far we are. unless ($self->[CURRENT_STATE] & STATE_DATA) { if ($chunk !~ /.\015?\012/s) { #warn "SPECIAL CASE"; if (@{$self->[FRAMING_BUFFER]} == 0) { #warn "pushing $chunk back"; unshift (@{$self->[FRAMING_BUFFER]}, $chunk); return $retval; } else { $chunk .= shift (@{$self->[FRAMING_BUFFER]}); #warn "added to $chunk"; } } } if ($self->[CURRENT_STATE] & STATE_SIZE) { DEBUG and warn "Finding chunk length marker"; if ( $chunk =~ s/^($HEX+)[^\S\015\012]*(?:;.*?)?[^\S\015\012]*\015?\012//s ) { my $length = hex($1); DEBUG and warn "Chunk should be $length bytes"; $self->[CHUNK_SIZE] = $length; if ($length == 0) { $self->[TRAILER_HEADERS] = HTTP::Headers->new; $self->[CURRENT_STATE] = STATE_TRAILER; } else { $self->[CURRENT_STATE] = STATE_DATA; } } else { # ok, this is a hack. skip to the next line if we # don't find the chunk length, it might just be an extra # line or something, and the chunk length always is on # a line of it's own, so this seems the only way to recover # somewhat. #TODO: after discussing on IRC, the concensus was to return #an error Response here, and have the client shut down the #connection. DEBUG and warn "DIDN'T FIND CHUNK LENGTH $chunk"; my $replaceN = $chunk =~ s/.*?\015?\012//s; unshift (@{$self->[FRAMING_BUFFER]}, $chunk) if ($replaceN == 1); return $retval; } } if ($self->[CURRENT_STATE] & STATE_DATA) { my $len = $self->[CHUNK_SIZE] - length ($self->[CHUNK_BUFFER]); DEBUG and warn "going for length ", $self->[CHUNK_SIZE], " (need $len more)"; my $newchunk = $self->[CHUNK_BUFFER]; $self->[CHUNK_BUFFER] = ""; $newchunk .= substr ($chunk, 0, $len, ''); #warn "got " . length($newchunk) . " bytes of data"; if (length $newchunk != $self->[CHUNK_SIZE]) { #smaller, so wait $self->[CHUNK_BUFFER] = $newchunk; next; } $self->[CURRENT_STATE] = STATE_SIZE; #warn "BACK TO FINDING CHUNK SIZE $chunk"; if (length ($chunk) > 0) { DEBUG and warn "we still have a bit $chunk ", length($chunk); #warn "'", substr ($chunk, 0, 10), "'"; $chunk =~ s/^\015?\012//s; #warn "'", substr ($chunk, 0, 10), "'"; unshift (@{$self->[FRAMING_BUFFER]}, $chunk); } push @$retval, $newchunk; #return [$newchunk]; } if ($self->[CURRENT_STATE] & STATE_TRAILER) { while ($chunk =~ s/^([-\w]+):\s*(.*?)\015?\012//s) { DEBUG and warn "add trailer header $1"; $self->[TRAILER_HEADERS]->push_header ($1, $2); } #warn "leftover: ", $chunk; #warn join ( # ",", # map {sprintf("%02X", ord($_))} split (//, substr ($chunk, 0, 10)) #), "\n"; if ($chunk =~ s/^\015?\012//s) { my $headers = delete $self->[TRAILER_HEADERS]; push (@$retval, $headers); DEBUG and warn "returning ", scalar @$retval, "responses"; unshift (@{$self->[FRAMING_BUFFER]}, $chunk) if (length $chunk); return $retval; } if (@{$self->[FRAMING_BUFFER]}) { $self->[FRAMING_BUFFER]->[0] = $chunk . $self->[FRAMING_BUFFER]->[0]; } else { unshift (@{$self->[FRAMING_BUFFER]}, $chunk); return $retval; } } } return $retval; } =for future sub put { die "not implemented yet"; } =cut sub get_pending { my $self = shift; return $self->[FRAMING_BUFFER] if @{$self->[FRAMING_BUFFER]}; return undef; } __END__ # {{{ POD =head1 NAME POE::Filter::HTTPChunk - Non-blocking incremental HTTP chunk parser. =head1 VERSION version 0.948 =head1 SYNOPSIS # Not a complete program. use POE::Filter::HTTPChunk; use POE::Wheel::ReadWrite; sub setup_io { $_[HEAP]->{io_wheel} = POE::Wheel::ReadWrite->new( Filter => POE::Filter::HTTPChunk->new(), # See POE::Wheel::ReadWrite for other required parameters. ); } =head1 DESCRIPTION This filter parses HTTP chunks from a data stream. It's used by POE::Component::Client::HTTP to do the bulk of the low-level HTTP parsing. =head1 CONSTRUCTOR =head2 new C takes no parameters and returns a shiny new POE::Filter::HTTPChunk object ready to use. =head1 METHODS POE::Filter::HTTPChunk supports the following methods. Most of them adhere to the standard POE::Filter API. The documentation for POE::Filter explains the API in more detail. =head2 get_one_start ARRAYREF Accept an arrayref containing zero or more raw data chunks. They are added to the filter's input buffer. The filter will attempt to parse that data when get_one() is called. $filter_httpchunk->get_one_start(\@stream_data); =head2 get_one Parse a single HTTP chunk from the filter's input buffer. Data is entered into the buffer by the get_one_start() method. Returns an arrayref containing zero or one parsed HTTP chunk. $ret_arrayref = $filter_httpchunk->get_one(); =head2 get_pending Returns an arrayref of stream data currently pending parsing. It's used to seamlessly transfer unparsed data between an old and a new filter when a wheel's filter is changed. $pending_arrayref = $filter_httpchunk->get_pending(); =head1 SEE ALSO L, L. =head1 BUGS None are known at this time. =head1 AUTHOR & COPYRIGHTS POE::Filter::HTTPChunk is... =over 2 =item Copyright 2005-2006 Martijn van Beers =item Copyright 2006 Rocco Caputo =back All rights are reserved. POE::Filter::HTTPChunk is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 CONTACT Rocco may be contacted by e-mail via L, and Martijn may be contacted by email via L. The preferred way to report bugs or requests is through RT though. See L or mail L For questions, try the L mailing list (poe@perl.org) =cut # }}} POD POE-Component-Client-HTTP-0.948/lib/POE/Filter/HTTPHead.pm000644 000765 000024 00000013356 12141763331 022552 0ustar00trocstaff000000 000000 package POE::Filter::HTTPHead_Line; { $POE::Filter::HTTPHead_Line::VERSION = '0.948'; } # vim: ts=2 sw=2 expandtab use warnings; use strict; use base 'POE::Filter'; use HTTP::Response; sub FRAMING_BUFFER () { 0 } sub CURRENT_STATE () { 1 } sub WORK_RESPONSE () { 2 } sub PROTOCOL_VERSION () { 3 } sub STATE_STATUS () { 0x01 } # waiting for a status line sub STATE_HEADER () { 0x02 } # gotten status, looking for header or end sub DEBUG () { 0 } sub new { my $type = shift; my $self = bless [ [], # FRAMING_BUFFER STATE_STATUS, # CURRENT_STATE undef, # WORK_RESPONSE "0.9", # PROTOCOL_VERSION ], $type; $self; } sub get_one_start { my ($self, $chunks) = @_; # We're receiving newline-terminated lines. Strip off any carriage # returns that might be left over. s/\x0D$// foreach @$chunks; s/^\x0D// foreach @$chunks; push (@{$self->[FRAMING_BUFFER]}, @$chunks); #warn "now got ", scalar @{$self->[FRAMING_BUFFER]}, " lines"; } sub get_one { my $self = shift; # Process lines while we have them. LINE: while (@{$self->[FRAMING_BUFFER]}) { my $line = shift @{$self->[FRAMING_BUFFER]}; # Waiting for a status line. if ($self->[CURRENT_STATE] == STATE_STATUS) { DEBUG and warn "----- Waiting for a status line.\n"; # Does the line look like a status line? if ($line =~ m|^(?:HTTP/(\d+\.\d+) )?(\d{3})\s*(.+)?$|) { $self->[PROTOCOL_VERSION] = $1 if defined $1; $self->[WORK_RESPONSE] = HTTP::Response->new ($2, $3); $self->[WORK_RESPONSE]->protocol('HTTP/' . $self->[PROTOCOL_VERSION]); $self->[CURRENT_STATE] = STATE_HEADER; # We're done with the line. Try the next one. DEBUG and warn "Got a status line.\n"; next LINE; } # We have a line, but it doesn't look like a HTTP/1.1 status # line. Assume it's an HTTP/0.9 response and fabricate headers. # Also, put the line back. It's part of the content. DEBUG and warn "Faking HTTP/0.9 headers (first line not status).\n"; my $resp = HTTP::Response->new ( '200', 'OK', ['Content-Type' => 'text/html'], $line ); $resp->protocol('HTTP/0.9'); #unshift @{$self->[FRAMING_BUFFER]}, $line; return [ $resp ]; } # A blank line signals the end of headers. if ($line =~ /^\s*$/) { DEBUG and warn "Got a blank line. End of headers.\n"; $self->[CURRENT_STATE] = STATE_STATUS; return [$self->[WORK_RESPONSE]]; } # We have a potential header line. Try to identify it's end. my $i = 0; CONTINUATION: while ($i < @{$self->[FRAMING_BUFFER]}) { # Forward-looking line begins with whitespace. It's a # continuation of the previous line. $i++, next CONTINUATION if $self->[FRAMING_BUFFER]->[$i] =~ /^\s+\S/; DEBUG and warn "Found end of header ($i)\n"; # Forward-looking line isn't a continuation line. All buffer # lines before it are part of the current header. if ($i) { $line .= $_ foreach ( map { s/^\s+//; $_ } splice(@{$self->[FRAMING_BUFFER]}, 0, $i) ); } DEBUG and warn "Full header read: $line\n"; # And parse the line. if ( $line =~ m{ ^ ([^\x00-\x19()<>@,;:\\""\/\[\]\?={}\x20\t]+): \s*([^\x00-\x07\x09-\x19]+) $ }x ) { DEBUG and warn " header($1) value($2)\n"; $self->[WORK_RESPONSE]->push_header($1, $2) } next LINE; } # We didn't find a complete header. Put the line back, and wait # for more input. DEBUG and warn "Incomplete header. Waiting for more.\n"; unshift @{$self->[FRAMING_BUFFER]}, $line; return []; } # Didn't return anything else, so we don't have anything. return []; } #=for future # #sub put { # my ($self, $responses) = @_; # my $out; # # foreach my $response (@$responses) { # $out = $response->as_string # } # # $out; #} # #=cut sub get_pending { my $self = shift; return $self->[FRAMING_BUFFER]; } package POE::Filter::HTTPHead; { $POE::Filter::HTTPHead::VERSION = '0.948'; } use strict; =head1 NAME POE::Filter::HTTPHead - filter data as HTTP::Response objects =head1 VERSION version 0.948 =head1 SYNOPSYS $filter = POE::Filter::HTTPHead->new(); $arrayref_of_response_objects = $filter->get($arrayref_of_raw_chunks_from_driver); $arrayref_of_leftovers = $filter->get_pending(); =head1 DESCRIPTION The HTTPHead filter turns stream data that has the appropriate format into a HTTP::Response object. In an all-POE world, this would sit on the other end of a connection as L =cut use base qw(POE::Filter::Stackable); use POE::Filter::Line; =head2 new Creates a new filter to parse HTTP headers. Takes no parameters, and returns a shiny new POE::Filter::HTTPHead object. =cut sub new { my $type = shift; # Look for EOL defined as linefeed. We'll strip off possible # carriage returns in HTTPHead_Line's get_one_start(). my $self = $type->SUPER::new( Filters => [ POE::Filter::Line->new(Literal => "\x0A"), POE::Filter::HTTPHead_Line->new, ], ); return bless $self, $type; } =head1 METHODS See L for documentation of the public API. =head2 get_pending Returns unparsed data pending in this filter's input buffer. It's used by POE::Wheel objects to seamlessly switch between filters. Details may be found in the POE::Filter documentation. =cut sub get_pending { my $self = shift; my @pending = map {"$_\n"} @{$self->[0]->[1]->get_pending}; my $lines = $self->[0]->[0]->get_pending; push (@pending, @$lines) if (defined $lines); return \@pending; } #=for future? # #sub put { # my $self = shift; # return $self->[0]->[1]->put (@_); #} # #=cut 1; POE-Component-Client-HTTP-0.948/lib/POE/Component/Client/000755 000765 000024 00000000000 12141763331 022576 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/lib/POE/Component/Client/HTTP/000755 000765 000024 00000000000 12141763331 023355 5ustar00trocstaff000000 000000 POE-Component-Client-HTTP-0.948/lib/POE/Component/Client/HTTP.pm000644 000765 000024 00000142612 12141763331 023721 0ustar00trocstaff000000 000000 package POE::Component::Client::HTTP; { $POE::Component::Client::HTTP::VERSION = '0.948'; } # vim: ts=2 sw=2 expandtab # {{{ INIT use strict; #use bytes; # for utf8 compatibility use constant DEBUG => 0; use constant DEBUG_DATA => 0; use Carp qw(croak); use HTTP::Response; use Net::HTTP::Methods; use Socket qw( sockaddr_in inet_ntoa getnameinfo NI_NUMERICHOST NI_NUMERICSERV ); use POE::Component::Client::HTTP::RequestFactory; use POE::Component::Client::HTTP::Request qw(:states :fields); BEGIN { local $SIG{'__DIE__'} = 'DEFAULT'; #TODO: move this to Client::Keepalive? # Allow more finely grained timeouts if Time::HiRes is available. eval { require Time::HiRes; Time::HiRes->import("time"); }; } use POE qw( Driver::SysRW Filter::Stream Filter::HTTPHead Filter::HTTPChunk Component::Client::Keepalive ); # The Internet Assigned Numbers Authority (IANA) acts as a registry # for transfer-coding value tokens. Initially, the registry contains # the following tokens: "chunked" (section 3.6.1), "identity" (section # 3.6.2), "gzip" (section 3.5), "compress" (section 3.5), and # "deflate" (section 3.5). # FIXME - Haven't been able to test the compression options. # Comments for each filter are what HTTP::Message use. Methods # without packages are from Compress::Zlib. # FIXME - Is it okay to be mixing content and transfer encodings in # this one table? my %te_possible_filters = ( 'chunked' => 'POE::Filter::HTTPChunk', 'identity' => 'POE::Filter::Stream', # 'gzip' => 'POE::Filter::Zlib::Stream', # Zlib: memGunzip # 'x-gzip' => 'POE::Filter::Zlib::Stream', # Zlib: memGunzip # 'x-bzip2' => 'POE::Filter::Bzip2', # Compress::BZip2::decompress # 'deflate' => 'POE::Filter::Zlib::Stream', # Zlib: uncompress / inflate # 'compress' => 'POE::Filter::LZW', # unsupported # FIXME - base64 = MIME::Base64::decode # FIXME - quoted-printable = Mime::QuotedPrint::decode ); my %te_filters; while (my ($encoding, $filter) = each %te_possible_filters) { eval "use $filter"; next if $@; $te_filters{$encoding} = $filter; } # The following defaults to 'chunked,identity' which is technically # correct but arguably useless. It also stomps on gzip'd transport # because in the World Wild Web, Accept-Encoding is used to indicate # gzip readiness, but the server responds with 'Content-Encoding: # gzip', completely outside of TE encoding. # # Done this way so they appear in order of preference. # FIXME - Is the order important here? #my $accept_encoding = join( # ",", # grep { exists $te_filters{$_} } # qw(x-bzip2 gzip x-gzip deflate compress chunked identity) #); my %supported_schemes = ( http => 1, https => 1, ); # }}} INIT #------------------------------------------------------------------------------ # Spawn a new PoCo::Client::HTTP session. This basically is a # constructor, but it isn't named "new" because it doesn't create a # usable object. Instead, it spawns the object off as a separate # session. # {{{ spawn sub spawn { my $type = shift; croak "$type requires an even number of parameters" if @_ % 2; my %params = @_; my $alias = delete $params{Alias}; $alias = 'weeble' unless defined $alias and length $alias; my $bind_addr = delete $params{BindAddr}; my $cm = delete $params{ConnectionManager}; my $request_factory = POE::Component::Client::HTTP::RequestFactory->new( \%params ); croak( "$type doesn't know these parameters: ", join(', ', sort keys %params) ) if scalar keys %params; POE::Session->create( inline_states => { _start => \&_poco_weeble_start, _stop => \&_poco_weeble_stop, _child => sub { }, # Public interface. request => \&_poco_weeble_request, pending_requests_count => \&_poco_weeble_pending_requests_count, 'shutdown' => \&_poco_weeble_shutdown, cancel => \&_poco_weeble_cancel, # Client::Keepalive interface. got_connect_done => \&_poco_weeble_connect_done, # ReadWrite interface. got_socket_input => \&_poco_weeble_io_read, got_socket_flush => \&_poco_weeble_io_flushed, got_socket_error => \&_poco_weeble_io_error, # I/O timeout. got_timeout => \&_poco_weeble_timeout, remove_request => \&_poco_weeble_remove_request, }, heap => { alias => $alias, factory => $request_factory, cm => $cm, is_shut_down => 0, bind_addr => $bind_addr, }, ); undef; } # }}} spawn # ------------------------------------------------------------------------------ # {{{ _poco_weeble_start sub _poco_weeble_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; $kernel->alias_set($heap->{alias}); # have to do this here because it wants a current_session $heap->{cm} = POE::Component::Client::Keepalive->new( timeout => $heap->{factory}->timeout, ($heap->{bind_addr} ? (bind_address => $heap->{bind_addr}) : ()), ) unless ($heap->{cm}); } # }}} _poco_weeble_start #------------------------------------------------------------------------------ # {{{ _poco_weeble_stop sub _poco_weeble_stop { my $heap = $_[HEAP]; my $request = delete $heap->{request}; foreach my $request_rec (values %$request) { $request_rec->remove_timeout(); delete $heap->{ext_request_to_int_id}->{$request_rec->[REQ_HTTP_REQUEST]}; } DEBUG and warn "Client::HTTP (alias=$heap->{alias}) stopped."; } # }}} _poco_weeble_stop # {{{ _poco_weeble_pending_requests_count sub _poco_weeble_pending_requests_count { my ($heap) = $_[HEAP]; my $r = $heap->{request} || {}; return scalar keys %$r; } # }}} _poco_weeble_pending_requests_count #------------------------------------------------------------------------------ # {{{ _poco_weeble_request sub _poco_weeble_request { my ( $kernel, $heap, $sender, $response_event, $http_request, $tag, $progress_event, $proxy_override ) = @_[KERNEL, HEAP, SENDER, ARG0, ARG1, ARG2, ARG3, ARG4]; my $scheme = $http_request->uri->scheme; unless ( defined($scheme) and exists $supported_schemes{$scheme} ) { my $rsp = HTTP::Response->new( 400 => 'Bad Request', [], "\n" . "Error: Bad Request\n" . "\n" . "

Error: Bad Request

\n" . "Unsupported URI scheme: '$scheme'\n" . "\n" . "\n" ); $rsp->request($http_request); if (ref($response_event) eq 'POE::Component::Client::HTTP::Request') { $response_event->postback->($rsp); } else { $kernel->post($sender, $response_event, [$http_request, $tag], [$rsp]); } return; } my $host = $http_request->uri->host; unless (defined $host and length $host) { my $rsp = HTTP::Response->new( 400 => 'Bad Request', [], "\n" . "Error: Bad Request\n" . "\n" . "

Error: Bad Request

\n" . "URI contains no discernable host.\n" . "\n" . "\n" ); $rsp->request($http_request); if (ref($response_event) eq 'POE::Component::Client::HTTP::Request') { $response_event->postback->($rsp); } else { $kernel->post($sender, $response_event, [$http_request, $tag], [$rsp]); } return; } if ($heap->{is_shut_down}) { my $rsp = HTTP::Response->new( 408 => 'Request timed out (component shut down)', [], "\n" . "Error: Request timed out (component shut down)" . "\n" . "\n" . "

Error: Request Timeout

\n" . "Request timed out (component shut down)\n" . "\n" . "\n" ); $rsp->request($http_request); if (ref($response_event) eq 'POE::Component::Client::HTTP::Request') { $response_event->postback->($rsp); } else { $kernel->post($sender, $response_event, [$http_request, $tag], [$rsp]); } return; } if (defined $proxy_override) { POE::Component::Client::HTTP::RequestFactory->parse_proxy($proxy_override); } my $request = $heap->{factory}->create_request( $http_request, $response_event, $tag, $progress_event, $proxy_override, $sender ); $heap->{request}->{$request->ID} = $request; $heap->{ext_request_to_int_id}->{$http_request} = $request->ID; my @timeout; if ($heap->{factory}->timeout()) { @timeout = ( timeout => $heap->{factory}->timeout() ); } eval { # get a connection from Client::Keepalive # # TODO CONNECT - We must ask PCC::Keepalive to establish an http # socket, not https. The initial proxy interactin is plaintext? $request->[REQ_CONN_ID] = $heap->{cm}->allocate( scheme => $request->scheme, addr => $request->host, port => $request->port, context => $request->ID, event => 'got_connect_done', @timeout, ); }; if ($@) { delete $heap->{request}->{$request->ID}; delete $heap->{ext_request_to_int_id}->{$http_request}; # we can reach here for things like host being invalid. $request->error(400, $@); } } # }}} _poco_weeble_request #------------------------------------------------------------------------------ # {{{ _poco_weeble_connect_done sub _poco_weeble_connect_done { my ($heap, $response) = @_[HEAP, ARG0]; my $connection = $response->{'connection'}; my $request_id = $response->{'context'}; # Can't handle connections if we're shut down. # TODO - How do we still get these? Were they previously queued or # something? if ($heap->{is_shut_down}) { _internal_cancel( $heap, $request_id, 408, "Request timed out (request canceled)" ); return; } if (defined $connection) { DEBUG and warn "CON: request $request_id connected ok..."; my $request = $heap->{request}->{$request_id}; unless (defined $request) { DEBUG and warn "CON: ignoring connection for canceled request"; return; } my $block_size = $heap->{factory}->block_size; # get wheel from the connection my $new_wheel = $connection->start( Driver => POE::Driver::SysRW->new(BlockSize => $block_size), InputFilter => POE::Filter::HTTPHead->new(), OutputFilter => POE::Filter::Stream->new(), InputEvent => 'got_socket_input', FlushedEvent => 'got_socket_flush', ErrorEvent => 'got_socket_error', ); DEBUG and warn "CON: request $request_id uses wheel ", $new_wheel->ID; # Add the new wheel ID to the lookup table. $heap->{wheel_to_request}->{ $new_wheel->ID() } = $request_id; $request->[REQ_CONNECTION] = $connection; # SSLify needs us to call it's function to get the "real" socket my $peer_addr; if ( $request->scheme eq 'http' ) { $peer_addr = getpeername($new_wheel->get_input_handle()); } else { my $socket = $new_wheel->get_input_handle(); $peer_addr = getpeername(POE::Component::SSLify::SSLify_GetSocket($socket)); } if (defined $peer_addr) { my ($error, $address, $port) = getnameinfo( $peer_addr, NI_NUMERICHOST | NI_NUMERICSERV ); if ($error) { $request->[REQ_PEERNAME] = "error: $error"; } else { $request->[REQ_PEERNAME] = "$address.$port"; } } else { $request->[REQ_PEERNAME] = "error: $!"; } $request->create_timer($heap->{factory}->timeout); $request->send_to_wheel; } else { DEBUG and warn( "CON: Error connecting for request $request_id --- ", $_[SENDER]->ID ); my ($operation, $errnum, $errstr) = ( $response->{function}, $response->{error_num} || '??', $response->{error_str} ); DEBUG and warn( "CON: request $request_id encountered $operation error " . "$errnum: $errstr" ); DEBUG and warn "I/O: removing request $request_id"; my $request = delete $heap->{request}->{$request_id}; $request->remove_timeout(); delete $heap->{ext_request_to_int_id}->{$request->[REQ_HTTP_REQUEST]}; # Post an error response back to the requesting session. $request->connect_error($operation, $errnum, $errstr); } } # }}} _poco_weeble_connect_done # {{{ _poco_weeble_timeout sub _poco_weeble_timeout { my ($kernel, $heap, $request_id) = @_[KERNEL, HEAP, ARG0]; DEBUG and warn "T/O: request $request_id timed out"; # Discard the request. Keep a copy for a few bits of cleanup. DEBUG and warn "I/O: removing request $request_id"; my $request = delete $heap->{request}->{$request_id}; unless (defined $request) { die( "T/O: unexpectedly undefined request for id $request_id\n", "T/O: known request IDs: ", join(", ", keys %{$heap->{request}}), "\n", "...", ); } DEBUG and warn "T/O: request $request_id has timer ", $request->timer; $request->remove_timeout(); delete $heap->{ext_request_to_int_id}->{$request->[REQ_HTTP_REQUEST]}; # There's a wheel attached to the request. Shut it down. if (defined(my $wheel = $request->wheel())) { my $wheel_id = $wheel->ID(); DEBUG and warn "T/O: request $request_id is wheel $wheel_id"; # Shut down the connection so it's not reused. $wheel->shutdown_input(); delete $heap->{wheel_to_request}->{$wheel_id}; } DEBUG and do { die( "T/O: request $request_id is unexpectedly zero" ) unless $request->[REQ_STATE]; warn "T/O: request_state = " . sprintf("%#04x\n", $request->[REQ_STATE]); }; # Hey, we haven't sent back a response yet! unless ($request->[REQ_STATE] & (RS_REDIRECTED | RS_POSTED)) { # Well, we have a response. Isn't that nice? Let's send it. if ($request->[REQ_STATE] & (RS_IN_CONTENT | RS_DONE)) { _finish_request($heap, $request); return; } # Post an error response back to the requesting session. DEBUG and warn "I/O: Disconnect, keepalive timeout or HTTP/1.0."; $request->error(408, "Request timed out") if $request->[REQ_STATE]; return; } } # }}} _poco_weeble_timeout #------------------------------------------------------------------------------ # {{{ _poco_weeble_io_flushed sub _poco_weeble_io_flushed { my ($heap, $wheel_id) = @_[HEAP, ARG0]; # We sent the request. Now we're looking for a response. It may be # bad to assume we won't get a response until a request has flushed. my $request_id = $heap->{wheel_to_request}->{$wheel_id}; if (not defined $request_id) { DEBUG and warn "!!!: unexpectedly undefined request ID"; return; } DEBUG and warn( "I/O: wheel $wheel_id (request $request_id) flushed its request..." ); my $request = $heap->{request}->{$request_id}; # Read content to send from a callback if ( ref $request->[REQ_HTTP_REQUEST]->content() eq 'CODE' ) { my $callback = $request->[REQ_HTTP_REQUEST]->content(); my $buf = eval { $callback->() }; if ( $buf ) { $request->[REQ_CONNECTION]->wheel->put($buf); # reset the timeout # Have to also reset REQ_START_TIME or timer ends early $request->remove_timeout; $request->[REQ_START_TIME] = time(); $request->create_timer($heap->{factory}->timeout); return; } } $request->[REQ_STATE] ^= RS_SENDING; $request->[REQ_STATE] = RS_IN_HEAD; # XXX - Removed a second time. The first time was in version 0.53, # because the EOF generated by shutdown_output() causes some servers # to disconnect rather than send their responses. # $request->wheel->shutdown_output(); } # }}} _poco_weeble_io_flushed #------------------------------------------------------------------------------ # {{{ _poco_weeble_io_error sub _poco_weeble_io_error { my ($kernel, $heap, $operation, $errnum, $errstr, $wheel_id) = @_[KERNEL, HEAP, ARG0..ARG3]; DEBUG and warn( "I/O: wheel $wheel_id encountered $operation error $errnum: $errstr" ); # Drop the wheel. my $request_id = delete $heap->{wheel_to_request}->{$wheel_id}; # There was no corresponding request? Nothing left to do here. # We might have got here because the server sent EOF after we were done processing # the request, and deleted it from our cache. ( notes for RT#50231 ) return unless $request_id; DEBUG and warn "I/O: removing request $request_id"; my $request = delete $heap->{request}->{$request_id}; $request->remove_timeout; delete $heap->{ext_request_to_int_id}{$request->[REQ_HTTP_REQUEST]}; # Otherwise the remote end simply closed. If we've got a pending # response, then post it back to the client. DEBUG and warn "STATE is ", $request->[REQ_STATE]; # Except when we're redirected. In this case, the connection was but # one step towards our destination. return if ($request->[REQ_STATE] & RS_REDIRECTED); # If there was a non-zero error, then something bad happened. Post # an error response back, if we haven't posted anything before. if ($errnum) { if ($operation eq "connect") { $request->connect_error($operation, $errnum, $errstr); return; } unless ($request->[REQ_STATE] & RS_POSTED) { $request->error(400, "$operation error $errnum: $errstr"); } return; } # We seem to have finished with the request. Send back a response. if ( $request->[REQ_STATE] & (RS_IN_CONTENT | RS_DONE) and not $request->[REQ_STATE] & RS_POSTED ) { _finish_request($heap, $request); return; } # We have already posted a response, so this is a remote keepalive # timeout or other delayed socket shutdown. Nothing left to do. if ($request->[REQ_STATE] & RS_POSTED) { DEBUG and warn "I/O: Disconnect, remote keepalive timeout or HTTP/1.0."; return; } # We never received a response. if (not defined $request->[REQ_RESPONSE]) { # Check for pending data indicating a LF-free HTTP 0.9 response. my $lines = $request->wheel->get_input_filter()->get_pending(); my $text = join '' => @$lines; DEBUG and warn "Got ", length($text), " bytes of data without LF."; # If we have data, build and return a response from it. if ($text =~ /\S/) { DEBUG and warn( "Generating HTTP response for HTTP/0.9 response without LF." ); $request->[REQ_RESPONSE] = HTTP::Response->new( 200, 'OK', [ 'Content-Type' => 'text/html', 'X-PCCH-Peer' => $request->[REQ_PEERNAME], ], $text ); $request->[REQ_RESPONSE]->protocol('HTTP/0.9'); $request->[REQ_RESPONSE]->request($request->[REQ_HTTP_REQUEST]); $request->[REQ_STATE] = RS_DONE; $request->return_response; return; } # No data received. This is an incomplete response. $request->error(400, "Incomplete response - $request_id"); return; } # We haven't built a proper response, and nothing returned by the # server can be turned into a proper response. Send back an error. # Changed to 406 after considering rt.cpan.org 20975. # # 10.4.7 406 Not Acceptable # # The resource identified by the request is only capable of # generating response entities which have content characteristics # not acceptable according to the accept headers sent in the # request. $request->error(406, "Server response is Not Acceptable - $request_id"); } # }}} _poco_weeble_io_error #------------------------------------------------------------------------------ # Read a chunk of response. This code is directly adapted from Artur # Bergman's nifty POE::Filter::HTTPD, which does pretty much the same # in the other direction. # {{{ _poco_weeble_io_read sub _poco_weeble_io_read { my ($kernel, $heap, $input, $wheel_id) = @_[KERNEL, HEAP, ARG0, ARG1]; my $request_id = $heap->{wheel_to_request}->{$wheel_id}; DEBUG and warn "I/O: wheel $wheel_id got input..."; DEBUG_DATA and warn (ref($input) ? $input->as_string : _hexdump($input)); # There was no corresponding request? Nothing left to do here. # # We might have got here because the server sent EOF after we were # done processing the request, and deleted it from our cache. ( # notes for RT#50231 ) return unless defined $request_id; my $request = $heap->{request}->{$request_id}; return unless defined $request; DEBUG and warn( "REQUEST $request_id is $request <", $request->[REQ_HTTP_REQUEST]->uri(), ">" ); # Reset the timeout if we get data. $kernel->delay_adjust($request->timer, $heap->{factory}->timeout); if ($request->[REQ_STATE] & RS_REDIRECTED) { DEBUG and warn "input for request that was redirected"; return; } # {{{ HEAD # The very first line ought to be status. If it's not, then it's # part of the content. if ($request->[REQ_STATE] & RS_IN_HEAD) { if (defined $input) { $input->request ($request->[REQ_HTTP_REQUEST]); #warn( # "INPUT for ", $request->[REQ_HTTP_REQUEST]->uri, # " is \n",$input->as_string #) } else { #warn "NO INPUT"; } # FIXME: LordVorp gets here without $input being a HTTP::Response. # FIXME: This happens when the response is HTTP/0.9 and doesn't # include a status line. See t/53_response_parser.t. $request->[REQ_RESPONSE] = $input; $input->header("X-PCCH-Peer", $request->[REQ_PEERNAME]); # TODO CONNECT - If we've got the headers to a CONNECT request, # then we can switch to the actual request. This is like a faux # redirect where the socket gets reused. # # 1. Switch the socket to SSL. # 2. Switch the request from CONNECT mode to regular mode, using # the method proposed in PCCH::Request. # 3. Send the original request via PCCH::Request->send_to_wheel(). # This puts the client back into the RS_SENDING state. # 4. Reset any data/state so it appears we never went through # CONNECT. # 5. Make sure that PCC::Keepalive will discard the socket when # we're done with it. # 6. Return. The connection should proceed as normal. # # I think the normal handling for HTTP errors will cover the case # of CONNECT failure. If not, we can refine the implementation as # needed. # Some responses are without content by definition # FIXME: #12363 # Make sure we finish even when it isn't one of these, but there # is no content. if ( $request->[REQ_HTTP_REQUEST]->method eq 'HEAD' or $input->code =~ /^(?:1|[23]04)/ or ( defined($input->content_length()) and $input->content_length() == 0 ) ) { if (_try_redirect($request_id, $input, $request)) { my $old_request = delete $heap->{request}->{$request_id}; delete $heap->{wheel_to_request}->{$wheel_id}; if (defined $old_request) { DEBUG and warn "I/O: removed request $request_id"; $old_request->remove_timeout(); delete $heap->{ext_request_to_int_id}{$old_request->[REQ_HTTP_REQUEST]}; $old_request->[REQ_CONNECTION] = undef; } return; } $request->[REQ_STATE] |= RS_DONE; $request->remove_timeout(); _finish_request($heap, $request); return; } else { # If we have content length, and it's more than the maximum we # requested, then fail without bothering with the content. if ( defined($heap->{factory}->max_response_size()) and defined($input->content_length()) and $input->content_length() > $heap->{factory}->max_response_size() ) { _internal_cancel( $heap, $request_id, 406, "Response content length " . $input->content_length() . " is greater than specified MaxSize of " . $heap->{factory}->max_response_size() . ". Use range requests to retrieve specific amounts of content." ); return; } $request->[REQ_STATE] |= RS_IN_CONTENT; $request->[REQ_STATE] &= ~RS_IN_HEAD; #FIXME: probably want to find out when the content from this # request is in, and only then do the new request, so we # can reuse the connection. if (_try_redirect($request_id, $input, $request)) { my $old_request = delete $heap->{request}->{$request_id}; delete $heap->{wheel_to_request}->{$wheel_id}; if (defined $old_request) { DEBUG and warn "I/O: removed request $request_id"; delete $heap->{ext_request_to_int_id}{$old_request->[REQ_HTTP_REQUEST]}; $old_request->remove_timeout(); $old_request->[REQ_CONNECTION]->close(); $old_request->[REQ_CONNECTION] = undef; } return; } # RFC 2616 14.41: If multiple encodings have been applied to an # entity, the transfer-codings MUST be listed in the order in # which they were applied. my ($filter, @filters); # Transfer encoding. my $te = $input->header('Transfer-Encoding'); if (defined $te) { my @te = split(/\s*,\s*/, lc($te)); while (@te and exists $te_filters{$te[-1]}) { my $encoding = pop @te; my $fclass = $te_filters{$encoding}; push @filters, $fclass->new(); } if (@te) { $input->header('Transfer-Encoding', join(', ', @te)); } else { $input->header('Transfer-Encoding', undef); } } # Content encoding. my $ce = $input->header('Content-Encoding'); if (defined $ce) { my @ce = split(/\s*,\s*/, lc($ce)); while (@ce and exists $te_filters{$ce[-1]}) { my $encoding = pop @ce; my $fclass = $te_filters{$encoding}; push @filters, $fclass->new(); } if (@ce) { $input->header('Content-Encoding', join(', ', @ce)); } else { $input->header('Content-Encoding', undef); } } if (@filters > 1) { $filter = POE::Filter::Stackable->new( Filters => \@filters ); } elsif (@filters) { $filter = $filters[0]; } else { # Punt if we have no specified filters. $filter = POE::Filter::Stream->new; } # do this last, because it triggers a read $request->wheel->set_input_filter($filter); } return; } # }}} HEAD # {{{ content # We're in a content state. if ($request->[REQ_STATE] & RS_IN_CONTENT) { if (ref($input) and UNIVERSAL::isa($input, 'HTTP::Response')) { # there was a problem in the input filter # $request->close_connection; } else { $request->add_content($input); } } # }}} content # {{{ deliver reponse if complete # POST response without disconnecting if ( $request->[REQ_STATE] & RS_DONE and not $request->[REQ_STATE] & RS_POSTED ) { $request->remove_timeout; _finish_request($heap, $request); } # }}} deliver reponse if complete } # }}} _poco_weeble_io_read #------------------------------------------------------------------------------ # Generate a hex dump of some input. This is not a POE function. # {{{ _hexdump sub _hexdump { my $data = shift; my $dump; my $offset = 0; while (length $data) { my $line = substr($data, 0, 16); substr($data, 0, 16) = ''; my $hexdump = unpack 'H*', $line; $hexdump =~ s/(..)/$1 /g; $line =~ tr[ -~][.]c; $dump .= sprintf( "%04x %-47.47s - %s\n", $offset, $hexdump, $line ); $offset += 16; } return $dump; } # }}} _hexdump # Check for and handle redirect. Returns true if redirect should # occur, or false if there's no redirect. sub _try_redirect { my ($request_id, $input, $request) = @_; if (my $newrequest = $request->check_redirect) { DEBUG and warn( "Redirected $request_id ", $input->code, " to <", $newrequest->uri, ">" ); my @proxy; if ($request->[REQ_USING_PROXY]) { push @proxy, ( 'http://' . $request->host . ':' . $request->port . '/' ); } $poe_kernel->yield( request => $request, $newrequest, "_redir_".$request->ID, $request->[REQ_PROG_POSTBACK], @proxy ); return 1; } return; } # Complete a request. This was moved out of _poco_weeble_io_error(). This is # not a POE function. # {{{ _finish_request sub _finish_request { my ($heap, $request) = @_; my $request_id = $request->ID; if (DEBUG) { my ($pkg, $file, $line) = caller(); warn( "XXX: calling _finish_request(request id = $request_id)" . "at $file line $line" ); } # XXX What does this do? $request->add_eof; # KeepAlive: added the RS_POSTED flag $request->[REQ_STATE] |= RS_POSTED; my $wheel_id = defined $request->wheel ? $request->wheel->ID : "(undef)"; DEBUG and warn "Wheel from request is ", $wheel_id; # clean up the request my $address = "$request->[REQ_HOST]:$request->[REQ_PORT]"; DEBUG and warn "address is $address"; return _clear_req_cache( $heap, $request_id ); } # }}} _finish_request #{{{ _remove_request sub _poco_weeble_remove_request { my ($kernel, $heap, $request_id) = @_[KERNEL, HEAP, ARG0]; return _clear_req_cache( $heap, $request_id ); } #}}} _remove_request # helper subroutine to remove a request from our caches #{{{ _clear_req_cache sub _clear_req_cache { my ($heap, $request_id) = @_; my $request = delete $heap->{request}->{$request_id}; if (defined $request) { DEBUG and warn "I/O: removed request $request_id"; $request->remove_timeout(); delete $heap->{ext_request_to_int_id}{$request->[REQ_HTTP_REQUEST]}; if (my $wheel = $request->wheel) { delete $heap->{wheel_to_request}->{$wheel->ID}; } } return; } #}}} _clear_req_cache # Cancel a single request by HTTP::Request object. sub _poco_weeble_cancel { my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0]; my $request_id = $heap->{ext_request_to_int_id}{$request}; return unless defined $request_id; _internal_cancel( $heap, $request_id, 408, "Request timed out (request canceled)" ); } sub _internal_cancel { my ($heap, $request_id, $code, $message) = @_; my $request = delete $heap->{request}{$request_id}; return unless defined $request; DEBUG and warn "CXL: canceling request $request_id"; $request->remove_timeout(); delete $heap->{ext_request_to_int_id}{$request->[REQ_HTTP_REQUEST]}; if (my $wheel = $request->wheel) { my $wheel_id = $wheel->ID; DEBUG and warn "CXL: Request $request_id canceling wheel $wheel_id"; delete $heap->{wheel_to_request}{$wheel_id}; $wheel = undef; } if ($request->[REQ_CONNECTION]) { $request->[REQ_CONNECTION]->close(); $request->[REQ_CONNECTION] = undef; } else { # Didn't connect yet; inform connection manager to cancel # connection request. $heap->{cm}->deallocate($request_id); } unless ($request->[REQ_STATE] & RS_POSTED) { $request->error($code, $message); } } # Shut down the entire component. sub _poco_weeble_shutdown { my ($kernel, $heap) = @_[KERNEL, HEAP]; $heap->{is_shut_down} = 1; my @request_ids = keys %{$heap->{request}}; foreach my $request_id (@request_ids) { _internal_cancel( $heap, $request_id, 408, "Request timed out (component shut down)" ); } # Shut down the connection manager subcomponent. if (defined $heap->{cm}) { DEBUG and warn "CXL: Client::HTTP shutting down Client::Keepalive"; $heap->{cm}->shutdown(); delete $heap->{cm}; } # Final cleanup of this component. $kernel->alias_remove($heap->{alias}); } 1; __END__ # {{{ POD =head1 NAME POE::Component::Client::HTTP - a HTTP user-agent component =head1 VERSION version 0.948 =head1 SYNOPSIS use POE qw(Component::Client::HTTP); POE::Component::Client::HTTP->spawn( Agent => 'SpiffCrawler/0.90', # defaults to something long Alias => 'ua', # defaults to 'weeble' From => 'spiffster@perl.org', # defaults to undef (no header) Protocol => 'HTTP/0.9', # defaults to 'HTTP/1.1' Timeout => 60, # defaults to 180 seconds MaxSize => 16384, # defaults to entire response Streaming => 4096, # defaults to 0 (off) FollowRedirects => 2, # defaults to 0 (off) Proxy => "http://localhost:80", # defaults to HTTP_PROXY env. variable NoProxy => [ "localhost", "127.0.0.1" ], # defs to NO_PROXY env. variable BindAddr => "12.34.56.78", # defaults to INADDR_ANY ); $kernel->post( 'ua', # posts to the 'ua' alias 'request', # posts to ua's 'request' state 'response', # which of our states will receive the response $request, # an HTTP::Request object ); # This is the sub which is called when the session receives a # 'response' event. sub response_handler { my ($request_packet, $response_packet) = @_[ARG0, ARG1]; # HTTP::Request my $request_object = $request_packet->[0]; # HTTP::Response my $response_object = $response_packet->[0]; my $stream_chunk; if (! defined($response_object->content)) { $stream_chunk = $response_packet->[1]; } print( "*" x 78, "\n", "*** my request:\n", "-" x 78, "\n", $request_object->as_string(), "*" x 78, "\n", "*** their response:\n", "-" x 78, "\n", $response_object->as_string(), ); if (defined $stream_chunk) { print "-" x 40, "\n", $stream_chunk, "\n"; } print "*" x 78, "\n"; } =head1 DESCRIPTION POE::Component::Client::HTTP is an HTTP user-agent for POE. It lets other sessions run while HTTP transactions are being processed, and it lets several HTTP transactions be processed in parallel. It supports keep-alive through POE::Component::Client::Keepalive, which in turn uses POE::Component::Resolver for asynchronous IPv4 and IPv6 name resolution. HTTP client components are not proper objects. Instead of being created, as most objects are, they are "spawned" as separate sessions. To avoid confusion (and hopefully not cause other confusion), they must be spawned with a C method, not created anew with a C one. =head1 CONSTRUCTOR =head2 spawn PoCo::Client::HTTP's C method takes a few named parameters: =over 2 =item Agent => $user_agent_string =item Agent => \@list_of_agents If a UserAgent header is not present in the HTTP::Request, a random one will be used from those specified by the C parameter. If none are supplied, POE::Component::Client::HTTP will advertise itself to the server. C may contain a reference to a list of user agents. If this is the case, PoCo::Client::HTTP will choose one of them at random for each request. =item Alias => $session_alias C sets the name by which the session will be known. If no alias is given, the component defaults to "weeble". The alias lets several sessions interact with HTTP components without keeping (or even knowing) hard references to them. It's possible to spawn several HTTP components with different names. =item ConnectionManager => $poco_client_keepalive C sets this component's connection pool manager. It expects the connection manager to be a reference to a POE::Component::Client::Keepalive object. The HTTP client component will call C on the connection manager itself so you should not have done this already. my $pool = POE::Component::Client::Keepalive->new( keep_alive => 10, # seconds to keep connections alive max_open => 100, # max concurrent connections - total max_per_host => 20, # max concurrent connections - per host timeout => 30, # max time (seconds) to establish a new connection ); POE::Component::Client::HTTP->spawn( # ... ConnectionManager => $pool, # ... ); See L for more information, including how to alter the connection manager's resolver configuration (for example, to force IPv6 or prefer it before IPv4). =item CookieJar => $cookie_jar C sets the component's cookie jar. It expects the cookie jar to be a reference to a HTTP::Cookies object. =item From => $admin_address C holds an e-mail address where the client's administrator and/or maintainer may be reached. It defaults to undef, which means no From header will be included in requests. =item MaxSize => OCTETS C specifies the largest response to accept from a server. The content of larger responses will be truncated to OCTET octets. This has been used to return the section of web pages without the need to wade through . =item NoProxy => [ $host_1, $host_2, ..., $host_N ] =item NoProxy => "host1,host2,hostN" C specifies a list of server hosts that will not be proxied. It is useful for local hosts and hosts that do not properly support proxying. If NoProxy is not specified, a list will be taken from the NO_PROXY environment variable. NoProxy => [ "localhost", "127.0.0.1" ], NoProxy => "localhost,127.0.0.1", =item BindAddr => $local_ip Specify C to bind all client sockets to a particular local address. The value of BindAddr will be passed through POE::Component::Client::Keepalive to POE::Wheel::SocketFactory (as C). See that module's documentation for implementation details. BindAddr => "12.34.56.78" =item Protocol => $http_protocol_string C advertises the protocol that the client wishes to see. Under normal circumstances, it should be left to its default value: "HTTP/1.1". =item Proxy => [ $proxy_host, $proxy_port ] =item Proxy => $proxy_url =item Proxy => $proxy_url,$proxy_url,... C specifies one or more proxy hosts that requests will be passed through. If not specified, proxy servers will be taken from the HTTP_PROXY (or http_proxy) environment variable. No proxying will occur unless Proxy is set or one of the environment variables exists. The proxy can be specified either as a host and port, or as one or more URLs. Proxy URLs must specify the proxy port, even if it is 80. Proxy => [ "127.0.0.1", 80 ], Proxy => "http://127.0.0.1:80/", C may specify multiple proxies separated by commas. PoCo::Client::HTTP will choose proxies from this list at random. This is useful for load balancing requests through multiple gateways. Proxy => "http://127.0.0.1:80/,http://127.0.0.1:81/", =item Streaming => OCTETS C changes allows Client::HTTP to return large content in chunks (of OCTETS octets each) rather than combine the entire content into a single HTTP::Response object. By default, Client::HTTP reads the entire content for a response into memory before returning an HTTP::Response object. This is obviously bad for applications like streaming MP3 clients, because they often fetch songs that never end. Yes, they go on and on, my friend. When C is set to nonzero, however, the response handler receives chunks of up to OCTETS octets apiece. The response handler accepts slightly different parameters in this case. ARG0 is also an HTTP::Response object but it does not contain response content, and ARG1 contains a a chunk of raw response content, or undef if the stream has ended. sub streaming_response_handler { my $response_packet = $_[ARG1]; my ($response, $data) = @$response_packet; print SAVED_STREAM $data if defined $data; } =item FollowRedirects => $number_of_hops_to_follow C specifies how many redirects (e.g. 302 Moved) to follow. If not specified defaults to 0, and thus no redirection is followed. This maintains compatibility with the previous behavior, which was not to follow redirects at all. If redirects are followed, a response chain should be built, and can be accessed through $response_object->previous(). See HTTP::Response for details here. =item Timeout => $query_timeout C sets how long POE::Component::Client::HTTP has to process an application's request, in seconds. C defaults to 180 (three minutes) if not specified. It's important to note that the timeout begins when the component receives an application's request, not when it attempts to connect to the web server. Timeouts may result from sending the component too many requests at once. Each request would need to be received and tracked in order. Consider this: $_[KERNEL]->post(component => request => ...) for (1..15_000); 15,000 requests are queued together in one enormous bolus. The component would receive and initialize them in order. The first socket activity wouldn't arrive until the 15,000th request was set up. If that took longer than C, then the requests that have waited too long would fail. C's own timeout and concurrency limits also affect how many requests may be processed at once. For example, most of the 15,000 requests would wait in the connection manager's pool until sockets become available. Meanwhile, the C would be counting down. Applications may elect to control concurrency outside the component's C. They may do so in a few ways. The easiest way is to limit the initial number of requests to something more manageable. As responses arrive, the application should handle them and start new requests. This limits concurrency to the initial request count. An application may also outsource job throttling to another module, such as POE::Component::JobQueue. In any case, C and C may be tuned to maximize timeouts and concurrency limits. This may help in some cases. Developers should be aware that doing so will increase memory usage. POE::Component::Client::HTTP and KeepAlive track requests in memory, while applications are free to keep pending requests on disk. =back =head1 ACCEPTED EVENTS Sessions communicate asynchronously with PoCo::Client::HTTP. They post requests to it, and it posts responses back. =head2 request Requests are posted to the component's "request" state. They include an HTTP::Request object which defines the request. For example: $kernel->post( 'ua', 'request', # http session alias & state 'response', # my state to receive responses GET('http://poe.perl.org'), # a simple HTTP request 'unique id', # a tag to identify the request 'progress', # an event to indicate progress 'http://1.2.3.4:80/' # proxy to use for this request ); Requests include the state to which responses will be posted. In the previous example, the handler for a 'response' state will be called with each HTTP response. The "progress" handler is optional and if installed, the component will provide progress metrics (see sample handler below). The "proxy" parameter is optional and if not defined, a default proxy will be used if configured. No proxy will be used if neither a default one nor a "proxy" parameter is defined. =head2 pending_requests_count There's also a pending_requests_count state that returns the number of requests currently being processed. To receive the return value, it must be invoked with $kernel->call(). my $count = $kernel->call('ua' => 'pending_requests_count'); NOTE: Sometimes the count might not be what you expected, because responses are currently in POE's queue and you haven't processed them. This could happen if you configure the C's concurrency to a high enough value. =head2 cancel Cancel a specific HTTP request. Requires a reference to the original request (blessed or stringified) so it knows which one to cancel. See L below for notes on canceling streaming requests. To cancel a request based on its blessed HTTP::Request object: $kernel->post( component => cancel => $http_request ); To cancel a request based on its stringified HTTP::Request object: $kernel->post( component => cancel => "$http_request" ); =head2 shutdown Responds to all pending requests with 408 (request timeout), and then shuts down the component and all subcomponents. =head1 SENT EVENTS =head2 response handler In addition to all the usual POE parameters, HTTP responses come with two list references: my ($request_packet, $response_packet) = @_[ARG0, ARG1]; C<$request_packet> contains a reference to the original HTTP::Request object. This is useful for matching responses back to the requests that generated them. my $http_request_object = $request_packet->[0]; my $http_request_tag = $request_packet->[1]; # from the 'request' post C<$response_packet> contains a reference to the resulting HTTP::Response object. my $http_response_object = $response_packet->[0]; Please see the HTTP::Request and HTTP::Response manpages for more information. =head2 progress handler The example progress handler shows how to calculate a percentage of download completion. sub progress_handler { my $gen_args = $_[ARG0]; # args passed to all calls my $call_args = $_[ARG1]; # args specific to the call my $req = $gen_args->[0]; # HTTP::Request object being serviced my $tag = $gen_args->[1]; # Request ID tag from. my $got = $call_args->[0]; # Number of bytes retrieved so far. my $tot = $call_args->[1]; # Total bytes to be retrieved. my $oct = $call_args->[2]; # Chunk of raw octets received this time. my $percent = $got / $tot * 100; printf( "-- %.0f%% [%d/%d]: %s\n", $percent, $got, $tot, $req->uri() ); # To cancel the request: # $_[KERNEL]->post( component => cancel => $req ); } =head3 DEPRECATION WARNING The third return argument (the raw octets received) has been deprecated. Instead of it, use the Streaming parameter to get chunks of content in the response handler. =head1 REQUEST CALLBACKS The HTTP::Request object passed to the request event can contain a CODE reference as C. This allows for sending large files without wasting memory. Your callback should return a chunk of data each time it is called, and an empty string when done. Don't forget to set the Content-Length header correctly. Example: my $request = HTTP::Request->new( PUT => 'http://...' ); my $file = '/path/to/large_file'; open my $fh, '<', $file; my $upload_cb = sub { if ( sysread $fh, my $buf, 4096 ) { return $buf; } else { close $fh; return ''; } }; $request->content_length( -s $file ); $request->content( $upload_cb ); $kernel->post( ua => request, 'response', $request ); =head1 CONTENT ENCODING AND COMPRESSION Transparent content decoding has been disabled as of version 0.84. This also removes support for transparent gzip requesting and decompression. To re-enable gzip compression, specify the gzip Content-Encoding and use HTTP::Response's decoded_content() method rather than content(): my $request = HTTP::Request->new( GET => "http://www.yahoo.com/", [ 'Accept-Encoding' => 'gzip' ] ); # ... time passes ... my $content = $response->decoded_content(); The change in POE::Component::Client::HTTP behavior was prompted by changes in HTTP::Response that surfaced a bug in the component's transparent gzip handling. Allowing the application to specify and handle content encodings seems to be the most reliable and flexible resolution. For more information about the problem and discussions regarding the solution, see: L and L =head1 CLIENT HEADERS POE::Component::Client::HTTP sets its own response headers with additional information. All of its headers begin with "X-PCCH". =head2 X-PCCH-Errmsg POE::Component::Client::HTTP may fail because of an internal client error rather than an HTTP protocol error. X-PCCH-Errmsg will contain a human readable reason for client failures, should they occur. The text of X-PCCH-Errmsg may also be repeated in the response's content. =head2 X-PCCH-Peer X-PCCH-Peer contains the remote IPv4 address and port, separated by a period. For example, "127.0.0.1.8675" represents port 8675 on localhost. Proxying will render X-PCCH-Peer nearly useless, since the socket will be connected to a proxy rather than the server itself. This feature was added at Doreen Grey's request. Doreen wanted a means to find the remote server's address without having to make an additional request. =head1 ENVIRONMENT POE::Component::Client::HTTP uses two standard environment variables: HTTP_PROXY and NO_PROXY. HTTP_PROXY sets the proxy server that Client::HTTP will forward requests through. NO_PROXY sets a list of hosts that will not be forwarded through a proxy. See the Proxy and NoProxy constructor parameters for more information about these variables. =head1 SEE ALSO This component is built upon HTTP::Request, HTTP::Response, and POE. Please see its source code and the documentation for its foundation modules to learn more. If you want to use cookies, you'll need to read about HTTP::Cookies as well. Also see the test program, t/01_request.t, in the PoCo::Client::HTTP distribution. =head1 BUGS There is no support for CGI_PROXY or CgiProxy. Secure HTTP (https) proxying is not supported at this time. There is no object oriented interface. See L and L for examples of a decent OO interface. =head1 AUTHOR, COPYRIGHT, & LICENSE POE::Component::Client::HTTP is =over 2 =item Copyright 1999-2009 Rocco Caputo =item Copyright 2004 Rob Bloodgood =item Copyright 2004-2005 Martijn van Beers =back All rights are reserved. POE::Component::Client::HTTP is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 CONTRIBUTORS Joel Bernstein solved some nasty race conditions. Portugal Telecom L was kind enough to support his contributions. Jeff Bisbee added POD tests and documentation to pass several of them to version 0.79. He's a kwalitee-increasing machine! =head1 BUG TRACKER https://rt.cpan.org/Dist/Display.html?Queue=POE-Component-Client-HTTP =head1 REPOSITORY Github: L . Gitorious: L . =head1 OTHER RESOURCES L =cut # }}} POD POE-Component-Client-HTTP-0.948/lib/POE/Component/Client/HTTP/Request.pm000644 000765 000024 00000051431 12141763331 025347 0ustar00trocstaff000000 000000 package POE::Component::Client::HTTP::Request; { $POE::Component::Client::HTTP::Request::VERSION = '0.948'; } # vim: ts=2 sw=2 expandtab use strict; use warnings; use POE; use Carp; use HTTP::Status; use Errno qw(ETIMEDOUT); BEGIN { local $SIG{'__DIE__'} = 'DEFAULT'; # Allow more finely grained timeouts if Time::HiRes is available. # This code is also in POE::Component::Client::HTTP eval { require Time::HiRes; Time::HiRes->import("time"); }; } # Unique request ID, independent of wheel and timer IDs. my $request_seq = 0; use constant DEBUG => 0; # TODO CONNECT - Add a flag to indicate whether to generate an HTTP # CONNECT request for proxying, or to return REQ_HTTP_REQUEST. Add a # method to update that flag. use constant REQ_ID => 0; use constant REQ_POSTBACK => 1; use constant REQ_CONNECTION => 2; use constant REQ_HTTP_REQUEST => 3; use constant REQ_STATE => 4; use constant REQ_RESPONSE => 5; use constant REQ_BUFFER => 6; use constant REQ_OCTETS_GOT => 8; use constant REQ_TIMER => 9; use constant REQ_PROG_POSTBACK => 10; use constant REQ_USING_PROXY => 11; use constant REQ_HOST => 12; use constant REQ_PORT => 13; use constant REQ_HISTORY => 14; use constant REQ_START_TIME => 15; use constant REQ_FACTORY => 16; use constant REQ_CONN_ID => 17; use constant REQ_PEERNAME => 18; use constant RS_CONNECT => 0x01; # establishing a connection use constant RS_SENDING => 0x02; # sending request to server use constant RS_IN_HEAD => 0x04; # waiting for or receiving headers use constant RS_REDIRECTED => 0x08; # request has been redirected use constant RS_IN_CONTENT => 0x20; # waiting for or receiving content use constant RS_DONE => 0x40; # received full content use constant RS_POSTED => 0x80; # we have posted back a response sub import { my ($class) = shift; my $package = caller(); foreach my $tag (@_) { if ($tag eq ':fields') { foreach my $sub ( qw( REQ_ID REQ_POSTBACK REQ_CONNECTION REQ_HTTP_REQUEST REQ_STATE REQ_RESPONSE REQ_BUFFER REQ_OCTETS_GOT REQ_TIMER REQ_PROG_POSTBACK REQ_USING_PROXY REQ_HOST REQ_PORT REQ_HISTORY REQ_START_TIME REQ_CONN_ID REQ_PEERNAME ) ) { no strict 'refs'; *{$package . "::$sub"} = \&$sub; } } if ($tag eq ':states') { foreach my $sub ( qw( RS_CONNECT RS_SENDING RS_IN_HEAD RS_REDIRECTED RS_IN_CONTENT RS_DONE RS_POSTED ) ) { no strict 'refs'; *{$package . "::$sub"} = \&$sub; } } } } sub ID { my ($self) = @_; return $self->[REQ_ID]; } sub new { my $class = shift; croak __PACKAGE__ . "expects its arguments to be key/value pairs" if @_ & 1; my %params = @_; croak "need a Request parameter" unless (defined $params{'Request'}); croak "Request must be a HTTP::Request object" unless (UNIVERSAL::isa ($params{'Request'}, "HTTP::Request")); croak "need a Factory parameter" unless (defined $params{'Factory'}); my ($http_request, $postback, $progress, $factory) = @params{qw(Request Postback Progress Factory)}; my $request_id = ++$request_seq; DEBUG and warn "REQ: creating a request ($request_id)"; # Get the host and port from the request object. my ($host, $port, $scheme, $using_proxy); eval { $host = $http_request->uri()->host(); $port = $http_request->uri()->port(); $scheme = $http_request->uri()->scheme(); }; croak "Not a usable Request: $@" if ($@); # Add a host header if one isn't included. Must do this before # we reset the $host for the proxy! unless ( defined $http_request->header('Host') and length $http_request->header('Host') ) { my $error = _set_host_header($http_request); croak "Can't set Host header: $error" if $error; } if (defined $params{Proxy}) { # This request qualifies for proxying. Replace the host and port # with the proxy's host and port. This comes after the Host: # header is set, so it doesn't break the request object. ($host, $port) = @{$params{Proxy}->[rand @{$params{Proxy}}]}; $using_proxy = 1; } else { $using_proxy = 0; } # Build the request. my $self = [ $request_id, # REQ_ID $postback, # REQ_POSTBACK undef, # REQ_CONNECTION $http_request, # REQ_HTTP_REQUEST RS_CONNECT, # REQ_STATE undef, # REQ_RESPONSE '', # REQ_BUFFER undef, # unused 0, # REQ_OCTETS_GOT undef, # REQ_TIMER $progress, # REQ_PROG_POSTBACK $using_proxy, # REQ_USING_PROXY $host, # REQ_HOST $port, # REQ_PORT undef, # REQ_HISTORY time(), # REQ_START_TIME $factory, # REQ_FACTORY undef, # REQ_CONN_ID undef, # REQ_PEERNAME ]; return bless $self, $class; } sub return_response { my ($self) = @_; DEBUG and warn "in return_response ", sprintf ("0x%02X", $self->[REQ_STATE]); return if ($self->[REQ_STATE] & RS_POSTED); my $response = $self->[REQ_RESPONSE]; # If we have a cookie jar, have it frob our headers. LWP rocks! $self->[REQ_FACTORY]->frob_cookies ($response); # If we're done, send back the HTTP::Response object, which # is filled with content if we aren't streaming, or empty # if we are. that there's no ARG1 lets the client know we're done # with the content in the latter case if ($self->[REQ_STATE] & RS_DONE) { DEBUG and warn "done; returning $response for ", $self->[REQ_ID]; $self->[REQ_POSTBACK]->($self->[REQ_RESPONSE]); $self->[REQ_STATE] |= RS_POSTED; #warn "state is now ", $self->[REQ_STATE]; } elsif ($self->[REQ_STATE] & RS_IN_CONTENT) { # If we are streaming, send the chunk back to the client session. # Otherwise add the new octets to the response's content. # This should only add up to content-length octets total! if ($self->[REQ_FACTORY]->is_streaming) { DEBUG and warn "returning partial $response"; $self->[REQ_POSTBACK]->($self->[REQ_RESPONSE], $self->[REQ_BUFFER]); } else { DEBUG and warn "adding to $response"; $self->[REQ_RESPONSE]->add_content($self->[REQ_BUFFER]); } } $self->[REQ_BUFFER] = ''; } sub add_eof { my ($self) = @_; return if ($self->[REQ_STATE] & RS_POSTED); unless (defined $self->[REQ_RESPONSE]) { # XXX I don't know if this is actually used $self->error(400, "incomplete response a " . $self->[REQ_ID]); return; } # RFC 2616: "If a message is received with both a Transfer-Encoding # header field and a Content-Length header field, the latter MUST be # ignored." # # Google returns a Content-Length header with its HEAD request, # generating "incomplete response" errors. Added a special case to # ignore content for HEAD requests. This may thwart keep-alive, # however. if ( $self->[REQ_HTTP_REQUEST]->method() ne "HEAD" and defined $self->[REQ_RESPONSE]->content_length and not defined $self->[REQ_RESPONSE]->header("Transfer-Encoding") and $self->[REQ_OCTETS_GOT] < $self->[REQ_RESPONSE]->content_length ) { DEBUG and warn( "got " . $self->[REQ_OCTETS_GOT] . " of " . $self->[REQ_RESPONSE]->content_length ); $self->error( 400, "incomplete response b " . $self->[REQ_ID] . ". Wanted " . $self->[REQ_RESPONSE]->content_length() . " octets. Got " . $self->[REQ_OCTETS_GOT] . "." ); } else { $self->[REQ_STATE] |= RS_DONE; $self->return_response(); } } sub add_content { my ($self, $data) = @_; if (ref $data) { $self->[REQ_STATE] = RS_DONE; $data->scan (sub {$self->[REQ_RESPONSE]->header (@_) }); return 1; } $self->[REQ_BUFFER] .= $data; # Count how many octets we've received. -><- This may fail on # perl 5.8 if the input has been identified as Unicode. Then # again, the C in Driver::SysRW may have untainted the # data... or it may have just changed the semantics of length() # therein. If it's done the former, then we're safe. Otherwise # we also need to C. # TODO: write test(s) for this. my $this_chunk_length = length($self->[REQ_BUFFER]); $self->[REQ_OCTETS_GOT] += $this_chunk_length; my $max = $self->[REQ_FACTORY]->max_response_size(); DEBUG and warn( "REQ: request ", $self->ID, " received $self->[REQ_OCTETS_GOT] bytes; maximum is $max" ); # Fail if we've gone over the maximum content size to return. if (defined $max and $self->[REQ_OCTETS_GOT] > $max) { $self->error( 406, "Response content is longer than specified MaxSize of $max. " . "Use range requests to retrieve specific amounts of content." ); $self->[REQ_STATE] |= RS_DONE; $self->[REQ_STATE] &= ~RS_IN_CONTENT; return 1; } # keep this for the progress callback (it gets cleared in return_response # as I say below, this needs to go away. my $buffer = $self->[REQ_BUFFER]; $self->return_response; DEBUG and do { warn( "REQ: request ", $self->ID, " got $this_chunk_length octets of content..." ); warn( "REQ: request ", $self->ID, " has $self->[REQ_OCTETS_GOT]", ( $self->[REQ_RESPONSE]->content_length() ? ( " out of " . $self->[REQ_RESPONSE]->content_length() ) : "" ), " octets" ); }; if ($self->[REQ_RESPONSE]->content_length) { # Report back progress $self->[REQ_PROG_POSTBACK]->( $self->[REQ_OCTETS_GOT], $self->[REQ_RESPONSE]->content_length, #TODO: ugh. this is stupid. Must remove/deprecate! $buffer, ) if ($self->[REQ_PROG_POSTBACK]); # Stop reading when we have enough content. -><- Should never be # greater than our content length. if ($self->[REQ_OCTETS_GOT] >= $self->[REQ_RESPONSE]->content_length) { DEBUG and warn( "REQ: request ", $self->ID, " has a full response... moving to done." ); $self->[REQ_STATE] |= RS_DONE; $self->[REQ_STATE] &= ~RS_IN_CONTENT; return 1; } } return 0; } sub timer { my ($self, $timer) = @_; # do it this way so we can set REQ_TIMER to undef if (@_ == 2) { die "overwriting timer $self->[REQ_TIMER]" if $self->[REQ_TIMER]; $self->[REQ_TIMER] = $timer; } return $self->[REQ_TIMER]; } sub create_timer { my ($self, $timeout) = @_; # remove old timeout first my $kernel = $POE::Kernel::poe_kernel; my $seconds = $timeout - (time() - $self->[REQ_START_TIME]); $self->[REQ_TIMER] = $kernel->delay_set( got_timeout => $seconds, $self->ID ); DEBUG and warn( "TKO: request ", $self->ID, " has timer $self->[REQ_TIMER] going off in $seconds seconds\n" ); } sub remove_timeout { my ($self) = @_; my $alarm_id = $self->[REQ_TIMER]; if (defined $alarm_id) { my $kernel = $POE::Kernel::poe_kernel; DEBUG and warn "REQ: Removing timer $alarm_id"; $kernel->alarm_remove($alarm_id); $self->[REQ_TIMER] = undef; } } sub postback { my ($self, $postback) = @_; if (defined $postback) { DEBUG and warn "REQ: modifying postback"; $self->[REQ_POSTBACK] = $postback; } return $self->[REQ_POSTBACK]; } sub _set_host_header { my ($request) = @_; my $uri = $request->uri; my ($new_host, $new_port); eval { $new_host = $uri->host(); $new_port = $uri->port(); # Only include the port if it's nonstandard. if ($new_port == 80 || $new_port == 443) { $request->header( Host => $new_host ); } else { $request->header( Host => "$new_host:$new_port" ); } }; # Return Boolean state of the eval. return $@; } sub does_redirect { my ($self, $last) = @_; if (defined $last) { $self->[REQ_HISTORY] = $last; # delete OLD timeout #my $alarm_id = $last->[REQ_TIMEOUT]; #DEBUG and warn "RED: Removing old timeout $alarm_id\n"; #$POE::Kernel::poe_kernel->alarm_remove ($alarm_id); } return defined $self->[REQ_HISTORY]; } sub check_redirect { my ($self) = @_; my $max = $self->[REQ_FACTORY]->max_redirect_count; if (defined $self->[REQ_HISTORY]) { $self->[REQ_RESPONSE]->previous($self->[REQ_HISTORY]->[REQ_RESPONSE]); } return undef unless ($self->[REQ_RESPONSE]->is_redirect); # Make sure to frob any cookies set. Redirect cookies are cookies, too! $self->[REQ_FACTORY]->frob_cookies($self->[REQ_RESPONSE]); my $location_uri = $self->[REQ_RESPONSE]->header('Location'); DEBUG and warn "REQ: Preparing redirect to $location_uri"; my $base = $self->[REQ_RESPONSE]->base(); $location_uri = URI->new($location_uri, $base)->abs($base); DEBUG and warn "RED: Actual redirect uri is $location_uri"; my $prev = $self; my $history = 0; while ($prev = $prev->[REQ_HISTORY]) { last if ++$history > $max; } if ($history >= $max) { #$self->[REQ_STATE] |= RS_DONE; DEBUG and warn "RED: Too much redirection"; } else { # All fine, yield new request and mark this disabled. my $newrequest = $self->[REQ_HTTP_REQUEST]->clone(); # Sanitize new request per rt #30400. # TODO - What other headers are security risks? $newrequest->remove_header('Cookie'); DEBUG and warn "RED: new request $newrequest"; $newrequest->uri($location_uri); # Don't change the Host header on a relative redirect. This # allows the HTTP::Request's Host to remain intact, per # rt.cpan.org #63990. if (defined $location_uri->scheme()) { DEBUG and warn "RED: redirecting to absolute location $location_uri"; _set_host_header($newrequest); } else { DEBUG and warn "RED: no new Host for relative redirect to $location_uri"; } $self->[REQ_STATE] = RS_REDIRECTED; DEBUG and warn "RED: new request $newrequest"; return $newrequest; } return undef; } sub send_to_wheel { my ($self) = @_; $self->[REQ_STATE] = RS_SENDING; my $http_request = $self->[REQ_HTTP_REQUEST]; # MEXNIX 2002-06-01: Check for proxy. Request query is a bit # different... my $request_uri; if ($self->[REQ_USING_PROXY]) { $request_uri = $http_request->uri()->canonical(); } else { $request_uri = $http_request->uri()->canonical()->path_query(); } my $request_string = ( $http_request->method() . ' ' . $request_uri . ' ' . $http_request->protocol() . "\x0D\x0A" . $http_request->headers_as_string("\x0D\x0A") . "\x0D\x0A" ); if ( !ref $http_request->content() ) { $request_string .= $http_request->content(); # . "\x0D\x0A" } DEBUG and do { my $formatted_request_string = $request_string; $formatted_request_string =~ s/([^\n])$/$1\n/; $formatted_request_string =~ s/^/| /mg; warn ",----- SENDING REQUEST ", '-' x 56, "\n"; warn $formatted_request_string; warn "`", '-' x 78, "\n"; }; $self->[REQ_CONNECTION]->wheel->put ($request_string); } sub wheel { my ($self) = @_; # FIXME - We don't support older versions of POE. Remove this chunk # of code when we're not fixing something else. # #if (defined $new_wheel) { # Switch wheels. This is cumbersome, but it works around a bug in # older versions of POE. # $self->[REQ_WHEEL] = undef; # $self->[REQ_WHEEL] = $new_wheel; #} return unless $self->[REQ_CONNECTION]; return $self->[REQ_CONNECTION]->wheel; } sub error { my ($self, $code, $message) = @_; my $nl = "\n"; my $http_msg = status_message($code); my $r = HTTP::Response->new($code, $http_msg, [ 'X-PCCH-Errmsg', $message ]); my $m = ( "$nl" . "Error: $http_msg$nl" . "$nl" . "

Error: $http_msg

$nl" . "$message$nl" . "This is a client error, not a server error.$nl" . "$nl" . "$nl" ); $r->content($m); $r->request($self->[REQ_HTTP_REQUEST]); $self->[REQ_POSTBACK]->($r); $self->[REQ_STATE] |= RS_POSTED; } sub connect_error { my ($self, $operation, $errnum, $errstr) = @_; my $host = $self->[REQ_HOST]; my $port = $self->[REQ_PORT]; if ($operation eq "connect" and $errnum == ETIMEDOUT) { $self->error(408, "Connection to $host:$port failed: timeout"); } else { $self->error( RC_INTERNAL_SERVER_ERROR, "Connection to $host:$port failed: $operation error $errnum: $errstr" ); } return; } sub host { shift->[REQ_HOST] } sub port { shift->[REQ_PORT] } sub scheme { my $self = shift; $self->[REQ_USING_PROXY] ? 'http' : $self->[REQ_HTTP_REQUEST]->uri->scheme; } sub DESTROY { my ($self) = @_; delete $self->[REQ_CONNECTION]; delete $self->[REQ_FACTORY]; } 1; __END__ =head1 NAME POE::Component::Client::HTTP::Request - an HTTP request class =head1 VERSION version 0.948 =head1 SYNOPSIS # Used internally by POE::Component::Client::HTTP =head1 DESCRIPTION POE::Component::Client::HTTP::Request encapsulates the state of requests POE::Component::Client::HTTP requests throughout their life cycles. There turns out to be a lot of state to manage. =head1 CONSTRUCTOR =head2 new NAMED_PARAMETERS Create a POE::Component::Client::HTTP object to manage a request. The constructor takes several named parameters: =over 2 =item Request => HTTP_REQUEST A POE::Component::Client::HTTP::Request object encapsulates a plain HTTP::Request. Required. =item Factory => POE_COMPONENT_CLIENT_HTTP_REQUESTFACTORY The request may create additional requests during its lifetime, for example when following redirects. The Factory parameter specifies the POE::Component::Client::HTTP::RequestFactory that may be used to create them. Required. =item Postback => RESPONSE_POSTBACK POE::Component::Client::HTTP creates a postback that will be used to send responses to the requesting session. Required. =item Progress => PROGRESS_POSTBACK Sets the progress notification if the user has requested progress events. Optional. =item Proxy Sets the proxy used for this request, if requested by the user. Optional. =back =head1 METHODS =head2 ID Return the request's unique ID. =head2 return_response Sends a response back to the user's session. Called by POE::Component::Client::HTTP when a complete response has arrived. =head2 add_eof Called by POE::Component::Client::HTTP to indicate EOF has arrived. =head2 add_content PARSED_DATA Called by POE::Component::Client::HTTP to add content data to an incrementally built response. If PARSED_DATA is an object, it is treated like an HTTP::Headers object and its headers are assimilated into the response being built by the request. Otherwise the PARSED_DATA is appended to the response's content. =head2 timer TIMER Accessor to manipulate the request's timeout timer. Sets the request's timer if TIMER is specified, otherwise merely fetches the one currently associated with the request. =head2 create_timer TIMEOUT Creates and sets a timer for this request. TIMEOUT is the number of seconds this request may live. =head2 remove_timeout Turn off the timer associated with this request, and discard it. =head2 postback POSTBACK Accessor to manipulate the postback associated with this request. Sets the postback if POSTBACK is defined, otherwise merely fetches it. =head2 does_redirect SOMETHING FIXME - Not sure what this accessor does. =head2 check_redirect Check whether the last response is a redirect, the request is permitted to follow redirects, and the maximum number of redirects has not been met. Initiate a redirect if all conditions are favorable. =head2 send_to_wheel Transmit the request to the socket associated with this request. =head2 wheel An accessor to return the wheel associated with this request. =head2 error ERROR_CODE, ERROR_MESSAGE Generate an error response, and post it back to the user's session. =head2 connect_error CONNECT_FAILURE_MESSAGE Generate a connection error response, and post it back to the user's session. =head2 host Return the host this request is attempting to work with. =head2 port Return the port this request is attempting to work with. =head2 scheme Return the scheme for this request. =head1 SEE ALSO L L =head1 BUGS None are currently known. =head1 AUTHOR & COPYRIGHTS POE::Component::Client::HTTP::Request is =over 2 =item Copyright 2004-2005 Martijn van Beers =item Copyright 2006 Rocco Caputo =back All rights are reserved. POE::Component::Client::HTTP::Request is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 CONTRIBUTORS Your name could be here. =head1 CONTACT Rocco may be contacted by e-mail via L, and Martijn may be contacted by email via L. The preferred way to report bugs or requests is through RT though. See L or mail L For questions, try the L mailing list (poe@perl.org) =cut POE-Component-Client-HTTP-0.948/lib/POE/Component/Client/HTTP/RequestFactory.pm000644 000765 000024 00000023601 12141763331 026675 0ustar00trocstaff000000 000000 package POE::Component::Client::HTTP::RequestFactory; { $POE::Component::Client::HTTP::RequestFactory::VERSION = '0.948'; } # vim: ts=2 sw=2 expandtab use strict; use warnings; use Carp; use POE::Component::Client::HTTP::Request; use POE::Component::Client::HTTP; use constant FCT_AGENT => 0; use constant FCT_STREAMING => 1; use constant FCT_MAXSIZE => 2; use constant FCT_PROTOCOL => 3; use constant FCT_COOKIEJAR => 4; use constant FCT_FROM => 5; use constant FCT_NOPROXY => 6; use constant FCT_HTTP_PROXY => 7; use constant FCT_FOLLOWREDIRECTS => 8; use constant FCT_TIMEOUT => 9; use constant DEBUG => 0; use constant DEFAULT_BLOCK_SIZE => 4096; =head1 NAME POE::Component::Client::HTTP::RequestFactory - an HTTP request factory object =head1 VERSION version 0.948 =head1 SYNOPSIS # Used internally by POE::Component::Client::HTTP =head1 CONSTRUCTOR =head2 new Create a new request factory object. It expects its parameters in a hashref. The following parameters are accepted. They are explained in detail in L. =over 4 =item Agent =item MaxSize =item Streaming =item Protocol =item From =item CookieJar =item NoProxy =item Proxy =item FollowRedirects =item Timeout =back =cut sub new { my ($class, $params) = @_; croak __PACKAGE__ . "expects its arguments in a hashref" unless (!defined ($params) or ref($params) eq 'HASH'); # Accept an agent, or a reference to a list of agents. my $agent = delete $params->{Agent}; $agent = [] unless defined $agent; $agent = [ $agent ] unless ref($agent); unless (ref($agent) eq "ARRAY") { croak "Agent must be a scalar or a reference to a list of agent strings"; } my $v = $POE::Component::Client::HTTP::VERSION; push( @$agent, sprintf( 'POE-Component-Client-HTTP/%s (perl; N; POE; en; rv:%f)', $v, $v ) ) unless @$agent; my $max_size = delete $params->{MaxSize}; my $streaming = delete $params->{Streaming}; my $protocol = delete $params->{Protocol}; $protocol = 'HTTP/1.1' unless defined $protocol and length $protocol; my $cookie_jar = delete $params->{CookieJar}; my $from = delete $params->{From}; my $no_proxy = delete $params->{NoProxy}; my $proxy = delete $params->{Proxy}; my $follow_redirects = delete $params->{FollowRedirects} || 0; my $timeout = delete $params->{Timeout}; # Process HTTP_PROXY and NO_PROXY environment variables. $proxy = $ENV{HTTP_PROXY} || $ENV{http_proxy} unless defined $proxy; $no_proxy = $ENV{NO_PROXY} || $ENV{no_proxy} unless defined $no_proxy; # Translate environment variable formats into internal versions. $class->parse_proxy($proxy) if defined $proxy; if (defined $no_proxy) { unless (ref($no_proxy) eq 'ARRAY') { $no_proxy = [ split(/\s*\,\s*/, $no_proxy) ]; } } $timeout = 180 unless (defined $timeout and $timeout > 0); my $self = [ $agent, # FCT_AGENT $streaming, # FCT_STREAMING $max_size, # FCT_MAXSIZE $protocol, # FCT_PROTOCOL $cookie_jar, # FCT_COOKIEJAR $from, # FCT_FROM $no_proxy, # FCT_NOPROXY $proxy, # FCT_HTTP_PROXY $follow_redirects, # FCT_FOLLOWREDIRECTS $timeout, # FCT_TIMEOUT ]; return bless $self, $class; } =head1 METHODS =head2 timeout [$timeout] Method that lets you query and/or change the timeout value for requests created by this factory. =cut sub timeout { my ($self, $timeout) = @_; if (defined $timeout) { $self->[FCT_TIMEOUT] = $timeout; } return $self->[FCT_TIMEOUT]; } =head2 is_streaming Accessor for the Streaming parameter =cut sub is_streaming { my ($self) = @_; DEBUG and warn( "FCT: this is " . ($self->[FCT_STREAMING] ? "" : "not ") . "streaming" ); return $self->[FCT_STREAMING]; } =head2 agent Accessor to the Agent parameter =cut sub agent { my ($self) = @_; return $self->[FCT_AGENT]->[rand @{$self->[FCT_AGENT]}]; } =head2 from getter/setter for the From parameter =cut sub from { my ($self) = @_; if (defined $self->[FCT_FROM] and length $self->[FCT_FROM]) { return $self->[FCT_FROM]; } return undef; } =head2 create_request Creates a new L =cut sub create_request { my ($self, $http_request, $response_event, $tag, $progress_event, $proxy_override, $sender) = @_; # Add a protocol if one isn't included. $http_request->protocol( $self->[FCT_PROTOCOL] ) unless ( defined $http_request->protocol() and length $http_request->protocol() ); # Add the User-Agent: header if one isn't included. unless (defined $http_request->user_agent()) { $http_request->user_agent($self->agent); } # Add a From: header if one isn't included. if (defined $self->from) { my $req_from = $http_request->from(); unless (defined $req_from and length $req_from) { $http_request->from( $self->from ); } } # Add a Content-Length header if this request has content but # doesn't have a Content-Length header already. Also, don't do it # if the content is a reference, as this means we're streaming via # callback. if ( length($http_request->content()) and !ref($http_request->content()) and !$http_request->content_length() ) { use bytes; $http_request->content_length(length($http_request->content())); } my ($last_request, $postback); if (ref($response_event) eq 'POE::Component::Client::HTTP::Request') { $last_request = $response_event; $postback = $last_request->postback; } else { $postback = $sender->postback( $response_event, $http_request, $tag ); } # Create a progress postback if requested. my $progress_postback; if (defined $progress_event) { if (ref $progress_event) { # The given progress event appears to already # be a postback, so use it. This is needed to # propagate the postback through redirects. $progress_postback = $progress_event; } else { $progress_postback = $sender->postback( $progress_event, $http_request, $tag ); } } # If we have a cookie jar, have it add the appropriate headers. # LWP rocks! if (defined $self->[FCT_COOKIEJAR]) { $self->[FCT_COOKIEJAR]->add_cookie_header($http_request); } # MEXNIX 2002-06-01: If we have a proxy set, and the request URI is # not in our no_proxy, then use the proxy. Otherwise use the # request URI. # # RCAPUTO 2006-03-23: We only support http proxying right now. # Avoid proxying if this isn't an http request. # TODO CONNECT - Create a PCCH::Request object in https-CONNECT mode # if we're using https and there's an appropriate proxy. my $proxy = $proxy_override; if ($http_request->uri->scheme() eq "http") { $proxy ||= $self->[FCT_HTTP_PROXY]; } if (defined $proxy) { # This request qualifies for proxying. Replace the host and port # with the proxy's host and port. This comes after the Host: # header is set, so it doesn't break the request object. my $host = $http_request->uri->host; undef $proxy if ( !defined($host) or _in_no_proxy ($host, $self->[FCT_NOPROXY]) ); } my $request = POE::Component::Client::HTTP::Request->new ( Request => $http_request, Proxy => $proxy, Postback => $postback, #Tag => $tag, # TODO - Is this needed for anything? Progress => $progress_postback, Factory => $self, ); if (defined $last_request) { $request->does_redirect($last_request); } return $request; } # Determine whether a host is in a no-proxy list. # {{{ _in_no_proxy sub _in_no_proxy { my ($host, $no_proxy) = @_; foreach my $no_proxy_domain (@$no_proxy) { return 1 if $host =~ /\Q$no_proxy_domain\E$/i; } return 0; } # }}} _in_no_proxy =head2 max_response_size Method to retrieve the maximum size of a response, as set by the C parameter to L's C method. =cut sub max_response_size { my ($self) = @_; return $self->[FCT_MAXSIZE]; } =head2 block_size Accessor for the Streaming parameter =cut sub block_size { my ($self) = @_; my $block_size = $self->[FCT_STREAMING] || DEFAULT_BLOCK_SIZE; $block_size = DEFAULT_BLOCK_SIZE if $block_size < 1; return $block_size; } =head2 frob_cookies $response Store the cookies from the L parameter passed into our cookie jar =cut sub frob_cookies { my ($self, $response) = @_; if (defined $self->[FCT_COOKIEJAR]) { $self->[FCT_COOKIEJAR] ->extract_cookies($response); } } =head2 max_redirect_count [$count] Function to get/set the maximum number of redirects to follow automatically. This allows you to retrieve or modify the value you passed with the FollowRedirects parameter to L's C method. =cut sub max_redirect_count { my ($self, $count) = @_; if (defined $count) { $self->[FCT_FOLLOWREDIRECTS] = $count; } return $self->[FCT_FOLLOWREDIRECTS]; } =head2 parse_proxy $proxy This static method is used for parsing proxies. The $proxy can be array reference like [host, port] or comma separated string like "http://1.2.3.4:80/,http://2.3.4.5:80/". parse_proxy() returns an array reference of two-element tuples (also array ferences), each containing a host and a port: [ [ host1, port1 ], [ host2, port2 ], ... ] =cut sub parse_proxy { my $proxy = $_[1]; if (ref($proxy) eq 'ARRAY') { croak "Proxy must contain [HOST,PORT]" unless @$proxy == 2; $proxy = [ $proxy ]; } else { my @proxies = split /\s*\,\s*/, $proxy; foreach (@proxies) { s/^http:\/+//; s/\/+$//; croak "Proxy must contain host:port" unless /^(.+):(\d+)$/; $_ = [ $1, $2 ]; } if (@proxies) { $proxy = \@proxies; } else { undef $proxy; # Empty proxy list means not to use proxy } } $_[1] = $proxy; } 1; POE-Component-Client-HTTP-0.948/examples/pcchget.perl000644 000765 000024 00000002736 12141763331 022354 0ustar00trocstaff000000 000000 #!perl # A short program to dump requests and responses. # Provided by Toby Ovod-Everett. Thanks! use strict; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use HTTP::Request; use POE qw(Component::Client::HTTP); POE::Component::Client::HTTP->spawn( Alias => 'ua', # defaults to 'weeble' Timeout => 20, # defaults to 180 seconds ); POE::Session->create( inline_states => { _start => sub { POE::Kernel->post( 'ua', # posts to the 'ua' alias 'request', # posts to ua's 'request' state 'response', # which of our states will receive the response HTTP::Request->new(GET => $ARGV[0]), # an HTTP::Request object ); }, _stop => sub {}, response => \&response_handler, }, ); POE::Kernel->run(); exit; sub response_handler { my ($request_packet, $response_packet) = @_[ARG0, ARG1]; my $request_object = $request_packet->[0]; my $response_object = $response_packet->[0]; my $stream_chunk; if (!defined($response_object->content)) { $stream_chunk = $response_packet->[1]; } print( "*" x 78, "\n", "*** my request:\n", "-" x 78, "\n", $request_object->as_string(), "*" x 78, "\n", "*** their response:\n", "-" x 78, "\n", $response_object->as_string(), ); if (defined $stream_chunk) { print( "-" x 40, "\n", $stream_chunk, "\n" ); } print "*" x 78, "\n"; }