POE-Component-Client-HTTP-0.949000755000765000024 012357031634 15352 5ustar00trocstaff000000000000README100644000765000024 4716012357031634 16343 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949NAME POE::Component::Client::HTTP - a HTTP user-agent component VERSION version 0.949 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 CHANGES100644000765000024 741312357031634 16433 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949================================================== Changes from 2013-07-08 00:00:00 +0000 to present. ================================================== ------------------------------------------ version 0.949 at 2014-07-08 18:08:22 +0000 ------------------------------------------ Change: 85e65e6e90de281c8212e152aa1a5681cfbedc54 Author: Rocco Caputo Date : 2014-07-08 14:05:32 +0000 Enable POE::Kernel::ASSERT_DEFAULT during test. Change: 4ca245d4725b829f95ee3176db92cd0a20e96e47 Author: Rocco Caputo Date : 2013-12-11 00:10:29 +0000 Avoid having two different HTTP version numbers in the response status line. Addresses a condition where response objects reported their status as "HTTP/0.9 200 OK HTTP/1.1". Change: 03af0affe03b90d3277b5b0b5be702bd0a88ac1a Author: Rocco Caputo Date : 2013-09-14 19:09:44 +0000 Style changes. Change: e4fb6f3b483e26d09492b3667a06fb6558fdb022 Author: Rocco Caputo Date : 2013-09-12 00:01:29 +0000 Consolidate connection closing code. Makes connection shutdown a little more consistent. Also fixes a bug where the wrong object ID was used to look up part of the connection state. Change: d1a4eda2246275b887edf63a18d9fb9678a55017 Author: Rocco Caputo Date : 2013-09-11 23:59:36 +0000 Style change. Consolidate C statements. Change: efe0ad26dfdea6e79a18c85ab31a70557d7693d7 Author: Rocco Caputo Date : 2013-09-08 01:30:46 +0000 Provide a dummy version number for development testing. The default connection string is based on the component version, which stopped being defined in-house since the move to Dist::Zilla. Tests were noisy and ugly with moot "uninitialized value" warnings. Change: 2de81a5dd9989077cdf5748a779c22aacde0ac1d Author: Rocco Caputo Date : 2013-09-08 01:28:08 +0000 On a shutdown, deallocate the proper keep-alive connection ID. It was deallocating the PoCo::Client::HTTP request ID, which isn't coupled to the PoCo::Client::Keepalive ID at all. The problem wasn't apparent before because IDs were coincidentally in synch. Recent changes finally desynchronized them. Change: f4e02b31ad4cc65d7444b02a982225ba57949570 Author: Rocco Caputo Date : 2013-09-07 23:29:20 +0000 Honor "Connection: close" response header by closing the connection. Without closing the connection, POE::Component::Client::Keepalive would put the connection back into its pool and detect closure when the server later shut down the socket. Nicolas Dehaine and Brad Sacks discovered this to be a problem when they tried to make a lot of rapid connections to a single address. The to-be-defunct connection didn't have enough time to shut down, so it would be returned to POE::Component::Client::HTTP. The HTTP transaction would then fail, and an error would be reported. Their test case allowed me to repeat the problem and diagnose it. Otherwise this would still be broken. Thanks, guys! Change: cca6b68f0df0cacb6b82c961f5456bd98a9978fa Author: Rocco Caputo Date : 2013-09-07 23:28:56 +0000 Clean up some constant definitions. No change in functionality. Change: 525cd6d8e64790e5ad14b6b986106210e82564d4 Author: Rocco Caputo Date : 2013-07-15 23:56:30 +0000 Bypass proxies for tests that make localhost connections. Localhost is relative, and it's often not what's expective when proxying is turned on without an exception for it. ================================================= Plus 61 releases after 2013-07-08 00:00:00 +0000. ================================================= LICENSE100644000765000024 4365512357031634 16475 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949This software is copyright (c) 2014 by Rocco Caputo. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2014 by Rocco Caputo. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2014 by Rocco Caputo. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644000765000024 246612357031634 17107 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949name = 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] META.yml100644000765000024 160512357031634 16706 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949--- 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 5.019, CPAN::Meta::Converter version 2.141520' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: POE-Component-Client-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.949' MANIFEST100644000765000024 171612357031634 16571 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.019. 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 t000755000765000024 012357031634 15536 5ustar00trocstaff000000000000POE-Component-Client-HTTP-0.94901_ssl.t100644000765000024 342312357031634 17166 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# 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; 12_pod.t100644000765000024 26512357031634 17132 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!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(); README.mkdn100644000765000024 4660112357031634 17272 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949# NAME POE::Component::Client::HTTP - a HTTP user-agent component # VERSION version 0.949 # 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](https://metacpan.org/pod/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"](#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: [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](https://metacpan.org/pod/POE::Component::Client::Keepalive) and [POE::Component::Resolver](https://metacpan.org/pod/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/) CHANGES.OLD100644000765000024 660212357031634 17047 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949============ 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. =========================== Makefile.PL100644000765000024 324112357031634 17405 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.019. use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "a HTTP user-agent component", "AUTHOR" => "Rocco Caputo ", "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.949", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "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" ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); 07_proxy.t100644000765000024 2027212357031634 17575 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#! /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"); } MANIFEST.SKIP100600000765000024 32012357031634 17274 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949CVS \.\# \.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$ ~$ 01_stream.t100644000765000024 1025612357031634 17702 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# vim: filetype=perl sw=2 ts=2 expandtab use strict; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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"); } } 11_cancel.t100644000765000024 704312357031634 17615 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/usr/bin/perl -w # vim: ts=2 sw=2 filetype=perl expandtab use strict; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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' ); } 01_request.t100644000765000024 1170112357031634 20073 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# vim: filetype=perl sw=2 ts=2 expandtab use strict; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } #sub POE::Kernel::ASSERT_DEFAULT () { 1 } 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 )], ], inline_states => { testd_client_flushed => sub { undef }, testd_connected => sub { undef }, testd_disconnected => sub { undef }, _stop => sub { undef }, }, ); $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(")))"); } } 05_request.t100644000765000024 253012357031634 20057 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# 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'); 06_factory.t100644000765000024 335312357031634 20043 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# 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'); 08_discard.t100644000765000024 343112357031634 20004 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#! /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; 10_shutdown.t100644000765000024 500412357031634 20235 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/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'); } 02_keepalive.t100644000765000024 1054012357031634 20351 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# vim: filetype=perl sw=2 ts=2 expandtab use strict; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; 03_head_filter.t100644000765000024 611312357031634 20634 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# 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-- 04_chunk_filter.t100644000765000024 1334012357031634 21064 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# 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"); } 13_pod_coverage.t100644000765000024 32512357031634 21003 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!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(); 59_incomplete_b.t100644000765000024 512012357031634 21036 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# vim: filetype=perl ts=2 sw=2 expandtab use strict; use warnings; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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' ); } 51_santos_status.t100644000765000024 151412357031634 21303 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# 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. examples000755000765000024 012357031634 17111 5ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949pcchget.perl100644000765000024 273612357031634 21562 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/examples#!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"; } 14_gzipped_content.t100644000765000024 1055012357031634 21604 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/usr/bin/perl # vim: filetype=perl ts=2 sw=2 expandtab # Test gzip'd content encoding. use warnings; use strict; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; 53_response_parser.t100644000765000024 1135412357031634 21630 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/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; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; 56_redirect_excess.t100644000765000024 472312357031634 21556 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/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; 57_pravus_progress.t100644000765000024 322712357031634 21646 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t# 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}"); } 60_rt50231_pending.t100644000765000024 616612357031634 21125 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/usr/bin/perl use strict; use warnings; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; } release-pod-syntax.t100644000765000024 45612357031634 21574 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 000-report-versions.t100644000765000024 3127012357031634 21564 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!perl use warnings; use strict; use Test::More 0.94; # Include a cut-down version of YAML::Tiny so we don't introduce unnecessary # dependencies ourselves. package Local::YAML::Tiny; use strict; use Carp 'croak'; # UTF Support? sub HAVE_UTF8 () { $] >= 5.007003 } BEGIN { if ( HAVE_UTF8 ) { # The string eval helps hide this from Test::MinimumVersion eval "require utf8;"; die "Failed to load UTF-8 support" if $@; } # Class structure require 5.004; $YAML::Tiny::VERSION = '1.40'; # Error storage $YAML::Tiny::errstr = ''; } # Printable characters for escapes my %UNESCAPES = ( z => "\x00", a => "\x07", t => "\x09", n => "\x0a", v => "\x0b", f => "\x0c", r => "\x0d", e => "\x1b", '\\' => '\\', ); ##################################################################### # Implementation # Create an empty YAML::Tiny object sub new { my $class = shift; bless [ @_ ], $class; } # Create an object from a file sub read { my $class = ref $_[0] ? ref shift : shift; # Check the file my $file = shift or return $class->_error( 'You did not specify a file name' ); return $class->_error( "File '$file' does not exist" ) unless -e $file; return $class->_error( "'$file' is a directory, not a file" ) unless -f _; return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; # Slurp in the file local $/ = undef; local *CFG; unless ( open(CFG, $file) ) { return $class->_error("Failed to open file '$file': $!"); } my $contents = ; unless ( close(CFG) ) { return $class->_error("Failed to close file '$file': $!"); } $class->read_string( $contents ); } # Create an object from a string sub read_string { my $class = ref $_[0] ? ref shift : shift; my $self = bless [], $class; my $string = $_[0]; unless ( defined $string ) { return $self->_error("Did not provide a string to load"); } # Byte order marks # NOTE: Keeping this here to educate maintainers # my %BOM = ( # "\357\273\277" => 'UTF-8', # "\376\377" => 'UTF-16BE', # "\377\376" => 'UTF-16LE', # "\377\376\0\0" => 'UTF-32LE' # "\0\0\376\377" => 'UTF-32BE', # ); if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) { return $self->_error("Stream has a non UTF-8 BOM"); } else { # Strip UTF-8 bom if found, we'll just ignore it $string =~ s/^\357\273\277//; } # Try to decode as utf8 utf8::decode($string) if HAVE_UTF8; # Check for some special cases return $self unless length $string; unless ( $string =~ /[\012\015]+\z/ ) { return $self->_error("Stream does not end with newline character"); } # Split the file into lines my @lines = grep { ! /^\s*(?:\#.*)?\z/ } split /(?:\015{1,2}\012|\015|\012)/, $string; # Strip the initial YAML header @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; # A nibbling parser while ( @lines ) { # Do we have a document header? if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { # Handle scalar documents shift @lines; if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { push @$self, $self->_read_scalar( "$1", [ undef ], \@lines ); next; } } if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { # A naked document push @$self, undef; while ( @lines and $lines[0] !~ /^---/ ) { shift @lines; } } elsif ( $lines[0] =~ /^\s*\-/ ) { # An array at the root my $document = [ ]; push @$self, $document; $self->_read_array( $document, [ 0 ], \@lines ); } elsif ( $lines[0] =~ /^(\s*)\S/ ) { # A hash at the root my $document = { }; push @$self, $document; $self->_read_hash( $document, [ length($1) ], \@lines ); } else { croak("YAML::Tiny failed to classify the line '$lines[0]'"); } } $self; } # Deparse a scalar string to the actual scalar sub _read_scalar { my ($self, $string, $indent, $lines) = @_; # Trim trailing whitespace $string =~ s/\s*\z//; # Explitic null/undef return undef if $string eq '~'; # Quotes if ( $string =~ /^\'(.*?)\'\z/ ) { return '' unless defined $1; $string = $1; $string =~ s/\'\'/\'/g; return $string; } if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) { # Reusing the variable is a little ugly, # but avoids a new variable and a string copy. $string = $1; $string =~ s/\\"/"/g; $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex; return $string; } # Special cases if ( $string =~ /^[\'\"!&]/ ) { croak("YAML::Tiny does not support a feature in line '$lines->[0]'"); } return {} if $string eq '{}'; return [] if $string eq '[]'; # Regular unquoted string return $string unless $string =~ /^[>|]/; # Error croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines; # Check the indent depth $lines->[0] =~ /^(\s*)/; $indent->[-1] = length("$1"); if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } # Pull the lines my @multiline = (); while ( @$lines ) { $lines->[0] =~ /^(\s*)/; last unless length($1) >= $indent->[-1]; push @multiline, substr(shift(@$lines), length($1)); } my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; return join( $j, @multiline ) . $t; } # Parse an array sub _read_array { my ($self, $array, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { # Inline nested hash my $indent2 = length("$1"); $lines->[0] =~ s/-/ /; push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { # Array entry with a value shift @$lines; push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { shift @$lines; unless ( @$lines ) { push @$array, undef; return 1; } if ( $lines->[0] =~ /^(\s*)\-/ ) { my $indent2 = length("$1"); if ( $indent->[-1] == $indent2 ) { # Null array entry push @$array, undef; } else { # Naked indenter push @$array, [ ]; $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines ); } } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); } else { croak("YAML::Tiny failed to classify line '$lines->[0]'"); } } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { # This is probably a structure like the following... # --- # foo: # - list # bar: value # # ... so lets return and let the hash parser handle it return 1; } else { croak("YAML::Tiny failed to classify line '$lines->[0]'"); } } return 1; } # Parse an array sub _read_hash { my ($self, $hash, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { croak("YAML::Tiny found bad indenting in line '$lines->[0]'"); } # Get the key unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) { if ( $lines->[0] =~ /^\s*[?\'\"]/ ) { croak("YAML::Tiny does not support a feature in line '$lines->[0]'"); } croak("YAML::Tiny failed to classify line '$lines->[0]'"); } my $key = $1; # Do we have a value? if ( length $lines->[0] ) { # Yes $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines ); } else { # An indent shift @$lines; unless ( @$lines ) { $hash->{$key} = undef; return 1; } if ( $lines->[0] =~ /^(\s*)-/ ) { $hash->{$key} = []; $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); } elsif ( $lines->[0] =~ /^(\s*)./ ) { my $indent2 = length("$1"); if ( $indent->[-1] >= $indent2 ) { # Null hash entry $hash->{$key} = undef; } else { $hash->{$key} = {}; $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); } } } } return 1; } # Set error sub _error { $YAML::Tiny::errstr = $_[1]; undef; } # Retrieve error sub errstr { $YAML::Tiny::errstr; } ##################################################################### # Use Scalar::Util if possible, otherwise emulate it BEGIN { eval { require Scalar::Util; }; if ( $@ ) { # Failed to load Scalar::Util eval <<'END_PERL'; sub refaddr { my $pkg = ref($_[0]) or return undef; if (!!UNIVERSAL::can($_[0], 'can')) { bless $_[0], 'Scalar::Util::Fake'; } else { $pkg = undef; } "$_[0]" =~ /0x(\w+)/; my $i = do { local $^W; hex $1 }; bless $_[0], $pkg if defined $pkg; $i; } END_PERL } else { Scalar::Util->import('refaddr'); } } ##################################################################### # main test ##################################################################### package main; BEGIN { # Skip modules that either don't want to be loaded directly, such as # Module::Install, or that mess with the test count, such as the Test::* # modules listed here. # # Moose::Role conflicts if Moose is loaded as well, but Moose::Role is in # the Moose distribution and it's certain that someone who uses # Moose::Role also uses Moose somewhere, so if we disallow Moose::Role, # we'll still get the relevant version number. my %skip = map { $_ => 1 } qw( App::FatPacker Class::Accessor::Classy Devel::Cover Module::Install Moose::Role POE::Loop::Tk Template::Test Test::Kwalitee Test::Pod::Coverage Test::Portability::Files Test::YAML::Meta open ); my $Test = Test::Builder->new; $Test->plan(skip_all => "META.yml could not be found") unless -f 'META.yml' and -r _; my $meta = (Local::YAML::Tiny->read('META.yml'))->[0]; my %requires; for my $require_key (grep { /requires/ } keys %$meta) { my %h = %{ $meta->{$require_key} }; $requires{$_}++ for keys %h; } delete $requires{perl}; diag("Testing with Perl $], $^X"); for my $module (sort keys %requires) { if ($skip{$module}) { note "$module doesn't want to be loaded directly, skipping"; next; } local $SIG{__WARN__} = sub { note "$module: $_[0]" }; require_ok $module or BAIL_OUT("can't load $module"); my $version = $module->VERSION; $version = 'undefined' unless defined $version; diag(" $module version is $version"); } done_testing; } 50_davis_zerolength.t100644000765000024 456512357031634 21750 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/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; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; 52_reiss_bad_length.t100644000765000024 663112357031634 21673 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/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; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; 54_hzheng_head_redir.t100644000765000024 466312357031634 22035 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#! /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 } BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; 55_reiss_double_resp.t100644000765000024 1221612357031634 22126 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/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; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; 58_joel_cancel_multi.t100644000765000024 504312357031634 22051 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!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; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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' ); } } release-pod-coverage.t100644000765000024 57212357031634 22040 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); Filter000755000765000024 012357031634 17711 5ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/lib/POEHTTPHead.pm100644000765000024 1603012357031634 21770 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/lib/POE/Filterpackage POE::Filter::HTTPHead_Line; # vim: ts=2 sw=2 expandtab $POE::Filter::HTTPHead_Line::VERSION = '0.949'; use warnings; use strict; use base 'POE::Filter'; use HTTP::Response; use constant { FRAMING_BUFFER => 0, CURRENT_STATE => 1, WORK_RESPONSE => 2, PROTOCOL_VERSION => 3, }; use constant { STATE_STATUS => 0x01, # waiting for a status line STATE_HEADER => 0x02, # gotten status, looking for header or end }; use constant 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!^(\d{3})\s+(.+?)\s+HTTP/(\d+\.\d+)$!) { $self->[PROTOCOL_VERSION] = $3; $self->[WORK_RESPONSE] = HTTP::Response->new($1, $2); $self->[WORK_RESPONSE]->protocol('HTTP/' . $self->[PROTOCOL_VERSION]); $self->[CURRENT_STATE] = STATE_HEADER; DEBUG and warn "Got a status line"; next LINE; } elsif ($line =~ m!^(\d{3})\s+(.+?)$!) { $self->[PROTOCOL_VERSION] = 0.9; $self->[WORK_RESPONSE] = HTTP::Response->new($1, $2); $self->[WORK_RESPONSE]->protocol('HTTP/' . $self->[PROTOCOL_VERSION]); $self->[CURRENT_STATE] = STATE_HEADER; DEBUG and warn "Got a status line"; next LINE; } elsif ($line =~ m!^(\d{3})$!) { $self->[PROTOCOL_VERSION] = 0.9; $self->[WORK_RESPONSE] = HTTP::Response->new($1); $self->[WORK_RESPONSE]->protocol('HTTP/' . $self->[PROTOCOL_VERSION]); $self->[CURRENT_STATE] = STATE_HEADER; DEBUG and warn "Got a status line"; next LINE; } elsif ($line =~ m!^HTTP/(\d+\.\d+)\s+(\d{3})\s+(.*?)\s*$!) { $self->[PROTOCOL_VERSION] = $1; $self->[WORK_RESPONSE] = HTTP::Response->new($2, $3); $self->[WORK_RESPONSE]->protocol('HTTP/' . $self->[PROTOCOL_VERSION]); $self->[CURRENT_STATE] = STATE_HEADER; DEBUG and warn "Got a status line"; next LINE; } elsif ($line =~ m!^HTTP/(\d+\.\d+)\s+(\d{3})\s*$!) { $self->[PROTOCOL_VERSION] = $1; $self->[WORK_RESPONSE] = HTTP::Response->new($2); $self->[WORK_RESPONSE]->protocol('HTTP/' . $self->[PROTOCOL_VERSION]); $self->[CURRENT_STATE] = STATE_HEADER; DEBUG and warn "Got a status line"; 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.949'; use strict; =head1 NAME POE::Filter::HTTPHead - filter data as HTTP::Response objects =head1 VERSION version 0.949 =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; HTTPChunk.pm100644000765000024 2007312357031634 22201 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/lib/POE/Filterpackage POE::Filter::HTTPChunk; # vim: ts=2 sw=2 expandtab $POE::Filter::HTTPChunk::VERSION = '0.949'; use warnings; use strict; use Carp; use bytes; use base 'POE::Filter'; use HTTP::Response; use constant { FRAMING_BUFFER => 0, CURRENT_STATE => 1, CHUNK_SIZE => 2, CHUNK_BUFFER => 3, TRAILER_HEADERS => 4, }; use constant { STATE_SIZE => 0x01, # waiting for a status line STATE_DATA => 0x02, # received status, looking for header or end STATE_TRAILER => 0x04, # received status, looking for header or end }; use constant DEBUG => 0; my $HEX = qr/[\dA-Fa-f]/o; sub new { my ($class) = @_; my $self = bless [ [], # FRAMING_BUFFER STATE_SIZE, # CURRENT_STATE 0, # CHUNK_SIZE '', # CHUNK_BUFFER undef, # TRAILER_HEADERS ], $class; return $self; } =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__ =head1 NAME POE::Filter::HTTPChunk - Non-blocking incremental HTTP chunk parser. =head1 VERSION version 0.949 =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 60_rt50231_pending_many.t100644000765000024 660712357031634 22151 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/t#!/usr/bin/perl use strict; use warnings; BEGIN { my @proxies = grep /^http.*proxy$/i, keys %ENV; delete @ENV{@proxies} if @proxies; } 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; } Client000755000765000024 012357031634 21644 5ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/lib/POE/ComponentHTTP.pm100644000765000024 14065512357031634 23174 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/lib/POE/Component/Clientpackage POE::Component::Client::HTTP; # vim: ts=2 sw=2 expandtab $POE::Component::Client::HTTP::VERSION = '0.949'; use strict; #use bytes; # for utf8 compatibility use constant DEBUG => 0; use constant DEBUG_DATA => 0; use Carp qw(croak carp); 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, ); #------------------------------------------------------------------------------ # 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. 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; } 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}); } 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."; } sub _poco_weeble_pending_requests_count { my ($heap) = $_[HEAP]; my $r = $heap->{request} || {}; return scalar keys %$r; } 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') { # This happens during redirect. $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, $@); } } 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); } } 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 ($request->wheel) { my $wheel_id = $request->wheel->ID(); DEBUG and warn "T/O: request $request_id is wheel $wheel_id"; # Shut down the connection so it's not reused. $request->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; } } 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->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(); } 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"); } #------------------------------------------------------------------------------ # 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. 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; } # 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->close_connection(); } 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; } # 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); } } # POST response without disconnecting if ( $request->[REQ_STATE] & RS_DONE and not $request->[REQ_STATE] & RS_POSTED ) { $request->remove_timeout; _finish_request($heap, $request); } } #------------------------------------------------------------------------------ # Generate a hex dump of some input. This is not a POE function. 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; } # 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. sub _finish_request { my ($heap, $request) = @_; my $request_id = $request->ID; if (DEBUG) { carp "XXX: calling _finish_request(request id = $request_id)"; } # 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 ); } sub _poco_weeble_remove_request { my ($kernel, $heap, $request_id) = @_[KERNEL, HEAP, ARG0]; return _clear_req_cache( $heap, $request_id ); } # helper subroutine to remove a request from our caches sub _clear_req_cache { my ($heap, $request_id) = @_; my $request = delete $heap->{request}->{$request_id}; return unless 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}; } # If the response wants us to close the connection, regrettably do # so. Only matters if the request is defined. if ($request->[REQ_CONNECTION]) { if (defined(my $response = $request->[REQ_RESPONSE])) { my $connection_header = $response->header('Connection'); if (defined $connection_header and $connection_header =~ /\bclose\b/) { DEBUG and warn "I/O: closing connection on server's request"; $request->close_connection(); } } } return; } # 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 ($request->wheel) { my $wheel_id = $request->wheel->ID; DEBUG and warn "CXL: Request $request_id canceling wheel $wheel_id"; delete $heap->{wheel_to_request}{$wheel_id}; } if ($request->[REQ_CONNECTION]) { DEBUG and warn "I/O: Closing connection during internal cancel"; $request->close_connection(); } else { # Didn't connect yet; inform connection manager to cancel # connection request. $heap->{cm}->deallocate($request->[REQ_CONN_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__ =head1 NAME POE::Component::Client::HTTP - a HTTP user-agent component =head1 VERSION version 0.949 =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 HTTP000755000765000024 012357031634 22423 5ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/lib/POE/Component/ClientRequest.pm100644000765000024 5153512357031634 24602 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/lib/POE/Component/Client/HTTPpackage POE::Component::Client::HTTP::Request; # vim: ts=2 sw=2 expandtab $POE::Component::Client::HTTP::Request::VERSION = '0.949'; 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, REQ_POSTBACK => 1, REQ_CONNECTION => 2, REQ_HTTP_REQUEST => 3, REQ_STATE => 4, REQ_RESPONSE => 5, REQ_BUFFER => 6, REQ_OCTETS_GOT => 8, REQ_TIMER => 9, REQ_PROG_POSTBACK => 10, REQ_USING_PROXY => 11, REQ_HOST => 12, REQ_PORT => 13, REQ_HISTORY => 14, REQ_START_TIME => 15, REQ_FACTORY => 16, REQ_CONN_ID => 17, REQ_PEERNAME => 18, }; use constant { RS_CONNECT => 0x01, # establishing a connection RS_SENDING => 0x02, # sending request to server RS_IN_HEAD => 0x04, # waiting for or receiving headers RS_REDIRECTED => 0x08, # request has been redirected RS_IN_CONTENT => 0x20, # waiting for or receiving content RS_DONE => 0x40, # received full content 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 { return $_[0][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; } ### Methods to manage the request's timer. 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 { $_[0][REQ_HOST] } sub port { $_[0][REQ_PORT] } sub close_connection { my ($self) = @_; return unless defined $self->[REQ_CONNECTION]; $self->[REQ_CONNECTION]->close(); $self->[REQ_CONNECTION] = undef; } 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.949 =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 close_connection Each active request object contains an internal connection. This method closes it. =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 RequestFactory.pm100644000765000024 2344412357031634 26130 0ustar00trocstaff000000000000POE-Component-Client-HTTP-0.949/lib/POE/Component/Client/HTTPpackage POE::Component::Client::HTTP::RequestFactory; # vim: ts=2 sw=2 expandtab $POE::Component::Client::HTTP::RequestFactory::VERSION = '0.949'; use strict; use warnings; use Carp; use POE::Component::Client::HTTP::Request; use POE::Component::Client::HTTP; use constant { FCT_AGENT => 0, FCT_STREAMING => 1, FCT_MAXSIZE => 2, FCT_PROTOCOL => 3, FCT_COOKIEJAR => 4, FCT_FROM => 5, FCT_NOPROXY => 6, FCT_HTTP_PROXY => 7, FCT_FOLLOWREDIRECTS => 8, 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.949 =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; $v = "0.000" unless defined $v; 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. 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; } =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;