Net-Async-HTTP-0.48000755001750001750 014021530440 12535 5ustar00leoleo000000000000Net-Async-HTTP-0.48/Build.PL000444001750001750 234714021530440 14174 0ustar00leoleo000000000000use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Net::Async::HTTP', requires => { 'Future' => '0.28', # ->set_label 'Future::Utils' => '0.16', 'HTTP::Request' => 0, 'HTTP::Request::Common' => 0, 'HTTP::Response' => 0, 'IO::Async::Loop' => '0.59', 'IO::Async::Stream' => '0.59', 'IO::Async::Timer::Countdown' => 0, 'List::Util' => "1.29", # pairs() 'Metrics::Any' => '0.05', 'Socket' => '2.010', 'Struct::Dumb' => '0.07', 'Time::HiRes' => 0, 'URI' => 0, 'perl' => '5.010', # // }, recommends => { 'Compress::Raw::Zlib' => '2.057', # Fails with Compress::Raw::Zlib 2.056 or before }, build_requires => { 'HTTP::Cookies' => 0, 'IO::Async::Test' => 0, 'Test::Identity' => 0, 'Test::Metrics::Any' => 0, 'Test::More' => '0.88', # done_testing 'Test::Refcount' => 0, }, configure_requires => { 'Module::Build' => '0.4004', # test_requires }, license => 'perl', create_license => 1, create_readme => 1, meta_merge => { resources => { x_IRC => "irc://irc.perl.org/#io-async", }, }, ); $build->create_build_script; Net-Async-HTTP-0.48/Changes000444001750001750 3132014021530440 14204 0ustar00leoleo000000000000Revision history for Net-Async-HTTP 0.48 2021-03-08 [CHANGES] * Add PATCH method convenience wrapper * Updates to documentation style [BUGFIXES] * Make sure to set port number in Host header if using a non-default port for the URI scheme (RT134411) 0.47 2020-05-13 [CHANGES] * Updated for Metrics::Any 0.05 0.46 2020-05-12 [CHANGES] * Report client-side HTTP metrics using Metrics::Any, analogous to the server ones reported by Net::Async::HTTP::Server 0.45 2019-11-26 17:32:42 [CHANGES] * Allow configuring additional default headers to set in every outbound request (RT125642) * Added config option to enforce close after every request (RT128952) [BUGFIXES] * Correct request encoding for non-canonical headers (RT131040) 0.44 2019-02-17 14:11:57 [BUGFIXES] * Regnerate embedded SSL testing certs * No actual code changes 0.43 2018-11-14 22:05:27 [CHANGES] * Use IPTOS_* constants directly from Socket 2.010 * Pass SNI hostname when making SSL connections (RT94605) [BUGFIXES] * Proxy connections require full authority string (RT119961) 0.42 2018-04-03 15:37:17 [CHANGES] * Optionally support SOCKS5 proxies, using Net::Async::SOCKS (RT124729) * Minor docs improvements [BUGFIXES] * Ensure that on_header is still invoked for a final redirect that isn't followed (RT124920) * Better detection of $Socket::VERSION (RT122527) 0.41 2016/06/03 19:00:47 [BUGFIXES] * Ensure all kept-alive connections are properly closed when removing an instance from its containing IO::Async::Loop 0.40 2015/07/27 19:53:19 [CHANGES] * Added 'on_ready' parameter to ->request method, for interacting with the socket directly * Allow optional restriction of connect family 0.39 2015/07/13 15:34:29 [CHANGES] * Allow additional HTTP request headers to be supplied when in URI mode * Add require_SSL parameter that forbids plaintext requests (RT101498) * Announce that a future version may set a default value for max_connections_per_host higher than 1 [BUGFIXES] * Ensure that fail_on_error also applies to legacy-style on_response+on_error continuations (RT102022) * Avoid use of undef in an error message printing a warning (RT101459) 0.38 2015/06/01 15:32:57 [CHANGES] * More debug_printf() calls for better logging of connection-related activity [BUGFIXES] * Ensure that failed connections are removed from the parent notifier (RT102547) * Make sure not to call length() on undefined values (RT102023) * Ensure that the first request after connecting is only written after the connection has been configured and has a notifier name 0.37 2014/12/13 15:06:06 [CHANGES] * Major refactoring of Net::Async::HTTP::Connection internal closure- generation logic [BUGFIXES] * Cancel pending connect Futures if pipelining means an existing connection can be reused; handles failures better (RT99142) * Attempt to handle the case where $f->done itself throws an exception by at least maintaining internal state (RT100066) 0.36 2014/10/14 12:03:07 [CHANGES] * Set the content of generated requests if a 'content' param is given (RT97654) * Store object-wide SSL params for convenience (RT98514) * Clarify the final return value of the on_body_chunk handler (RT98278) * Nicer error message when a non-HTTP response header is received (RT93231) [BUGFIXES] * 3xx responses without a Location header, and non-(GET|HEAD) requests should not be redirected (RT98093) 0.35 2014/03/30 20:58:34 [BUGFIXES] * Reparse URI scheme after redirect, so host/port/SSLness are reset correctly (RT94303) * Requeue the next pending request after an HTTP/1.0-style EOF (RT94304) * Require at least Compress::Bzip2 2.10 to do bzip2 decompression Bugfixes sponsored by Cisco (http://www.cisco.com/) 0.34 2014/03/27 18:26:43 [BUGFIXES] * Don't attempt to reconnect ready queue items that already have a pending connection attempt (RT92904) * Don't close over $responder, thus avoiding a reference cycle leak (RT93232 / RT92728) * Avoid relying on strong forward references in Future, by creating intentional cycles on pending Futures. Workaround for bugfix in upcoming Future release. Bugfixes sponsored by NET-A-PORTER (http://www.net-a-porter.com/) 0.33 2014/01/22 23:48:40 [CHANGES] * Include connection flieno in notifier_name in case of multiple connections to a given host+port * Use different Future failure operation names for timeout and stall_timeout [BUGFIXES] * Zlib compression needs Compress::Raw::Zlib 2.057 or newer * Ensure that unpipelined requests can be cancelled * Ensure that other pending requests on a connection are also errored out when connection receives EOF 0.32 2013/11/19 14:09:18 [CHANGES] * Optionally decode encoded content and set the Accept-Encoding header of outbound requests. Currently defaults off, but may become true in a later version. [BUGFIXES] * Handle resolve/connect errors and pipeline queue flushing after cancellation correctly 0.31 2013/11/04 18:04:30 [CHANGES] * Allow a plain string URI, upgrading it to a URI object (RT89269) * Added ->POST shortcut method, similar to ->GET and ->HEAD * Extract HTTP basic auth. information from the URL in an HTTP::Request (RT89775) [BUGFIXES] * Remember to keep resetting the stall timer when receiving body content * Fix awkward race between stall_timer and ->cancel * Note dependency on Test::Refcount 0.30 2013/10/20 02:08:01 [CHANGES] * Use Future->new->fail to return failing immediate Futures * Ensure Future failures all use standard IO::Async style of ($message, NAME, ...) [BUGFIXES] * Ensure that fail_on_error doesn't cause non-error responses to fail (RT88996) 0.29 2013/09/22 02:50:39 [CHANGES] * Added 'on_body_write' callback * Reordering of documentation to emphasise futures first [BUGFIXES] * Fix handling of chunk header when split across reads 0.28 2013/09/13 20:40:14 [CHANGES] * Rewrite back into being a subclass of IO::Async::Stream instead of using IO::Async::Protocol::Stream * IO::Async::Stream 0.59 allows stall timeout detection during writes now as well [BUGFIXES] * Closed connections should drop the ready queue, so they don't accidentally try to process a second request * Failure handling of corrupted chunk headers during chunked transfer encoding 0.27 BUGFIXES: * Ensure that $f->cancel on a request Future actually works properly 0.26 CHANGES: * Added 'stall_timeout', at least for read operations BUGFIXES: * Fix NaHTTP+NaHTTP::Server unit tests for minimum version requirements 0.25 BUGFIXES: * Defend against ->setsockopt detecting SvPOK() of string values * Test for both "Connection closed" and "Connection closed while awaiting header" as OSes differ in behaviour 0.24 CHANGES: * Optionally set IP_TOS field in sockets * Remember to pass 'SSL' parameter around for requests on 'https' scheme 0.23 BUGFIXES: * Fix t/14conn-max.t failures - disable pipelining, wait for correct peersock connection to become ready (it may not be [0]) 0.22 CHANGES: * Allow more control over per-host concurrency; either a pool with a limit, or boundless growth of concurrency 0.21 CHANGES: * Optional mode in which 4xx and 5xx HTTP errors are turned into callback errors or Future failures * Handle incoming 1xx informational responses * Optionally set 'Expect' header for 100 Continue response 0.20 CHANGES: * Improvements to timeout and cancellation handling * Updated for Future 0.12; pass 'return' argument to Future::Utils::repeat * Use newer IO::Async::OS->socketpair in unit tests 0.19 CHANGES: * Allow $http->do_request to return a Future object yielding the eventual response * Added convenient $http->GET and ->HEAD methods * Many internal neatenings and rewrites to better support Futures 0.18 CHANGES: * Default host/port/SSLness from URL in HTTP::Request if given * Set Connection: keep-alive by default * Presume that HTTP/1.1 connections can keep-alive by default * Attempt to limit the number of outstanding requests in flight per connection; keep others in a queue BUGFIXES: * Pass the same timer object down redirects so the same overall timeout is reused * Fix memory leak by remembering to remove closed NaHTTP::Protocol children from containing NaHTTP * Correctly terminate requests to connections closed during write * Handle trailing whitespace after Chunked encoding chunk size (thanks David Leadbeater) 0.17 CHANGES: * Support optionally setting local host/port/addr (RT75431) * Don't pipeline requests until the server is known to be at least HTTP/1.1 BUGFIXES: * Default request protocol to HTTP/1.1 so caller doesn't have to (RT75830) * http(s) port logic on numbers rather than protocol names (RT75615) * Use more weaseling in timeout handlers to avoid cyclic reference memory leak 0.16 BUGFIXES: * Work around HTTP::Message's non-trimming of linear whitespace (RT72843) 0.15 BUGFIXES: * Better HTTP handling of "Connection: close" connections; close the socket at the end of the response body or HEAD header. 0.14 CHANGES: * Per-request timeouts * Default port to http/https if not supplied explicitly * Fill in Response ->previous on redirects - RT72791 * Improvements to unit tests 0.13 BUGFIXES: * Handle redirect to https:// as well as http:// (RT71526) * Fix use of conditional variable declaration that breaks on Perl 5.14 (RT71545) * Clean up connection cache after resolve, connect or SSL failures (RT71530) 0.12 BUGFIXES: * Wait for connect to complete when pipelining multiple requests down the same connection initially (RT66189) * When serialising a request, handle a full protocol://authority URI by splitting protocol/authority parts out of it 0.11 BUGFIXES: * Fix stalling t/12request-streaming.t test script that causes lots of FAILs at test time 0.10 CHANGES: * Support streaming of request body content * Support HTTP::Cookies object as a cookie jar * Allow proxy_host and proxy_port as ->configure parameters, to set defaults for requests 0.09 CHANGES: * Use IO::Async::Protocol->connect from 0.34 0.08 CHANGES: * Support streaming of response body content * Support SSL if IO::Async::SSL is installed 0.07 CHANGES: * base on IO::Async::Protocol::Stream 0.06 CHANGES: * When POSTing content that isn't form data, expect to be given its content type 0.05 CHANGES: * Added Test::Pod testing * Created example wget-style script * Documentation neatening * More accurate 'requires' in Build.PL; hopefully to keep CPANTS happy 0.04 CHANGES: * Added 'use warnings' * Updated to IO::Async 0.21 style * Various small documentation and test script updates 0.03 CHANGES: * Support server-local HTTP redirects 0.02 CHANGES: * Support HTTP redirects BUGFIXES: * Declare dependency on HTTP::Request and HTTP::Response 0.01 First version, released on an unsuspecting world. Net-Async-HTTP-0.48/LICENSE000444001750001750 4376214021530440 13733 0ustar00leoleo000000000000This software is copyright (c) 2021 by Paul Evans . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2021 by Paul Evans . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, 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) 2021 by Paul Evans . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Net-Async-HTTP-0.48/MANIFEST000444001750001750 164614021530440 14032 0ustar00leoleo000000000000Build.PL Changes examples/GET.pl examples/parallel-put.pl examples/PUT.pl lib/Net/Async/HTTP.pm lib/Net/Async/HTTP/Connection.pm lib/Net/Async/HTTP/StallTimer.pm LICENSE MANIFEST This list of files META.json META.yml README t/00use.t t/01request.t t/02uri.t t/03future.t t/04fail.t t/05redir.t t/06close.t t/07continue.t t/08prepareprocess.t t/09cookies.t t/10request-streaming.t t/11response-streaming.t t/12conn-persistence.t t/13conn-pipeline.t t/14conn-max.t t/15conn-errors.t t/16max-in-flight.t t/17on-write.t t/18content-coding.t t/19idle.t t/20local-connect.t t/21local-connect-ssl.t t/22local-connect-pipeline.t t/23local-connect-redir.t t/24local-connect-redir-ssl.t t/30timeout.t t/31cancel.t t/32remove.t t/40socks.t t/70metrics.t t/80cross-http.t t/81cross-https.t t/90rt75615.t t/90rt75616.t t/90rt92904.t t/90rt93232.t t/90rt99142.t t/91rt100066.t t/91rt102547.t t/99pod.t t/privkey.pem t/regen-certs.sh t/server.pem Net-Async-HTTP-0.48/META.json000444001750001750 410214021530440 14310 0ustar00leoleo000000000000{ "abstract" : "use HTTP with C", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4231", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Net-Async-HTTP", "prereqs" : { "build" : { "requires" : { "HTTP::Cookies" : "0", "IO::Async::Test" : "0", "Test::Identity" : "0", "Test::Metrics::Any" : "0", "Test::More" : "0.88", "Test::Refcount" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.4004" } }, "runtime" : { "recommends" : { "Compress::Raw::Zlib" : "2.057" }, "requires" : { "Future" : "0.28", "Future::Utils" : "0.16", "HTTP::Request" : "0", "HTTP::Request::Common" : "0", "HTTP::Response" : "0", "IO::Async::Loop" : "0.59", "IO::Async::Stream" : "0.59", "IO::Async::Timer::Countdown" : "0", "List::Util" : "1.29", "Metrics::Any" : "0.05", "Socket" : "2.010", "Struct::Dumb" : "0.07", "Time::HiRes" : "0", "URI" : "0", "perl" : "5.010" } } }, "provides" : { "Net::Async::HTTP" : { "file" : "lib/Net/Async/HTTP.pm", "version" : "0.48" }, "Net::Async::HTTP::Connection" : { "file" : "lib/Net/Async/HTTP/Connection.pm", "version" : "0.48" }, "Net::Async::HTTP::StallTimer" : { "file" : "lib/Net/Async/HTTP/StallTimer.pm", "version" : "0.48" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "x_IRC" : "irc://irc.perl.org/#io-async" }, "version" : "0.48", "x_serialization_backend" : "JSON::PP version 4.05" } Net-Async-HTTP-0.48/META.yml000444001750001750 247314021530440 14151 0ustar00leoleo000000000000--- abstract: 'use HTTP with C' author: - 'Paul Evans ' build_requires: HTTP::Cookies: '0' IO::Async::Test: '0' Test::Identity: '0' Test::Metrics::Any: '0' Test::More: '0.88' Test::Refcount: '0' configure_requires: Module::Build: '0.4004' dynamic_config: 1 generated_by: 'Module::Build version 0.4231, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-Async-HTTP provides: Net::Async::HTTP: file: lib/Net/Async/HTTP.pm version: '0.48' Net::Async::HTTP::Connection: file: lib/Net/Async/HTTP/Connection.pm version: '0.48' Net::Async::HTTP::StallTimer: file: lib/Net/Async/HTTP/StallTimer.pm version: '0.48' recommends: Compress::Raw::Zlib: '2.057' requires: Future: '0.28' Future::Utils: '0.16' HTTP::Request: '0' HTTP::Request::Common: '0' HTTP::Response: '0' IO::Async::Loop: '0.59' IO::Async::Stream: '0.59' IO::Async::Timer::Countdown: '0' List::Util: '1.29' Metrics::Any: '0.05' Socket: '2.010' Struct::Dumb: '0.07' Time::HiRes: '0' URI: '0' perl: '5.010' resources: IRC: irc://irc.perl.org/#io-async license: http://dev.perl.org/licenses/ version: '0.48' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Net-Async-HTTP-0.48/README000444001750001750 4644114021530440 13603 0ustar00leoleo000000000000NAME Net::Async::HTTP - use HTTP with IO::Async SYNOPSIS use Future::AsyncAwait; use IO::Async::Loop; use Net::Async::HTTP; use URI; my $loop = IO::Async::Loop->new(); my $http = Net::Async::HTTP->new(); $loop->add( $http ); my $response = await $http->do_request( uri => URI->new( "http://www.cpan.org/" ), ); print "Front page of http://www.cpan.org/ is:\n"; print $response->as_string; DESCRIPTION This object class implements an asynchronous HTTP user agent. It sends requests to servers, returning Future instances to yield responses when they are received. The object supports multiple concurrent connections to servers, and allows multiple requests in the pipeline to any one connection. Normally, only one such object will be needed per program to support any number of requests. As well as using futures the module also supports a callback-based interface. This module optionally supports SSL connections, if IO::Async::SSL is installed. If so, SSL can be requested either by passing a URI with the https scheme, or by passing a true value as the SSL parameter. Connection Pooling There are three ways in which connections to HTTP server hosts are managed by this object, controlled by the value of max_connections_per_host. This controls when new connections are established to servers, as compared to waiting for existing connections to be free, as new requests are made to them. They are: max_connections_per_host = 1 This is the default setting. In this mode, there will be one connection per host on which there are active or pending requests. If new requests are made while an existing one is outstanding, they will be queued to wait for it. If pipelining is active on the connection (because both the pipeline option is true and the connection is known to be an HTTP/1.1 server), then requests will be pipelined into the connection awaiting their response. If not, they will be queued awaiting a response to the previous before sending the next. max_connections_per_host > 1 In this mode, there can be more than one connection per host. If a new request is made, it will try to re-use idle connections if there are any, or if they are all busy it will create a new connection to the host, up to the configured limit. max_connections_per_host = 0 In this mode, there is no upper limit to the number of connections per host. Every new request will try to reuse an idle connection, or else create a new one if all the existing ones are busy. These modes all apply per hostname / server port pair; they do not affect the behaviour of connections made to differing hostnames, or differing ports on the same hostname. PARAMETERS The following named parameters may be passed to new or configure: user_agent => STRING A string to set in the User-Agent HTTP header. If not supplied, one will be constructed that declares Net::Async::HTTP and the version number. headers => ARRAY or HASH Since version 0.45. A set of extra headers to apply to every outgoing request. May be specified either as an even-sized array containing key/value pairs, or a hash. Individual header values may be added or changed without replacing the entire set by using the configure method and passing a key called +headers: $http->configure( +headers => { One_More => "Key" } ); max_redirects => INT Optional. How many levels of redirection to follow. If not supplied, will default to 3. Give 0 to disable redirection entirely. max_in_flight => INT Optional. The maximum number of in-flight requests to allow per host when pipelining is enabled and supported on that host. If more requests are made over this limit they will be queued internally by the object and not sent to the server until responses are received. If not supplied, will default to 4. Give 0 to disable the limit entirely. max_connections_per_host => INT Optional. Controls the maximum number of connections per hostname/server port pair, before requests will be queued awaiting one to be free. Give 0 to disable the limit entirely. See also the "Connection Pooling" section documented above. Currently, if not supplied it will default to 1. However, it has been found in practice that most programs will raise this limit to something higher, perhaps 3 or 4. Therefore, a future version of this module may set a higher value. To test if your application will handle this correctly, you can set a different default by setting an environment variable: $ NET_ASYNC_HTTP_MAXCONNS=3 perl ... timeout => NUM Optional. How long in seconds to wait before giving up on a request. If not supplied then no default will be applied, and no timeout will take place. stall_timeout => NUM Optional. How long in seconds to wait after each write or read of data on a socket, before giving up on a request. This may be more useful than timeout on large-file operations, as it will not time out provided that regular progress is still being made. proxy_host => STRING proxy_port => INT Optional. Default values to apply to each request method. cookie_jar => HTTP::Cookies Optional. A reference to a HTTP::Cookies object. Will be used to set cookies in requests and store them from responses. pipeline => BOOL Optional. If false, disables HTTP/1.1-style request pipelining. close_after_request => BOOL Since version 0.45. Optional. If true, will set the Connection: close header on outgoing requests and disable pipelining, thus making every request use a new connection. family => INT local_host => STRING local_port => INT local_addrs => ARRAY local_addr => HASH or ARRAY Optional. Parameters to pass on to the connect method used to connect sockets to HTTP servers. Sets the socket family and local socket address to bind() to. For more detail, see the documentation in IO::Async::Connector. fail_on_error => BOOL Optional. Affects the behaviour of response handling when a 4xx or 5xx response code is received. When false, these responses will be processed as other responses and yielded as the result of the future, or passed to the on_response callback. When true, such an error response causes the future to fail, or the on_error callback to be invoked. The HTTP response and request objects will be passed as well as the code and message, and the failure name will be http. ( $code_message, "http", $response, $request ) = $f->failure $on_error->( "$code $message", $response, $request ) read_len => INT write_len => INT Optional. Used to set the reading and writing buffer lengths on the underlying IO::Async::Stream objects that represent connections to the server. If not define, a default of 64 KiB will be used. ip_tos => INT or STRING Optional. Used to set the IP_TOS socket option on client sockets. If given, should either be a IPTOS_* constant, or one of the string names lowdelay, throughput, reliability or mincost. If undefined or left absent, no option will be set. decode_content => BOOL Optional. If true, incoming responses that have a recognised Content-Encoding are handled by the module, and decompressed content is passed to the body handling callback or returned in the HTTP::Response. See "CONTENT DECODING" below for details of which encoding types are recognised. When this option is enabled, outgoing requests also have the Accept-Encoding header added to them if it does not already exist. Currently the default is false, because this behaviour is new, but it may default to true in a later version. Applications which care which behaviour applies should set this to a defined value to ensure it doesn't change. SSL_* Additionally, any parameters whose names start with SSL_ will be stored and passed on requests to perform SSL requests. This simplifies configuration of common SSL parameters. require_SSL => BOOL Optional. If true, then any attempt to make a request that does not use SSL (either by calling request, or as a result of a redirection) will immediately fail. SOCKS_* Since version 0.42. Additionally, any parameters whose names start with SOCKS_ will be stored and used by Net::Async::SOCKS to establish connections via a configured proxy. METHODS The following methods documented in an await expression return Future instances. When returning a Future, the following methods all indicate HTTP-level errors using the Future failure name of http. If the error relates to a specific response it will be included. The original request is also included. $f->fail( $message, "http", $response, $request ) do_request $response = await $http->do_request( %args ); Send an HTTP request to a server, returning a Future that will yield the response. The request may be represented by an HTTP::Request object, or a URI object, depending on the arguments passed. The following named arguments are used for HTTP::Requests: request => HTTP::Request A reference to an HTTP::Request object host => STRING Hostname of the server to connect to port => INT or STRING Optional. Port number or service of the server to connect to. If not defined, will default to http or https depending on whether SSL is being used. family => INT Optional. Restricts the socket family for connecting. If not defined, will default to the globally-configured value in the object. SSL => BOOL Optional. If true, an SSL connection will be used. The following named arguments are used for URI requests: uri => URI or STRING A reference to a URI object, or a plain string giving the request URI. If the scheme is https then an SSL connection will be used. method => STRING Optional. The HTTP method name. If missing, GET is used. content => STRING or ARRAY ref Optional. The body content to use for PUT or POST requests. If this is a plain scalar it will be used directly, and a content_type field must also be supplied to describe it. If this is an ARRAY ref and the request method is POST, it will be form encoded. It should contain an even-sized list of field names and values. For more detail see "POST" in HTTP::Request::Common. content_type => STRING The type of non-form data content. user => STRING pass => STRING Optional. If both are given, the HTTP Basic Authorization header will be sent with these details. headers => ARRAY|HASH Optional. If provided, contains additional HTTP headers to set on the constructed request object. If provided as an ARRAY reference, it should contain an even-sized list of name/value pairs. proxy_host => STRING proxy_port => INT Optional. Override the hostname or port number implied by the URI. For either request type, it takes the following arguments: request_body => STRING | CODE | Future Optional. Allows request body content to be generated by a future or callback, rather than being provided as part of the request object. This can either be a plain string, a CODE reference to a generator function, or a future. As this is passed to the underlying IO::Async::Stream write method, the usual semantics apply here. If passed a CODE reference, it will be called repeatedly whenever it's safe to write. The code should should return undef to indicate completion. If passed a Future it is expected to eventually yield the body value. As with the content parameter, the content_type field should be specified explicitly in the request header, as should the content length (typically via the HTTP::Request content_length method). See also examples/PUT.pl. expect_continue => BOOL Optional. If true, sets the Expect request header to the value 100-continue and does not send the request_body parameter until a 100 Continue response is received from the server. If an error response is received then the request_body code, if present, will not be invoked. on_ready => CODE Optional. A callback that is invoked once a socket connection is established with the HTTP server, but before the request is actually sent over it. This may be used by the client code to inspect the socket, or perform any other operations on it. This code is expected to return a Future; only once that has completed will the request cycle continue. If it fails, that failure is propagated to the caller. $f = $on_ready->( $connection ) on_redirect => CODE Optional. A callback that is invoked if a redirect response is received, before the new location is fetched. It will be passed the response and the new URL. $on_redirect->( $response, $location ) on_body_write => CODE Optional. A callback that is invoked after each successful syswrite of the body content. This may be used to implement an upload progress indicator or similar. It will be passed the total number of bytes of body content written so far (i.e. excluding bytes consumed in the header). $on_body_write->( $written ) max_redirects => INT Optional. How many levels of redirection to follow. If not supplied, will default to the value given in the constructor. timeout => NUM stall_timeout => NUM Optional. Overrides the object's configured timeout values for this one request. If not specified, will use the configured defaults. On a timeout, the returned future will fail with either timeout or stall_timeout as the operation name. ( $message, "timeout" ) = $f->failure do_request (void) $http->do_request( %args ) When not returning a future, the following extra arguments are used as callbacks instead: on_response => CODE A callback that is invoked when a response to this request has been received. It will be passed an HTTP::Response object containing the response the server sent. $on_response->( $response ) on_header => CODE Alternative to on_response. A callback that is invoked when the header of a response has been received. It is expected to return a CODE reference for handling chunks of body content. This CODE reference will be invoked with no arguments once the end of the request has been reached, and whatever it returns will be used as the result of the returned Future, if there is one. $on_body_chunk = $on_header->( $header ) $on_body_chunk->( $data ) $response = $on_body_chunk->() on_error => CODE A callback that is invoked if an error occurs while trying to send the request or obtain the response. It will be passed an error message. $on_error->( $message ) If this is invoked because of a received 4xx or 5xx error code in an HTTP response, it will be invoked with the response and request objects as well. $on_error->( $message, $response, $request ) GET, HEAD, PUT, ... $response = await $http->GET( $uri, %args ); $response = await $http->HEAD( $uri, %args ); $response = await $http->PUT( $uri, $content, %args ); $response = await $http->POST( $uri, $content, %args ); $response = await $http->PATCH( $uri, $content, %args ); Convenient wrappers for performing GET, HEAD, PUT, POST or PATCH requests with a URI object and few if any other arguments, returning a Future. Remember that POST with non-form data (as indicated by a plain scalar instead of an ARRAY reference of form data name/value pairs) needs a content_type key in %args. SUBCLASS METHODS The following methods are intended as points for subclasses to override, to add extra functionallity. prepare_request $http->prepare_request( $request ) Called just before the HTTP::Request object is sent to the server. process_response $http->process_response( $response ) Called after a non-redirect HTTP::Response has been received from a server. The originating request will be set in the object. CONTENT DECODING If the required decompression modules are installed and available, compressed content can be decoded. If the received Content-Encoding is recognised and the required module is available, the content is transparently decoded and the decoded content is returned in the resulting response object, or passed to the data chunk handler. In this case, the original Content-Encoding header will be deleted from the response, and its value will be available instead as X-Original-Content-Encoding. The following content encoding types are recognised by these modules: * gzip (q=0.7) and deflate (q=0.5) Recognised if Compress::Raw::Zlib version 2.057 or newer is installed. * bzip2 (q=0.8) Recognised if Compress::Bzip2 version 2.10 or newer is installed. Other content encoding types can be registered by calling the following method register_decoder Net::Async::HTTP->register_decoder( $name, $q, $make_decoder ) Registers an encoding type called $name, at the quality value $q. In order to decode this encoding type, $make_decoder will be invoked with no paramters, and expected to return a CODE reference to perform one instance of decoding. $decoder = $make_decoder->() This decoder will be invoked on string buffers to decode them until the end of stream is reached, when it will be invoked with no arguments. $content = $decoder->( $encoded_content ) $content = $decoder->() # EOS EXAMPLES Concurrent GET The Future-returning GET method makes it easy to await multiple URLs at once, by using the Future::Utils fmap_void utility use Future::AsyncAwait; use Future::Utils qw( fmap_void ); my @URLs = ( ... ); my $http = Net::Async::HTTP->new( ... ); $loop->add( $http ); my $future = fmap_void { my ( $url ) = @_; $http->GET( $url ) ->on_done( sub { my $response = shift; say "$url succeeded: ", $response->code; say " Content-Type:", $response->content_type; } ) ->on_fail( sub { my $failure = shift; say "$url failed: $failure"; } ); } foreach => \@URLs, concurrent => 5; await $future; SEE ALSO * http://tools.ietf.org/html/rfc2616 - Hypertext Transfer Protocol -- HTTP/1.1 SPONSORS Parts of this code, or bugfixes to it were paid for by * SocialFlow http://www.socialflow.com * Shadowcat Systems http://www.shadow.cat * NET-A-PORTER http://www.net-a-porter.com * Cisco http://www.cisco.com AUTHOR Paul Evans Net-Async-HTTP-0.48/examples000755001750001750 014021530440 14353 5ustar00leoleo000000000000Net-Async-HTTP-0.48/examples/GET.pl000555001750001750 150314021530440 15466 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use URI; use Getopt::Long; use IO::Async::Loop; use Net::Async::HTTP; my $FAMILY; GetOptions( 'local-host=s' => \my $LOCAL_HOST, 'local-port=i' => \my $LOCAL_PORT, 'timeout=f' => \my $TIMEOUT, 'ipv4|4' => sub { $FAMILY = "inet" }, 'ipv6|6' => sub { $FAMILY = "inet6" }, ) or exit 1; my $loop = IO::Async::Loop->new; my $ua = Net::Async::HTTP->new( local_host => $LOCAL_HOST, local_port => $LOCAL_PORT, family => $FAMILY, decode_content => 1, ); $loop->add( $ua ); $ua->configure( timeout => $TIMEOUT ) if defined $TIMEOUT; $ua->GET( $ARGV[0] ) ->on_done( sub { my ( $response ) = @_; print $response->as_string; } ) ->on_fail( sub { my ( $message ) = @_; print STDERR "Failed - $message\n"; } )->get; Net-Async-HTTP-0.48/examples/PUT.pl000555001750001750 574114021530440 15527 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use URI; use IO::Async::Loop; use Net::Async::HTTP; use POSIX qw( floor ); use Time::HiRes qw( time ); use Getopt::Long; sub usage { my ( $exitcode ) = @_; print STDERR <<"EOF"; Net::Async::HTTP PUT client example. Usage: $0 [-u user:pass] https://example.com/file-to-put.bin /tmp/file-to-read.bin If -u options are given, these will be sent as Basic auth credentials. Different ports can be specified in the URL, e.g. http://example.com:12314/file.txt EOF } # Basic commandline parameter support - -u user:password my $userpass; my $url; my $src; my $contenttype = "application/octet-stream"; GetOptions( 'userpass|u=s' => \$userpass, 'src=s' => \$src, 'type|t=s' => \$contenttype, 'help|h' => sub { usage(0) }, ) or usage(1); my $loop = IO::Async::Loop->new; $url = shift @ARGV or usage(1); $src = shift @ARGV or usage(1) if !defined $src; my $ua = Net::Async::HTTP->new; $loop->add( $ua ); # We'll send the size as the Content-Length, and get the filehandle ready for reading my $size = (stat $src)[7]; open my $fh, '<', $src or die "Failed to open source file $src - $!\n"; binmode $fh; # Prepare our request object my $uri = URI->new($url) or die "Invalid URL?\n"; my $req = HTTP::Request->new( PUT => $uri->path, [ 'Host' => $uri->host, 'Content-Type' => $contenttype, ] ); # Default is no protocol, we insist on HTTP/1.1 here, PUT probably requires that as a minimum anyway $req->protocol( 'HTTP/1.1' ); $req->authorization_basic( split m/:/, $userpass, 2 ) if defined $userpass; $req->content_length( $size ); # For stats my $total = 0; my $last = -1; my $start; $ua->do_request( request => $req, host => $uri->host, port => $uri->port, SSL => $uri->scheme eq 'https' ? 1 : 0, # We override the default behaviour (pulling content from HTTP::Request) by passing a callback explicitly # Originall had "content_callback", not really sure what the best thing to call this would be though. request_body => sub { my ($stream) = @_; unless (defined $start) { $start = time; $| = 1; } # This part is the important one - read some data, and eventually return it my $read = sysread $fh, my $buffer, 1048576; # Just for stats display, update every mbyte $total += $read; my $step = floor($total / 1048576); if($step > $last) { $last = $step; my $elapsed = (time - $start) || 1; printf("Total: %14d of %14d bytes, %5.2f%% complete, %9.3fkbyte/s \r", $total, $size, (100 * $total) / $size, ($total) / ($elapsed * 1024)); } return $buffer if $read; # Return undef when we're done print "\n\nComplete.\n"; return; }, on_response => sub { my ( $response ) = @_; close $fh or die $!; print $response->as_string; }, on_error => sub { my ( $message ) = @_; print STDERR "Failed - $message\n"; } )->get; Net-Async-HTTP-0.48/examples/parallel-put.pl000444001750001750 1252314021530440 17472 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; =pod A slightly longer example demonstrating multiple L clients running in parallel. Given a base URL, this will recursively (breadth-first) scan any paths given on the command line and PUT whatever files are found. The resulting file structure will be flattened, there's no attempt to MKCOL the equivalent path structure on the target server. =cut use URI; use Async::MergePoint; use IO::Async::Loop; use IO::Async::Timer::Periodic; use Net::Async::HTTP; use POSIX qw(floor); use Time::HiRes qw(time); use Scalar::Util qw(weaken); use File::Basename qw(basename); use Format::Human::Bytes; use Getopt::Std; # Basic commandline parameter support: # * -u user:password # * -n number of workers to start getopt('u:n:', \my %opts); @ARGV || die <<"USAGE"; Net::Async::HTTP PUT client example. Usage: $0 [-u user:pass] -n 8 http://dav.example.com file*.txt directory1 directory2 If -u options are given, these will be sent as Basic auth credentials. Different ports can be specified in the URL, e.g. http://example.com:12314/file.txt. The -n option specifies how many parallel connections to open (default is a single connection only). USAGE my $loop = IO::Async::Loop->new; # Bytes transferred so far my $total = 0; # Define some workers $opts{n} ||= 1; my @ua = map { Net::Async::HTTP->new } 1..$opts{n}; $loop->add( $_ ) for @ua; my $start = time; # Used for pretty-printing, not essential if you don't have it installed my $fhb = Format::Human::Bytes->new; # The clients are added to this, and marked as done by the workers once the current file has finished and there is nothing # else left in the queue. Bit of a hack to pass the raw Net::Async:HTTP objects but since they each stringify to a different # value it does the job for now, should perhaps pass an ID or something instead. my $mp = Async::MergePoint->new( needs => \@ua, on_finished => sub { my $elapsed = time - $start; print "All done - " . $fhb->base2($total) . " in $elapsed seconds, " . $fhb->base2($total / $elapsed) . "/sec\n"; $loop->loop_stop; } ); # Expect a URL and a list of files as parameters my ($base_url, @todo) = @ARGV; # Start each worker off queue_next_item($_) for @ua; # Give a rough idea of progress my $timer = IO::Async::Timer::Periodic->new( interval => 10, on_tick => sub { my $elapsed = time - $start; print ">> Transferred " . $fhb->base2($total) . " bytes in $elapsed seconds, " . $fhb->base2($total / $elapsed, 2) . "/sec\n"; }, ); $loop->add($timer); $timer->start; # And begin looping $loop->loop_forever; exit; # Get next item from the queue and make the request sub queue_next_item { my $ua = shift; while(@todo) { my $path = shift(@todo); return send_file($ua, $path) if -f $path; push @todo, glob "$path/*"; print "Add directory $path, queue now " . @todo . "\n"; } $mp->done($ua); } # Generate the request for the given UA and send it sub send_file { my $ua = shift; my $path = shift; # We'll send the size as the Content-Length, and get the filehandle ready for reading my $size = (stat $path)[7]; open my $fh, '<', $path or die "failed to open source file $path: $!"; binmode $fh; # Prepare our request object my $uri = URI->new($base_url . '/' . basename($path)) or die "Invalid URL?"; my $req = HTTP::Request->new( PUT => $uri->path, [ 'Host' => $uri->host, # Send as binary to avoid any text-mangling process, should be overrideable from the commandline though 'Content-Type' => 'application/octetstream' ] ); # Default is no protocol, we insist on HTTP/1.1 here, PUT probably requires that as a minimum anyway $req->protocol('HTTP/1.1'); $req->authorization_basic(split /:/, $opts{u}, 2) if defined $opts{u}; $req->content_length($size); weaken $ua; $ua->do_request( request => $req, # Probably duplicating a load of logic here :( host => $uri->host, port => $uri->port || $uri->scheme || 80, SSL => $uri->scheme eq 'https' ? 1 : 0, # We override the default behaviour (pulling content from HTTP::Request) by passing a callback explicitly request_body => sub { my ($stream) = @_; # This part is the important one - read some data, and eventually return it my $read = sysread $fh, my $buffer, 32768; $total += $read // 0; return $buffer if $read; # Don't really need to close here, but might as well clean up as soon as we're ready close $fh or warn $!; undef $fh; return; }, on_response => sub { my ($response) = @_; if($fh) { close $fh or die $!; } my $msg = $response->message; $msg =~ s/\s+/ /ig; $msg =~ s/(?:^\s+)|(?:\s+$)//g; # trim print $response->code . " for $path ($size bytes) - $msg\n"; # haxx: if we get a server error, just repeat. push @todo, $path if $response->code == 500; queue_next_item($ua); }, on_error => sub { my ( $message ) = @_; if($fh) { close $fh or die $!; } print STDERR "Failed - $message\n"; # Could do a $loop->loop_stop here - some failures should be fatal! queue_next_item($ua); } ); } Net-Async-HTTP-0.48/lib000755001750001750 014021530440 13303 5ustar00leoleo000000000000Net-Async-HTTP-0.48/lib/Net000755001750001750 014021530440 14031 5ustar00leoleo000000000000Net-Async-HTTP-0.48/lib/Net/Async000755001750001750 014021530440 15106 5ustar00leoleo000000000000Net-Async-HTTP-0.48/lib/Net/Async/HTTP.pm000444001750001750 11654514021530440 16434 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2008-2021 -- leonerd@leonerd.org.uk package Net::Async::HTTP; use strict; use warnings; use v5.10; # // use base qw( IO::Async::Notifier ); our $VERSION = '0.48'; our $DEFAULT_UA = "Perl + " . __PACKAGE__ . "/$VERSION"; our $DEFAULT_MAXREDIR = 3; our $DEFAULT_MAX_IN_FLIGHT = 4; our $DEFAULT_MAX_CONNS_PER_HOST = $ENV{NET_ASYNC_HTTP_MAXCONNS} // 1; use Carp; use Net::Async::HTTP::Connection; use HTTP::Request; use HTTP::Request::Common qw(); use URI; use IO::Async::Stream 0.59; use IO::Async::Loop 0.59; # ->connect( handle ) ==> $stream use Future 0.28; # ->set_label use Future::Utils 0.16 qw( repeat ); use Metrics::Any 0.05 '$metrics', strict => 1, name_prefix => [qw( http client )]; use Scalar::Util qw( blessed reftype ); use Time::HiRes qw( time ); use List::Util 1.29 qw( first pairs pairgrep ); use Socket 2.010 qw( SOCK_STREAM IPPROTO_IP IP_TOS IPTOS_LOWDELAY IPTOS_THROUGHPUT IPTOS_RELIABILITY IPTOS_MINCOST ); use constant HTTP_PORT => 80; use constant HTTPS_PORT => 443; use constant READ_LEN => 64*1024; # 64 KiB use constant WRITE_LEN => 64*1024; # 64 KiB use Struct::Dumb 0.07; # equallity operator overloading struct Ready => [qw( future connecting )]; =head1 NAME C - use HTTP with C =head1 SYNOPSIS use Future::AsyncAwait; use IO::Async::Loop; use Net::Async::HTTP; use URI; my $loop = IO::Async::Loop->new(); my $http = Net::Async::HTTP->new(); $loop->add( $http ); my $response = await $http->do_request( uri => URI->new( "http://www.cpan.org/" ), ); print "Front page of http://www.cpan.org/ is:\n"; print $response->as_string; =head1 DESCRIPTION This object class implements an asynchronous HTTP user agent. It sends requests to servers, returning L instances to yield responses when they are received. The object supports multiple concurrent connections to servers, and allows multiple requests in the pipeline to any one connection. Normally, only one such object will be needed per program to support any number of requests. As well as using futures the module also supports a callback-based interface. This module optionally supports SSL connections, if L is installed. If so, SSL can be requested either by passing a URI with the C scheme, or by passing a true value as the C parameter. =head2 Connection Pooling There are three ways in which connections to HTTP server hosts are managed by this object, controlled by the value of C. This controls when new connections are established to servers, as compared to waiting for existing connections to be free, as new requests are made to them. They are: =over 2 =item max_connections_per_host = 1 This is the default setting. In this mode, there will be one connection per host on which there are active or pending requests. If new requests are made while an existing one is outstanding, they will be queued to wait for it. If pipelining is active on the connection (because both the C option is true and the connection is known to be an HTTP/1.1 server), then requests will be pipelined into the connection awaiting their response. If not, they will be queued awaiting a response to the previous before sending the next. =item max_connections_per_host > 1 In this mode, there can be more than one connection per host. If a new request is made, it will try to re-use idle connections if there are any, or if they are all busy it will create a new connection to the host, up to the configured limit. =item max_connections_per_host = 0 In this mode, there is no upper limit to the number of connections per host. Every new request will try to reuse an idle connection, or else create a new one if all the existing ones are busy. =back These modes all apply per hostname / server port pair; they do not affect the behaviour of connections made to differing hostnames, or differing ports on the same hostname. =cut $metrics->make_gauge( requests_in_flight => description => "Count of the number of requests sent that have not yet been completed", # no labels ); $metrics->make_counter( requests => description => "Number of HTTP requests sent", labels => [qw( method )], ); $metrics->make_counter( responses => description => "Number of HTTP responses received", labels => [qw( method code )], ); $metrics->make_timer( request_duration => description => "Duration of time spent waiting for responses", # no labels ); $metrics->make_distribution( response_bytes => name => [qw( response bytes )], description => "The size in bytes of responses received", units => "bytes", # no labels ); sub _init { my $self = shift; $self->{connections} = {}; # { "$host:$port" } -> [ @connections ] $self->{read_len} = READ_LEN; $self->{write_len} = WRITE_LEN; $self->{max_connections_per_host} = $DEFAULT_MAX_CONNS_PER_HOST; $self->{ssl_params} = {}; } sub _remove_from_loop { my $self = shift; foreach my $conn ( map { @$_ } values %{ $self->{connections} } ) { $conn->close; } $self->SUPER::_remove_from_loop( @_ ); } =head1 PARAMETERS The following named parameters may be passed to C or C: =head2 user_agent => STRING A string to set in the C HTTP header. If not supplied, one will be constructed that declares C and the version number. =head2 headers => ARRAY or HASH I A set of extra headers to apply to every outgoing request. May be specified either as an even-sized array containing key/value pairs, or a hash. Individual header values may be added or changed without replacing the entire set by using the L method and passing a key called C<+headers>: $http->configure( +headers => { One_More => "Key" } ); =head2 max_redirects => INT Optional. How many levels of redirection to follow. If not supplied, will default to 3. Give 0 to disable redirection entirely. =head2 max_in_flight => INT Optional. The maximum number of in-flight requests to allow per host when pipelining is enabled and supported on that host. If more requests are made over this limit they will be queued internally by the object and not sent to the server until responses are received. If not supplied, will default to 4. Give 0 to disable the limit entirely. =head2 max_connections_per_host => INT Optional. Controls the maximum number of connections per hostname/server port pair, before requests will be queued awaiting one to be free. Give 0 to disable the limit entirely. See also the L section documented above. Currently, if not supplied it will default to 1. However, it has been found in practice that most programs will raise this limit to something higher, perhaps 3 or 4. Therefore, a future version of this module may set a higher value. To test if your application will handle this correctly, you can set a different default by setting an environment variable: $ NET_ASYNC_HTTP_MAXCONNS=3 perl ... =head2 timeout => NUM Optional. How long in seconds to wait before giving up on a request. If not supplied then no default will be applied, and no timeout will take place. =head2 stall_timeout => NUM Optional. How long in seconds to wait after each write or read of data on a socket, before giving up on a request. This may be more useful than C on large-file operations, as it will not time out provided that regular progress is still being made. =head2 proxy_host => STRING =head2 proxy_port => INT Optional. Default values to apply to each C method. =head2 cookie_jar => HTTP::Cookies Optional. A reference to a L object. Will be used to set cookies in requests and store them from responses. =head2 pipeline => BOOL Optional. If false, disables HTTP/1.1-style request pipelining. =head2 close_after_request => BOOL I Optional. If true, will set the C header on outgoing requests and disable pipelining, thus making every request use a new connection. =head2 family => INT =head2 local_host => STRING =head2 local_port => INT =head2 local_addrs => ARRAY =head2 local_addr => HASH or ARRAY Optional. Parameters to pass on to the C method used to connect sockets to HTTP servers. Sets the socket family and local socket address to C to. For more detail, see the documentation in L. =head2 fail_on_error => BOOL Optional. Affects the behaviour of response handling when a C<4xx> or C<5xx> response code is received. When false, these responses will be processed as other responses and yielded as the result of the future, or passed to the C callback. When true, such an error response causes the future to fail, or the C callback to be invoked. The HTTP response and request objects will be passed as well as the code and message, and the failure name will be C. ( $code_message, "http", $response, $request ) = $f->failure $on_error->( "$code $message", $response, $request ) =head2 read_len => INT =head2 write_len => INT Optional. Used to set the reading and writing buffer lengths on the underlying C objects that represent connections to the server. If not define, a default of 64 KiB will be used. =head2 ip_tos => INT or STRING Optional. Used to set the C socket option on client sockets. If given, should either be a C constant, or one of the string names C, C, C or C. If undefined or left absent, no option will be set. =head2 decode_content => BOOL Optional. If true, incoming responses that have a recognised C are handled by the module, and decompressed content is passed to the body handling callback or returned in the C. See L below for details of which encoding types are recognised. When this option is enabled, outgoing requests also have the C header added to them if it does not already exist. Currently the default is false, because this behaviour is new, but it may default to true in a later version. Applications which care which behaviour applies should set this to a defined value to ensure it doesn't change. =head2 SSL_* Additionally, any parameters whose names start with C will be stored and passed on requests to perform SSL requests. This simplifies configuration of common SSL parameters. =head2 require_SSL => BOOL Optional. If true, then any attempt to make a request that does not use SSL (either by calling C, or as a result of a redirection) will immediately fail. =head2 SOCKS_* I Additionally, any parameters whose names start with C will be stored and used by L to establish connections via a configured proxy. =cut sub configure { my $self = shift; my %params = @_; foreach (qw( user_agent max_redirects max_in_flight max_connections_per_host timeout stall_timeout proxy_host proxy_port cookie_jar pipeline close_after_request family local_host local_port local_addrs local_addr fail_on_error read_len write_len decode_content require_SSL )) { $self->{$_} = delete $params{$_} if exists $params{$_}; } # Always store internally as ARRAyref if( my $headers = delete $params{headers} ) { @{ $self->{headers} } = ( ref $headers eq "ARRAY" ) ? @$headers : ( ref $headers eq "HASH" ) ? %$headers : croak "Expected 'headers' to be either ARRAY or HASH reference"; } if( my $more = delete $params{"+headers"} ) { my @more = ( ref $more eq "ARRAY" ) ? @$more : ( ref $more eq "HASH" ) ? %$more : croak "Expected '+headers' to be either ARRAY or HASH reference"; my %to_remove = @more; my $headers = $self->{headers}; @$headers = ( ( pairgrep { !exists $to_remove{$a} } @$headers ), @more ); } foreach ( grep { m/^SSL_/ } keys %params ) { $self->{ssl_params}{$_} = delete $params{$_}; } foreach ( grep { m/^SOCKS_/ } keys %params ) { $self->{socks_params}{$_} = delete $params{$_}; } if( exists $params{ip_tos} ) { # TODO: This conversion should live in IO::Async somewhere my $ip_tos = delete $params{ip_tos}; $ip_tos = IPTOS_LOWDELAY if defined $ip_tos and $ip_tos eq "lowdelay"; $ip_tos = IPTOS_THROUGHPUT if defined $ip_tos and $ip_tos eq "throughput"; $ip_tos = IPTOS_RELIABILITY if defined $ip_tos and $ip_tos eq "reliability"; $ip_tos = IPTOS_MINCOST if defined $ip_tos and $ip_tos eq "mincost"; $self->{ip_tos} = $ip_tos; } $self->SUPER::configure( %params ); defined $self->{user_agent} or $self->{user_agent} = $DEFAULT_UA; defined $self->{max_redirects} or $self->{max_redirects} = $DEFAULT_MAXREDIR; defined $self->{max_in_flight} or $self->{max_in_flight} = $DEFAULT_MAX_IN_FLIGHT; defined $self->{pipeline} or $self->{pipeline} = 1; } =head1 METHODS The following methods documented in an C expression return L instances. When returning a Future, the following methods all indicate HTTP-level errors using the Future failure name of C. If the error relates to a specific response it will be included. The original request is also included. $f->fail( $message, "http", $response, $request ) =cut sub connect_connection { my $self = shift; my %args = @_; my $conn = delete $args{conn}; my $host = delete $args{host}; my $port = delete $args{port}; my $on_error = $args{on_error}; if( my $socks_params = $self->{socks_params} ) { require Net::Async::SOCKS; Net::Async::SOCKS->VERSION( '0.003' ); unshift @{ $args{extensions} }, "SOCKS"; $args{$_} = $socks_params->{$_} for keys %$socks_params; } if( $args{SSL} ) { require IO::Async::SSL; IO::Async::SSL->VERSION( '0.12' ); # 0.12 has ->connect(handle) bugfix unshift @{ $args{extensions} }, "SSL"; } my $f = $conn->connect( host => $host, service => $port, family => ( $args{family} || $self->{family} || 0 ), ( map { defined $self->{$_} ? ( $_ => $self->{$_} ) : () } qw( local_host local_port local_addrs local_addr ) ), %args, )->on_done( sub { my ( $stream ) = @_; $stream->configure( notifier_name => "$host:$port,fd=" . $stream->read_handle->fileno, ); # Defend against ->setsockopt doing silly things like detecting SvPOK() $stream->read_handle->setsockopt( IPPROTO_IP, IP_TOS, $self->{ip_tos}+0 ) if defined $self->{ip_tos}; $stream->ready; })->on_fail( sub { $on_error->( $conn, "$host:$port - $_[0] failed [$_[-1]]" ); }); $f->on_ready( sub { undef $f } ); # intentionally cycle } sub get_connection { my $self = shift; my %args = @_; my $loop = $self->get_loop or croak "Cannot ->get_connection without a Loop"; my $host = $args{host}; my $port = $args{port}; my $key = "$host:$port"; my $conns = $self->{connections}{$key} ||= []; my $ready_queue = $self->{ready_queue}{$key} ||= []; # Have a look to see if there are any idle connected ones first foreach my $conn ( @$conns ) { $conn->is_idle and $conn->read_handle and return Future->done( $conn ); } my $ready = $args{ready}; $ready or push @$ready_queue, $ready = Ready( $self->loop->new_future->set_label( "[ready $host:$port]" ), 0 ); my $f = $ready->future; my $max = $self->{max_connections_per_host}; if( $max and @$conns >= $max ) { return $f; } my $conn = Net::Async::HTTP::Connection->new( notifier_name => "$host:$port,connecting", ready_queue => $ready_queue, ( map { $_ => $self->{$_} } qw( max_in_flight read_len write_len decode_content ) ), pipeline => ( $self->{pipeline} && !$self->{close_after_request} ), is_proxy => $args{is_proxy}, on_closed => sub { my $conn = shift; my $http = $conn->parent; $conn->remove_from_parent; @$conns = grep { $_ != $conn } @$conns; if( my $next = first { !$_->connecting } @$ready_queue ) { # Requeue another connection attempt as there's still more to do $http->get_connection( %args, ready => $next ); } }, ); $self->add_child( $conn ); push @$conns, $conn; $ready->connecting = $self->connect_connection( %args, conn => $conn, on_error => sub { my $conn = shift; $f->fail( @_ ) unless $f->is_cancelled; $conn->remove_from_parent; @$conns = grep { $_ != $conn } @$conns; @$ready_queue = grep { $_ != $ready } @$ready_queue; if( my $next = first { !$_->connecting } @$ready_queue ) { # Requeue another connection attempt as there's still more to do $self->get_connection( %args, ready => $next ); } }, )->on_cancel( sub { $conn->remove_from_parent; @$conns = grep { $_ != $conn } @$conns; }); return $f; } =head2 do_request $response = await $http->do_request( %args ); Send an HTTP request to a server, returning a L that will yield the response. The request may be represented by an L object, or a L object, depending on the arguments passed. The following named arguments are used for Cs: =over 8 =item request => HTTP::Request A reference to an C object =item host => STRING Hostname of the server to connect to =item port => INT or STRING Optional. Port number or service of the server to connect to. If not defined, will default to C or C depending on whether SSL is being used. =item family => INT Optional. Restricts the socket family for connecting. If not defined, will default to the globally-configured value in the object. =item SSL => BOOL Optional. If true, an SSL connection will be used. =back The following named arguments are used for C requests: =over 8 =item uri => URI or STRING A reference to a C object, or a plain string giving the request URI. If the scheme is C then an SSL connection will be used. =item method => STRING Optional. The HTTP method name. If missing, C is used. =item content => STRING or ARRAY ref Optional. The body content to use for C or C requests. If this is a plain scalar it will be used directly, and a C field must also be supplied to describe it. If this is an ARRAY ref and the request method is C, it will be form encoded. It should contain an even-sized list of field names and values. For more detail see L. =item content_type => STRING The type of non-form data C. =item user => STRING =item pass => STRING Optional. If both are given, the HTTP Basic Authorization header will be sent with these details. =item headers => ARRAY|HASH Optional. If provided, contains additional HTTP headers to set on the constructed request object. If provided as an ARRAY reference, it should contain an even-sized list of name/value pairs. =item proxy_host => STRING =item proxy_port => INT Optional. Override the hostname or port number implied by the URI. =back For either request type, it takes the following arguments: =over 8 =item request_body => STRING | CODE | Future Optional. Allows request body content to be generated by a future or callback, rather than being provided as part of the C object. This can either be a plain string, a C reference to a generator function, or a future. As this is passed to the underlying L C method, the usual semantics apply here. If passed a C reference, it will be called repeatedly whenever it's safe to write. The code should should return C to indicate completion. If passed a C it is expected to eventually yield the body value. As with the C parameter, the C field should be specified explicitly in the request header, as should the content length (typically via the L C method). See also F. =item expect_continue => BOOL Optional. If true, sets the C request header to the value C<100-continue> and does not send the C parameter until a C<100 Continue> response is received from the server. If an error response is received then the C code, if present, will not be invoked. =item on_ready => CODE Optional. A callback that is invoked once a socket connection is established with the HTTP server, but before the request is actually sent over it. This may be used by the client code to inspect the socket, or perform any other operations on it. This code is expected to return a C; only once that has completed will the request cycle continue. If it fails, that failure is propagated to the caller. $f = $on_ready->( $connection ) =item on_redirect => CODE Optional. A callback that is invoked if a redirect response is received, before the new location is fetched. It will be passed the response and the new URL. $on_redirect->( $response, $location ) =item on_body_write => CODE Optional. A callback that is invoked after each successful C of the body content. This may be used to implement an upload progress indicator or similar. It will be passed the total number of bytes of body content written so far (i.e. excluding bytes consumed in the header). $on_body_write->( $written ) =item max_redirects => INT Optional. How many levels of redirection to follow. If not supplied, will default to the value given in the constructor. =item timeout => NUM =item stall_timeout => NUM Optional. Overrides the object's configured timeout values for this one request. If not specified, will use the configured defaults. On a timeout, the returned future will fail with either C or C as the operation name. ( $message, "timeout" ) = $f->failure =back =head2 do_request (void) $http->do_request( %args ) When not returning a future, the following extra arguments are used as callbacks instead: =over 8 =item on_response => CODE A callback that is invoked when a response to this request has been received. It will be passed an L object containing the response the server sent. $on_response->( $response ) =item on_header => CODE Alternative to C. A callback that is invoked when the header of a response has been received. It is expected to return a C reference for handling chunks of body content. This C reference will be invoked with no arguments once the end of the request has been reached, and whatever it returns will be used as the result of the returned C, if there is one. $on_body_chunk = $on_header->( $header ) $on_body_chunk->( $data ) $response = $on_body_chunk->() =item on_error => CODE A callback that is invoked if an error occurs while trying to send the request or obtain the response. It will be passed an error message. $on_error->( $message ) If this is invoked because of a received C<4xx> or C<5xx> error code in an HTTP response, it will be invoked with the response and request objects as well. $on_error->( $message, $response, $request ) =back =cut sub _do_one_request { my $self = shift; my %args = @_; my $host = delete $args{host}; my $port = delete $args{port}; my $request = delete $args{request}; my $SSL = delete $args{SSL}; my $start_time = time; my $stall_timeout = $args{stall_timeout} // $self->{stall_timeout}; $self->prepare_request( $request ); if( $self->{require_SSL} and not $SSL ) { return Future->fail( "Non-SSL request is not allowed with 'require_SSL' set", http => undef, $request ); } if( $metrics ) { $metrics->inc_gauge( requests_in_flight => ); $metrics->inc_counter( requests => [ method => $request->method ] ); } return $self->get_connection( host => $args{proxy_host} || $self->{proxy_host} || $host, port => $args{proxy_port} || $self->{proxy_port} || $port, is_proxy => !!( $args{proxy_host} || $self->{proxy_host} ), ( defined $args{family} ? ( family => $args{family} ) : () ), $SSL ? ( SSL => 1, SSL_hostname => $host, %{ $self->{ssl_params} }, ( map { m/^SSL_/ ? ( $_ => $args{$_} ) : () } keys %args ), ) : (), )->then( sub { my ( $conn ) = @_; $args{on_ready} ? $args{on_ready}->( $conn )->then_done( $conn ) : Future->done( $conn ) })->then( sub { my ( $conn ) = @_; return $conn->request( request => $request, stall_timeout => $stall_timeout, %args, $SSL ? ( SSL => 1 ) : (), on_done => sub { my ( $ctx ) = @_; if( $metrics ) { $metrics->dec_gauge( requests_in_flight => ); # TODO: Some sort of error counter instead for errors? $metrics->inc_counter( responses => [ method => $request->method, code => $ctx->resp_header->code ] ); $metrics->report_timer( request_duration => time - $start_time ); $metrics->report_distribution( response_bytes => $ctx->resp_bytes ); } }, ); } ); } sub _should_redirect { my ( $response ) = @_; # Should only redirect if we actually have a Location header return 0 unless $response->is_redirect and defined $response->header( "Location" ); my $req_method = $response->request->method; # Should only redirect GET or HEAD requests return $req_method eq "GET" || $req_method eq "HEAD"; } sub _do_request { my $self = shift; my %args = @_; my $host = $args{host}; my $port = $args{port}; my $ssl = $args{SSL}; my $on_header = delete $args{on_header}; my $redirects = defined $args{max_redirects} ? $args{max_redirects} : $self->{max_redirects}; my $request = $args{request}; my $response; my $reqf; # Defeat prototype my $future = &repeat( $self->_capture_weakself( sub { my $self = shift; my ( $previous_f ) = @_; if( $previous_f ) { my $previous_response = $previous_f->get; $args{previous_response} = $previous_response; my $location = $previous_response->header( "Location" ); if( $location =~ m{^http(?:s?)://} ) { # skip } elsif( $location =~ m{^/} ) { my $hostport = ( $port != HTTP_PORT ) ? "$host:$port" : $host; $location = "http://$hostport" . $location; } else { return Future->fail( "Unrecognised Location: $location", http => $previous_response, $request ); } my $loc_uri = URI->new( $location ); unless( $loc_uri ) { return Future->fail( "Unable to parse '$location' as a URI", http => $previous_response, $request ); } $self->debug_printf( "REDIRECT $loc_uri" ); $args{on_redirect}->( $previous_response, $location ) if $args{on_redirect}; %args = $self->_make_request_for_uri( $loc_uri, %args ); $request = $args{request}; undef $host; undef $port; undef $ssl; } my $uri = $request->uri; if( defined $uri->scheme and $uri->scheme =~ m/^http(s?)$/ ) { $host = $uri->host if !defined $host; $port = $uri->port if !defined $port; $ssl = ( $uri->scheme eq "https" ); } defined $host or croak "Expected 'host'"; defined $port or $port = ( $ssl ? HTTPS_PORT : HTTP_PORT ); return $reqf = $self->_do_one_request( host => $host, port => $port, SSL => $ssl, %args, on_header => $self->_capture_weakself( sub { my $self = shift; ( $response ) = @_; # Consume and discard the entire body of a redirect return sub { return if @_; return $response; } if $redirects and $response->is_redirect; return $on_header->( $response ); } ), ); } ), while => sub { my $f = shift; return 0 if $f->failure or $f->is_cancelled; return _should_redirect( $response ) && $redirects--; } ); if( $self->{fail_on_error} ) { $future = $future->then_with_f( sub { my ( $f, $resp ) = @_; my $code = $resp->code; if( $code =~ m/^[45]/ ) { my $message = $resp->message; $message =~ s/\r$//; # HTTP::Message bug return Future->fail( "$code $message", http => $resp, $request ); } return $f; }); } return $future; } sub do_request { my $self = shift; my %args = @_; if( my $uri = delete $args{uri} ) { %args = $self->_make_request_for_uri( $uri, %args ); } elsif( !defined $args{request} ) { croak "Require either 'uri' or 'request' argument"; } if( $args{on_header} ) { # ok } elsif( $args{on_response} or defined wantarray ) { $args{on_header} = sub { my ( $response ) = @_; return sub { if( @_ ) { $response->add_content( @_ ); } else { return $response; } }; } } else { croak "Expected 'on_response' or 'on_header' as CODE ref or to return a Future"; } my $on_error = delete $args{on_error}; my $timeout = defined $args{timeout} ? $args{timeout} : $self->{timeout}; my $future = $self->_do_request( %args ); if( defined $timeout ) { $future = Future->wait_any( $future, $self->loop->timeout_future( after => $timeout ) ->transform( fail => sub { "Timed out", timeout => } ), ); } $future->on_done( $self->_capture_weakself( sub { my $self = shift; my $response = shift; $self->process_response( $response ); } ) ); $future->on_fail( sub { my ( $message, $name, @rest ) = @_; $on_error->( $message, @rest ); }) if $on_error; if( my $on_response = delete $args{on_response} ) { $future->on_done( sub { my ( $response ) = @_; $on_response->( $response ); }); } # DODGY HACK: # In void context we'll lose reference on the ->wait_any Future, so the # timeout logic will never happen. So lets purposely create a cycle by # capturing the $future in on_done/on_fail closures within itself. This # conveniently clears them out to drop the ref when done. return $future if defined wantarray; $future->on_ready( sub { undef $future } ); } sub _make_request_for_uri { my $self = shift; my ( $uri, %args ) = @_; if( !ref $uri ) { $uri = URI->new( $uri ); } elsif( blessed $uri and !$uri->isa( "URI" ) ) { croak "Expected 'uri' as a URI reference"; } my $method = delete $args{method} || "GET"; $args{host} = $uri->host; $args{port} = $uri->port; my $request; if( $method eq "POST" ) { defined $args{content} or croak "Expected 'content' with POST method"; # Lack of content_type didn't used to be a failure condition: ref $args{content} or defined $args{content_type} or carp "No 'content_type' was given with 'content'"; # This will automatically encode a form for us $request = HTTP::Request::Common::POST( $uri, Content => $args{content}, Content_Type => $args{content_type} ); } else { $request = HTTP::Request->new( $method, $uri ); if( defined $args{content} ) { defined $args{content_type} or carp "No 'content_type' was given with 'content'"; $request->content( $args{content} ); $request->content_type( $args{content_type} // "" ); } } $request->protocol( "HTTP/1.1" ); if( $args{port} != $uri->default_port ) { $request->header( Host => "$args{host}:$args{port}" ); } else { $request->header( Host => "$args{host}" ); } my $headers = $args{headers}; if( $headers and reftype $headers eq "ARRAY" ) { $request->header( @$_ ) for pairs @$headers; } elsif( $headers and reftype $headers eq "HASH" ) { $request->header( $_, $headers->{$_} ) for keys %$headers; } my ( $user, $pass ); if( defined $uri->userinfo ) { ( $user, $pass ) = split( m/:/, $uri->userinfo, 2 ); } elsif( defined $args{user} and defined $args{pass} ) { $user = $args{user}; $pass = $args{pass}; } if( defined $user and defined $pass ) { $request->authorization_basic( $user, $pass ); } $args{request} = $request; return %args; } =head2 GET, HEAD, PUT, ... $response = await $http->GET( $uri, %args ); $response = await $http->HEAD( $uri, %args ); $response = await $http->PUT( $uri, $content, %args ); $response = await $http->POST( $uri, $content, %args ); $response = await $http->PATCH( $uri, $content, %args ); Convenient wrappers for performing C, C, C, C or C requests with a C object and few if any other arguments, returning a C. Remember that C with non-form data (as indicated by a plain scalar instead of an C reference of form data name/value pairs) needs a C key in C<%args>. =cut sub GET { my $self = shift; my ( $uri, @args ) = @_; return $self->do_request( method => "GET", uri => $uri, @args ); } sub HEAD { my $self = shift; my ( $uri, @args ) = @_; return $self->do_request( method => "HEAD", uri => $uri, @args ); } sub PUT { my $self = shift; my ( $uri, $content, @args ) = @_; return $self->do_request( method => "PUT", uri => $uri, content => $content, @args ); } sub POST { my $self = shift; my ( $uri, $content, @args ) = @_; return $self->do_request( method => "POST", uri => $uri, content => $content, @args ); } sub PATCH { my $self = shift; my ( $uri, $content, @args ) = @_; return $self->do_request( method => "PATCH", uri => $uri, content => $content, @args ); } =head1 SUBCLASS METHODS The following methods are intended as points for subclasses to override, to add extra functionallity. =cut =head2 prepare_request $http->prepare_request( $request ) Called just before the C object is sent to the server. =cut sub prepare_request { my $self = shift; my ( $request ) = @_; $request->init_header( 'User-Agent' => $self->{user_agent} ) if length $self->{user_agent}; if( $self->{close_after_request} ) { $request->header( "Connection" => "close" ); } else { $request->init_header( "Connection" => "keep-alive" ); } foreach ( pairs @{ $self->{headers} } ) { $request->init_header( $_->key, $_->value ); } $self->{cookie_jar}->add_cookie_header( $request ) if $self->{cookie_jar}; } =head2 process_response $http->process_response( $response ) Called after a non-redirect C has been received from a server. The originating request will be set in the object. =cut sub process_response { my $self = shift; my ( $response ) = @_; $self->{cookie_jar}->extract_cookies( $response ) if $self->{cookie_jar}; } =head1 CONTENT DECODING If the required decompression modules are installed and available, compressed content can be decoded. If the received C is recognised and the required module is available, the content is transparently decoded and the decoded content is returned in the resulting response object, or passed to the data chunk handler. In this case, the original C header will be deleted from the response, and its value will be available instead as C. The following content encoding types are recognised by these modules: =over 4 =cut =item * gzip (q=0.7) and deflate (q=0.5) Recognised if L version 2.057 or newer is installed. =cut if( eval { require Compress::Raw::Zlib and $Compress::Raw::Zlib::VERSION >= 2.057 } ) { my $make_zlib_decoder = sub { my ( $bits ) = @_; my $inflator = Compress::Raw::Zlib::Inflate->new( -ConsumeInput => 0, -WindowBits => $bits, ); sub { my $output; my $status = @_ ? $inflator->inflate( $_[0], $output ) : $inflator->inflate( "", $output, 1 ); die "$status\n" if $status && $status != Compress::Raw::Zlib::Z_STREAM_END(); return $output; }; }; # RFC1950 __PACKAGE__->register_decoder( deflate => 0.5, sub { $make_zlib_decoder->( 15 ) }, ); # RFC1952 __PACKAGE__->register_decoder( gzip => 0.7, sub { $make_zlib_decoder->( Compress::Raw::Zlib::WANT_GZIP() ) }, ); } =item * bzip2 (q=0.8) Recognised if L version 2.10 or newer is installed. =cut if( eval { require Compress::Bzip2 and $Compress::Bzip2::VERSION >= 2.10 } ) { __PACKAGE__->register_decoder( bzip2 => 0.8, sub { my $inflator = Compress::Bzip2::inflateInit(); sub { return unless my ( $in ) = @_; my $out = $inflator->bzinflate( \$in ); die $inflator->bzerror."\n" if !defined $out; return $out; }; } ); } =back Other content encoding types can be registered by calling the following method =head2 register_decoder Net::Async::HTTP->register_decoder( $name, $q, $make_decoder ) Registers an encoding type called C<$name>, at the quality value C<$q>. In order to decode this encoding type, C<$make_decoder> will be invoked with no paramters, and expected to return a CODE reference to perform one instance of decoding. $decoder = $make_decoder->() This decoder will be invoked on string buffers to decode them until the end of stream is reached, when it will be invoked with no arguments. $content = $decoder->( $encoded_content ) $content = $decoder->() # EOS =cut { my %DECODERS; # {$name} = [$q, $make_decoder] sub register_decoder { shift; my ( $name, $q, $make_decoder ) = @_; $DECODERS{$name} = [ $q, $make_decoder ]; } sub can_decode { shift; if( @_ ) { my ( $name ) = @_; return unless my $d = $DECODERS{$name}; return $d->[1]->(); } else { my @ds = sort { $DECODERS{$b}[0] <=> $DECODERS{$a}[0] } keys %DECODERS; return join ", ", map { "$_;q=$DECODERS{$_}[0]" } @ds; } } } =head1 EXAMPLES =head2 Concurrent GET The C-returning C method makes it easy to await multiple URLs at once, by using the L C utility use Future::AsyncAwait; use Future::Utils qw( fmap_void ); my @URLs = ( ... ); my $http = Net::Async::HTTP->new( ... ); $loop->add( $http ); my $future = fmap_void { my ( $url ) = @_; $http->GET( $url ) ->on_done( sub { my $response = shift; say "$url succeeded: ", $response->code; say " Content-Type:", $response->content_type; } ) ->on_fail( sub { my $failure = shift; say "$url failed: $failure"; } ); } foreach => \@URLs, concurrent => 5; await $future; =cut =head1 SEE ALSO =over 4 =item * L - Hypertext Transfer Protocol -- HTTP/1.1 =back =head1 SPONSORS Parts of this code, or bugfixes to it were paid for by =over 2 =item * SocialFlow L =item * Shadowcat Systems L =item * NET-A-PORTER L =item * Cisco L =back =head1 AUTHOR Paul Evans =cut 0x55AA; Net-Async-HTTP-0.48/lib/Net/Async/HTTP000755001750001750 014021530440 15665 5ustar00leoleo000000000000Net-Async-HTTP-0.48/lib/Net/Async/HTTP/Connection.pm000444001750001750 4451714021530440 20512 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2008-2019 -- leonerd@leonerd.org.uk package Net::Async::HTTP::Connection; use strict; use warnings; our $VERSION = '0.48'; use Carp; use base qw( IO::Async::Stream ); IO::Async::Stream->VERSION( '0.59' ); # ->write( ..., on_write ) use Net::Async::HTTP::StallTimer; use HTTP::Response; my $CRLF = "\x0d\x0a"; # More portable than \r\n use Struct::Dumb; struct RequestContext => [qw( req on_read stall_timer resp_header resp_bytes on_done is_done f )], named_constructor => 1; # Detect whether HTTP::Message properly trims whitespace in header values. If # it doesn't, we have to deploy a workaround to fix them up. # https://rt.cpan.org/Ticket/Display.html?id=75224 use constant HTTP_MESSAGE_TRIMS_LWS => HTTP::Message->parse( "Name: value " )->header("Name") eq "value"; =head1 NAME C - HTTP client protocol handler =head1 DESCRIPTION This class provides a connection to a single HTTP server, and is used internally by L. It is not intended for general use. =cut sub _init { my $self = shift; $self->SUPER::_init( @_ ); $self->{requests_in_flight} = 0; } sub configure { my $self = shift; my %params = @_; foreach (qw( pipeline max_in_flight ready_queue decode_content is_proxy )) { $self->{$_} = delete $params{$_} if exists $params{$_}; } if( my $on_closed = $params{on_closed} ) { $params{on_closed} = sub { my $self = shift; $self->debug_printf( "CLOSED in-flight=$self->{requests_in_flight}" ); $self->error_all( "Connection closed" ); undef $self->{ready_queue}; $on_closed->( $self ); }; } croak "max_in_flight parameter required, may be zero" unless defined $self->{max_in_flight}; $self->SUPER::configure( %params ); } sub should_pipeline { my $self = shift; return $self->{pipeline} && $self->{can_pipeline} && ( !$self->{max_in_flight} || $self->{requests_in_flight} < $self->{max_in_flight} ); } sub connect { my $self = shift; my %args = @_; $self->debug_printf( "CONNECT $args{host}:$args{service}" ); defined wantarray or die "VOID ->connect"; $self->SUPER::connect( socktype => "stream", %args )->on_done( sub { $self->debug_printf( "CONNECTED" ); }); } sub ready { my $self = shift; my $queue = $self->{ready_queue} or return; if( $self->should_pipeline ) { $self->debug_printf( "READY pipelined" ); while( @$queue && $self->should_pipeline ) { my $ready = shift @$queue; my $f = $ready->future; next if $f->is_cancelled; $ready->connecting and $ready->connecting->cancel; $f->done( $self ); } } elsif( @$queue and $self->is_idle ) { $self->debug_printf( "READY non-pipelined" ); while( @$queue ) { my $ready = shift @$queue; my $f = $ready->future; next if $f->is_cancelled; $ready->connecting and $ready->connecting->cancel; $f->done( $self ); last; } } else { $self->debug_printf( "READY cannot-run queue=%d idle=%s", scalar @$queue, $self->is_idle ? "Y" : "N"); } } sub is_idle { my $self = shift; return $self->{requests_in_flight} == 0; } sub on_read { my $self = shift; my ( $buffref, $closed ) = @_; while( my $head = $self->{request_queue}[0]) { shift @{ $self->{request_queue} } and next if $head->is_done; $head->stall_timer->reset if $head->stall_timer; my $ret = $head->on_read->( $self, $buffref, $closed, $head ); if( defined $ret ) { return $ret if !ref $ret; $head->on_read = $ret; return 1; } $head->is_done or die "ARGH: undef return without being marked done"; shift @{ $self->{request_queue} }; return 1 if !$closed and length $$buffref; return; } # Reinvoked after switch back to baseline, but may be idle again return if $closed or !length $$buffref; $self->invoke_error( "Spurious on_read of connection while idle", http_connection => read => $$buffref ); $$buffref = ""; } sub on_write_eof { my $self = shift; $self->error_all( "Connection closed", http => undef, undef ); } sub error_all { my $self = shift; while( my $head = shift @{ $self->{request_queue} } ) { $head->f->fail( @_ ) unless $head->is_done or $head->f->is_ready; } } sub request { my $self = shift; my %args = @_; my $on_header = $args{on_header} or croak "Expected 'on_header' as a CODE ref"; my $req = $args{request}; ref $req and $req->isa( "HTTP::Request" ) or croak "Expected 'request' as a HTTP::Request reference"; $self->debug_printf( "REQUEST %s %s", $req->method, $req->uri ); my $request_body = $args{request_body}; my $expect_continue = !!$args{expect_continue}; my $method = $req->method; if( $method eq "POST" or $method eq "PUT" or length $req->content ) { $req->init_header( "Content-Length", length $req->content ); } if( $expect_continue ) { $req->init_header( "Expect", "100-continue" ); } if( $self->{decode_content} ) { #$req->init_header( "Accept-Encoding", Net::Async::HTTP->can_decode ) $req->init_header( "Accept-Encoding", "gzip" ); } my $f = $self->loop->new_future ->set_label( "$method " . $req->uri ); # TODO: Cancelling a request Future shouldn't necessarily close the socket # if we haven't even started writing the request yet. But we can't know # that currently. $f->on_cancel( sub { $self->debug_printf( "CLOSE on_cancel" ); $self->close_now; }); my $stall_timer; if( $args{stall_timeout} ) { $stall_timer = Net::Async::HTTP::StallTimer->new( delay => $args{stall_timeout}, future => $f, ); $self->add_child( $stall_timer ); # Don't start it yet my $remove_timer = sub { $self->remove_child( $stall_timer ) if $stall_timer; undef $stall_timer; }; $f->on_ready( $remove_timer ); } push @{ $self->{request_queue} }, my $ctx = RequestContext( req => $req, on_read => undef, # will be set later stall_timer => $stall_timer, resp_header => undef, # will be set later resp_bytes => 0, on_done => $args{on_done}, is_done => 0, f => $f, ); my $on_body_write; if( $stall_timer or $args{on_body_write} ) { my $inner_on_body_write = $args{on_body_write}; my $written = 0; $on_body_write = sub { $stall_timer->reset if $stall_timer; $inner_on_body_write->( $written += $_[1] ) if $inner_on_body_write; }; } my $write_request_body = defined $request_body ? sub { my ( $self ) = @_; $self->write( $request_body, on_write => $on_body_write ); } : undef; # Unless the request method is CONNECT, or we are connecting to a # non-transparent proxy, the URL is not allowed to contain # an authority; only path # Take a copy of the headers since we'll be hacking them up my $headers = $req->headers->clone; my $path; if( $method eq "CONNECT" ) { $path = $req->uri->as_string; } else { my $uri = $req->uri; if ( $self->{is_proxy} ) { $path = $uri->as_string; } else { $path = $uri->path_query; $path = "/$path" unless $path =~ m{^/}; } my $authority = $uri->authority; if( defined $authority and my ( $user, $pass, $host ) = $authority =~ m/^(.*?):(.*)@(.*)$/ ) { $headers->init_header( Host => $host ); $headers->authorization_basic( $user, $pass ); } else { $headers->init_header( Host => $authority ); } } my $protocol = $req->protocol || "HTTP/1.1"; my @headers = ( "$method $path $protocol" ); $headers->scan( sub { my ( $name, $value ) = @_; $name =~ s/^://; # non-canonical header push @headers, "$name: $value"; } ); $stall_timer->start if $stall_timer; $stall_timer->reason = "writing request" if $stall_timer; my $on_header_write = $stall_timer ? sub { $stall_timer->reset } : undef; $self->write( join( $CRLF, @headers ) . $CRLF . $CRLF, on_write => $on_header_write ); $self->write( $req->content, on_write => $on_body_write ) if length $req->content; $write_request_body->( $self ) if $write_request_body and !$expect_continue; $self->write( "", on_flush => sub { return unless $stall_timer; # test again in case it was cancelled in the meantime $stall_timer->reset; $stall_timer->reason = "waiting for response"; }) if $stall_timer; $self->{requests_in_flight}++; $ctx->on_read = $self->_mk_on_read_header( $args{previous_response}, $expect_continue ? $write_request_body : undef, $on_header ); return $f; } sub _mk_on_read_header { shift; # $self my ( $previous_response, $write_request_body, $on_header ) = @_; sub { my ( $self, $buffref, $closed, $ctx ) = @_; my $req = $ctx->req; my $stall_timer = $ctx->stall_timer; my $f = $ctx->f; if( $stall_timer ) { $stall_timer->reason = "receiving response header"; $stall_timer->reset; } if( length $$buffref >= 4 and $$buffref !~ m/^HTTP/ ) { $self->debug_printf( "ERROR fail" ); $f->fail( "Did not receive HTTP response from server", http => undef, $req ) unless $f->is_cancelled; $self->close_now; } unless( $$buffref =~ s/^(.*?$CRLF$CRLF)//s ) { if( $closed ) { $self->debug_printf( "ERROR closed" ); $f->fail( "Connection closed while awaiting header", http => undef, $req ) unless $f->is_cancelled; $self->close_now; } return 0; } $ctx->resp_bytes += $+[0]; my $header = HTTP::Response->parse( $1 ); # HTTP::Response doesn't strip the \rs from this ( my $status_line = $header->status_line ) =~ s/\r$//; $ctx->resp_header = $header; unless( HTTP_MESSAGE_TRIMS_LWS ) { my @headers; $header->scan( sub { my ( $name, $value ) = @_; s/^\s+//, s/\s+$// for $value; push @headers, $name => $value; } ); $header->header( @headers ) if @headers; } my $protocol = $header->protocol; if( $protocol =~ m{^HTTP/1\.(\d+)$} and $1 >= 1 ) { $self->{can_pipeline} = 1; } if( $header->code =~ m/^1/ ) { # 1xx is not a final response $self->debug_printf( "HEADER [provisional] %s", $status_line ); $write_request_body->( $self ) if $write_request_body; return 1; } $header->request( $req ); $header->previous( $previous_response ) if $previous_response; $self->debug_printf( "HEADER %s", $status_line ); my $on_body_chunk = $on_header->( $header ); my $code = $header->code; my $content_encoding = $header->header( "Content-Encoding" ); my $decoder; if( $content_encoding and $decoder = Net::Async::HTTP->can_decode( $content_encoding ) ) { $header->init_header( "X-Original-Content-Encoding" => $header->remove_header( "Content-Encoding" ) ); } # can_pipeline is set for HTTP/1.1 or above; presume it can keep-alive if set my $connection_close = lc( $header->header( "Connection" ) || ( $self->{can_pipeline} ? "keep-alive" : "close" ) ) eq "close"; if( $connection_close ) { $self->{max_in_flight} = 1; } elsif( defined( my $keep_alive = lc( $header->header("Keep-Alive") || "" ) ) ) { my ( $max ) = ( $keep_alive =~ m/max=(\d+)/ ); $self->{max_in_flight} = $max if $max && $max < $self->{max_in_flight}; } my $on_more = sub { my ( $chunk ) = @_; if( $decoder and not eval { $chunk = $decoder->( $chunk ); 1 } ) { $self->debug_printf( "ERROR decode failed" ); $f->fail( "Decode error $@", http => undef, $req ); $self->close; return undef; } $on_body_chunk->( $chunk ); return 1; }; my $on_done = sub { my ( $ctx ) = @_; $ctx->is_done++; # TODO: IO::Async probably ought to do this. We need to fire the # on_closed event _before_ calling on_body_chunk, to clear the # connection cache in case another request comes - e.g. HEAD->GET $self->close if $connection_close; my $final; if( $decoder and not eval { $final = $decoder->(); 1 } ) { $self->debug_printf( "ERROR decode failed" ); $f->fail( "Decode error $@", http => undef, $req ); $self->close; return undef; } $on_body_chunk->( $final ) if defined $final and length $final; my $response = $on_body_chunk->(); my $e = eval { $f->done( $response ) unless $f->is_cancelled; 1 } ? undef : $@; $ctx->on_done->( $ctx ) if $ctx->on_done; $self->{requests_in_flight}--; $self->debug_printf( "DONE remaining in-flight=$self->{requests_in_flight}" ); $self->ready; if( defined $e ) { chomp $e; $self->invoke_error( $e, perl => ); # This might not return, if it top-level croaks } return undef; # Finished }; # RFC 2616 says "HEAD" does not have a body, nor do any 1xx codes, nor # 204 (No Content) nor 304 (Not Modified) if( $req->method eq "HEAD" or $code =~ m/^1..$/ or $code eq "204" or $code eq "304" ) { $self->debug_printf( "BODY done [none]" ); return $on_done->( $ctx ); } my $transfer_encoding = $header->header( "Transfer-Encoding" ); my $content_length = $header->content_length; if( defined $transfer_encoding and $transfer_encoding eq "chunked" ) { $self->debug_printf( "BODY chunks" ); $stall_timer->reason = "receiving body chunks" if $stall_timer; return $self->_mk_on_read_chunked( $on_more, $on_done ); } elsif( defined $content_length ) { $self->debug_printf( "BODY length $content_length" ); if( $content_length == 0 ) { $self->debug_printf( "BODY done [length=0]" ); return $on_done->( $ctx ); } $stall_timer->reason = "receiving body" if $stall_timer; return $self->_mk_on_read_length( $content_length, $on_more, $on_done ); } else { $self->debug_printf( "BODY until EOF" ); $stall_timer->reason = "receiving body until EOF" if $stall_timer; return $self->_mk_on_read_until_eof( $on_more, $on_done ); } }; } sub _mk_on_read_chunked { shift; # $self my ( $on_more, $on_done ) = @_; my $chunk_length; sub { my ( $self, $buffref, $closed, $ctx ) = @_; my $req = $ctx->req; my $f = $ctx->f; if( !defined $chunk_length and $$buffref =~ s/^(.*?)$CRLF// ) { my $header = $1; $ctx->resp_bytes += $+[0]; # Chunk header unless( $header =~ s/^([A-Fa-f0-9]+).*// ) { $f->fail( "Corrupted chunk header", http => undef, $req ) unless $f->is_cancelled; $self->close_now; return 0; } $chunk_length = hex( $1 ); return 1 if $chunk_length; return $self->_mk_on_read_chunk_trailer( $req, $on_more, $on_done, $f ); } # Chunk is followed by a CRLF, which isn't counted in the length; if( defined $chunk_length and length( $$buffref ) >= $chunk_length + 2 ) { # Chunk body my $chunk = substr( $$buffref, 0, $chunk_length, "" ); $ctx->resp_bytes += length $chunk; unless( $$buffref =~ s/^$CRLF// ) { $self->debug_printf( "ERROR chunk without CRLF" ); $f->fail( "Chunk of size $chunk_length wasn't followed by CRLF", http => undef, $req ) unless $f->is_cancelled; $self->close; } $ctx->resp_bytes += $+[0]; undef $chunk_length; return $on_more->( $chunk ); } if( $closed ) { $self->debug_printf( "ERROR closed" ); $f->fail( "Connection closed while awaiting chunk", http => undef, $req ) unless $f->is_cancelled; } return 0; }; } sub _mk_on_read_chunk_trailer { shift; # $self my ( undef, $on_more, $on_done ) = @_; my $trailer = ""; sub { my ( $self, $buffref, $closed, $ctx ) = @_; my $req = $ctx->req; my $f = $ctx->f; if( $closed ) { $self->debug_printf( "ERROR closed" ); $f->fail( "Connection closed while awaiting chunk trailer", http => undef, $req ) unless $f->is_cancelled; } $$buffref =~ s/^(.*)$CRLF// or return 0; $trailer .= $1; $ctx->resp_bytes += $+[0]; return 1 if length $1; # TODO: Actually use the trailer $self->debug_printf( "BODY done [chunked]" ); return $on_done->( $ctx ); }; } sub _mk_on_read_length { shift; # $self my ( $content_length, $on_more, $on_done ) = @_; sub { my ( $self, $buffref, $closed, $ctx ) = @_; my $req = $ctx->req; my $f = $ctx->f; # This will truncate it if the server provided too much my $content = substr( $$buffref, 0, $content_length, "" ); $content_length -= length $content; $ctx->resp_bytes += length $content; return undef unless $on_more->( $content ); if( $content_length == 0 ) { $self->debug_printf( "BODY done [length]" ); return $on_done->( $ctx ); } if( $closed ) { $self->debug_printf( "ERROR closed" ); $f->fail( "Connection closed while awaiting body", http => undef, $req ) unless $f->is_cancelled; } return 0; }; } sub _mk_on_read_until_eof { shift; # $self my ( $on_more, $on_done ) = @_; sub { my ( $self, $buffref, $closed, $ctx ) = @_; my $content = $$buffref; $$buffref = ""; $ctx->resp_bytes += length $content; return undef unless $on_more->( $content ); return 0 unless $closed; $self->debug_printf( "BODY done [eof]" ); return $on_done->( $ctx ); }; } =head1 AUTHOR Paul Evans =cut 0x55AA; Net-Async-HTTP-0.48/lib/Net/Async/HTTP/StallTimer.pm000444001750001750 127014021530440 20440 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2014 -- leonerd@leonerd.org.uk package Net::Async::HTTP::StallTimer; use strict; use warnings; use base qw( IO::Async::Timer::Countdown ); our $VERSION = '0.48'; sub _init { my $self = shift; my ( $params ) = @_; $self->SUPER::_init( $params ); $self->{future} = delete $params->{future}; } sub reason :lvalue { shift->{stall_reason} } sub on_expire { my $self = shift; my $conn = $self->parent; $self->{future}->fail( "Stalled while ${\$self->reason}", stall_timeout => ); $conn->close_now; } 0x55AA; Net-Async-HTTP-0.48/t000755001750001750 014021530440 13000 5ustar00leoleo000000000000Net-Async-HTTP-0.48/t/00use.t000444001750001750 15214021530440 14234 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use_ok( "Net::Async::HTTP" ); done_testing; Net-Async-HTTP-0.48/t/01request.t000444001750001750 3747514021530440 15213 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Identity; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); ok( defined $http, 'defined $http' ); isa_ok( $http, "Net::Async::HTTP", '$http isa Net::Async::HTTP' ); $loop->add( $http ); my $hostnum = 0; sub do_test_req { my $name = shift; my %args = @_; my $response; my $error; my $request = $args{req}; my $host = $args{no_host} ? $request->uri->host : $http->{proxy_host} || "host$hostnum"; $hostnum++; my $service = $http->{proxy_port} || 80; my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq $host or die "Expected $args{host} eq $host"; $args{service} eq $service or die "Expected $args{service} eq $service"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $future = $http->do_request( request => $request, ( $args{no_host} ? () : ( host => $host ) ), timeout => 10, on_response => sub { $response = $_[0] }, on_error => sub { $error = $_[0] }, ); $future->on_fail( sub { $future->get } ) unless $args{expect_error}; ok( defined $future, "\$future defined for $name" ); wait_for { $peersock }; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; my $req_firstline = $1; is( $req_firstline, $args{expect_req_firstline}, "First line for $name" ); $request_stream =~ s/^(.*)$CRLF$CRLF//s; my %req_headers = map { m/^([^:]+):\s+(.*)$/g } split( m/$CRLF/, $1 ); my $req_content; if( defined( my $len = $req_headers{'Content-Length'} ) ) { wait_for { length( $request_stream ) >= $len }; $req_content = substr( $request_stream, 0, $len ); substr( $request_stream, 0, $len ) = ""; } my $expect_req_headers = $args{expect_req_headers}; foreach my $header ( keys %$expect_req_headers ) { is( $req_headers{$header}, $expect_req_headers->{$header}, "Expected value for $header" ); } if( defined $args{expect_req_content} ) { is( $req_content, $args{expect_req_content}, "Request content for $name" ); } $peersock->syswrite( $args{response} ); $peersock->close if $args{close_after_response}; # Future shouldn't be ready yet ok( !$future->is_ready, "\$future is not ready before response given for $name" ); # Wait for the server to finish its response wait_for { defined $response or defined $error }; if( $args{expect_error} ) { ok( defined $error, "Expected error for $name" ); return; } else { ok( !defined $error, "Failed to error for $name" ); if( defined $error ) { diag( "Got error $error" ); } } identical( $response->request, $request, "\$response->request is \$request for $name" ); ok( $future->is_ready, "\$future is now ready after response given for $name" ); identical( scalar $future->get, $response, "\$future->get yields \$response for $name" ); if( exists $args{expect_res_code} ) { is( $response->code, $args{expect_res_code}, "Result code for $name" ); } if( exists $args{expect_res_content} ) { is( $response->content, $args{expect_res_content}, "Result content for $name" ); } if( exists $args{expect_res_headers} ) { my %h = map { $_ => $response->header( $_ ) } $response->header_field_names; is_deeply( \%h, $args{expect_res_headers}, "Result headers for $name" ); } } my $req; $req = HTTP::Request->new( HEAD => "/some/path", [ Host => "myhost" ] ); do_test_req( "simple HEAD", req => $req, expect_req_firstline => "HEAD /some/path HTTP/1.1", expect_req_headers => { Host => "myhost", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 13$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: keep-alive$CRLF" . $CRLF, expect_res_code => 200, expect_res_headers => { 'Content-Length' => 13, 'Content-Type' => "text/plain", 'Connection' => "keep-alive", }, expect_res_content => "", ); $req = HTTP::Request->new( GET => "/some/path", [ Host => "myhost" ] ); do_test_req( "simple GET", req => $req, host => "myhost", expect_req_firstline => "GET /some/path HTTP/1.1", expect_req_headers => { Host => "myhost", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 13$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "Hello, world!", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 13, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "Hello, world!", ); $req = HTTP::Request->new( GET => "http://myhost/some/path" ); do_test_req( "GET to full URL", req => $req, host => "myhost", expect_req_firstline => "GET /some/path HTTP/1.1", expect_req_headers => { Host => "myhost", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 13$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "Hello, world!", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 13, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "Hello, world!", ); { $http->configure( proxy_host => 'proxyhost', proxy_port => 3128 ); do_test_req( "GET over proxy", req => $req, host => "myhost", expect_req_firstline => "GET http://myhost/some/path HTTP/1.1", expect_req_headers => { Host => "myhost", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 13$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "Hello, world!", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 13, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "Hello, world!", ); $http->configure( proxy_host => undef, proxy_port => undef ); } $req = HTTP::Request->new( GET => "/empty", [ Host => "myhost" ] ); do_test_req( "GET with empty body", req => $req, host => "myhost", expect_req_firstline => "GET /empty HTTP/1.1", expect_req_headers => { Host => "myhost", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF, expect_res_code => 200, expect_res_headers => { 'Content-Length' => 0, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "", ); $req = HTTP::Request->new( GET => "/" ); do_test_req( "GET with no response headers", req => $req, host => "myhost", expect_req_firstline => "GET / HTTP/1.1", expect_req_headers => { Host => "myhost", }, response => "HTTP/1.0 200 OK$CRLF". $CRLF . "Your data here", close_after_response => 1, expect_res_code => 200, expect_req_headers => {}, expect_res_content => "Your data here", ); $req = HTTP::Request->new( GET => "/somethingmissing", [ Host => "somewhere" ] ); do_test_req( "GET not found", req => $req, host => "somewhere", expect_req_firstline => "GET /somethingmissing HTTP/1.1", expect_req_headers => { Host => "somewhere", }, response => "HTTP/1.1 404 Not Found$CRLF" . "Content-Length: 0$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF, expect_res_code => 404, expect_res_headers => { 'Content-Length' => 0, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "", ); $req = HTTP::Request->new( GET => "/stream", [ Host => "somewhere" ] ); do_test_req( "GET chunks", req => $req, host => "somewhere", expect_req_firstline => "GET /stream HTTP/1.1", expect_req_headers => { Host => "somewhere", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 13$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . "Transfer-Encoding: chunked$CRLF" . $CRLF . "7$CRLF" . "Hello, " . $CRLF . # Handle trailing whitespace on chunk size "6 $CRLF" . "world!" . $CRLF . "0$CRLF" . "$CRLF", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 13, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", 'Transfer-Encoding' => "chunked", }, expect_res_content => "Hello, world!", ); do_test_req( "GET chunks LWS stripping", req => $req, host => "somewhere", expect_req_firstline => "GET /stream HTTP/1.1", expect_req_headers => { Host => "somewhere", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 13$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . "Transfer-Encoding: chunked $CRLF" . $CRLF . "7$CRLF" . "Hello, " . $CRLF . "6$CRLF" . "world!" . $CRLF . "0$CRLF" . "$CRLF", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 13, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", 'Transfer-Encoding' => "chunked", }, expect_res_content => "Hello, world!", ); do_test_req( "GET chunks corrupted", req => $req, host => "somewhere", expect_req_firstline => "GET /stream HTTP/1.1", expect_req_headers => { Host => "somewhere", }, response => "HTTP/1.1 500 Internal Server Error$CRLF" . "Content-Length: 21$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . "Transfer-Encoding: chunked$CRLF" . $CRLF . "Internal Server Error" . $CRLF, # no chunk header close_after_response => 1, expect_error => 1, ); $req = HTTP::Request->new( GET => "/untileof", [ Host => "somewhere" ] ); do_test_req( "GET unspecified length", req => $req, host => "somewhere", expect_req_firstline => "GET /untileof HTTP/1.1", expect_req_headers => { Host => "somewhere", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: close$CRLF" . $CRLF . "Some more content here", close_after_response => 1, expect_res_code => 200, expect_res_headers => { 'Content-Type' => "text/plain", 'Connection' => "close", }, expect_res_content => "Some more content here", ); do_test_req( "GET unspecified length LWS stripping", req => $req, host => "somewhere", expect_req_firstline => "GET /untileof HTTP/1.1", expect_req_headers => { Host => "somewhere", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: close $CRLF" . $CRLF . "Some more content here", close_after_response => 1, expect_res_code => 200, expect_res_headers => { 'Content-Type' => "text/plain", 'Connection' => "close", }, expect_res_content => "Some more content here", ); $req = HTTP::Request->new( POST => "/handler", [ Host => "somewhere" ], "New content" ); do_test_req( "simple POST", req => $req, host => "somewhere", expect_req_firstline => "POST /handler HTTP/1.1", expect_req_headers => { Host => "somewhere", 'Content-Length' => 11, }, expect_req_content => "New content", response => "HTTP/1.1 201 Created$CRLF" . "Content-Length: 11$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "New content", expect_res_code => 201, expect_res_headers => { 'Content-Length' => 11, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "New content", ); $req = HTTP::Request->new( PUT => "/handler", [ Host => "somewhere" ], "New content" ); do_test_req( "simple PUT", req => $req, host => "somewhere", expect_req_firstline => "PUT /handler HTTP/1.1", expect_req_headers => { Host => "somewhere", 'Content-Length' => 11, }, expect_req_content => "New content", response => "HTTP/1.1 201 Created$CRLF" . "Content-Length: 0$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF, expect_res_code => 201, expect_res_headers => { 'Content-Length' => 0, 'Connection' => "Keep-Alive", }, ); $req = HTTP::Request->new( PATCH => "/handler", [ Host => "somewhere" ], "New content" ); do_test_req( "simple PATCH", req => $req, host => "somewhere", expect_req_firstline => "PATCH /handler HTTP/1.1", expect_req_headers => { Host => "somewhere", 'Content-Length' => 11, }, expect_req_content => "New content", response => "HTTP/1.1 201 Created$CRLF" . "Content-Length: 0$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF, expect_res_code => 201, expect_res_headers => { 'Content-Length' => 0, 'Connection' => "Keep-Alive", }, ); $req = HTTP::Request->new( GET => "http://somehost/with/path" ); do_test_req( "request-implied host", req => $req, no_host => 1, expect_req_firstline => "GET /with/path HTTP/1.1", expect_req_headers => { Host => "somehost", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 2$CRLF" . "Content-Type: text/plain$CRLF" . $CRLF . "OK", expect_res_code => 200, ); $req = HTTP::Request->new( GET => "http://user:pass\@somehost2/with/secret" ); do_test_req( "request-implied authentication", req => $req, no_host => 1, expect_req_firstline => "GET /with/secret HTTP/1.1", expect_req_headers => { Host => "somehost2", Authorization => "Basic dXNlcjpwYXNz", # determined using 'wget' }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 4$CRLF" . "Content-Type: text/plain$CRLF" . $CRLF . "Booo", expect_res_code => 200, ); $req = HTTP::Request->new( GET => "/", [ Host => "myhost" ] ); do_test_req( "Non-HTTP response", req => $req, host => "myhost", expect_req_firstline => "GET / HTTP/1.1", expect_req_headers => { Host => "myhost", }, response => "Some other protocol, sorry\n", expect_error => 1, ); do_test_req( "Non-canonical header", req => HTTP::Request->new( GET => "/", [ ":other_hdr" => "value" ] ), host => "myhost", expect_req_firstline => "GET / HTTP/1.1", expect_req_headers => { other_hdr => "value", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF, expect_res_code => 200, ); done_testing; Net-Async-HTTP-0.48/t/02uri.t000444001750001750 2533614021530440 14314 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); # Most of this function copypasted from t/01http-req.t sub do_test_uri { my $name = shift; my %args = @_; my $response; my $error; my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; $http->do_request( uri => $args{uri}, method => $args{method}, user => $args{user}, pass => $args{pass}, headers => $args{headers}, content => $args{content}, content_type => $args{content_type}, on_response => sub { $response = $_[0] }, on_error => sub { $error = $_[0] }, ); wait_for { $peersock }; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; my $req_firstline = $1; is( $req_firstline, $args{expect_req_firstline}, "First line for $name" ); $request_stream =~ s/^(.*)$CRLF$CRLF//s; my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); my $req_content; if( defined( my $len = $req_headers{'Content-Length'} ) ) { wait_for { length( $request_stream ) >= $len }; $req_content = substr( $request_stream, 0, $len ); substr( $request_stream, 0, $len ) = ""; } my $expect_req_headers = $args{expect_req_headers}; foreach my $header ( keys %$expect_req_headers ) { is( $req_headers{$header}, $expect_req_headers->{$header}, "Expected value for $header" ); } if( defined $args{expect_req_content} ) { is( $req_content, $args{expect_req_content}, "Request content for $name" ); } $peersock->syswrite( $args{response} ); # Wait for the server to finish its response wait_for { defined $response or defined $error }; if( $args{expect_error} ) { ok( defined $error, "Expected error for $name" ); return; } else { ok( !defined $error, "Failed to error for $name" ); if( defined $error ) { diag( "Got error $error" ); } } if( exists $args{expect_res_code} ) { is( $response->code, $args{expect_res_code}, "Result code for $name" ); } if( exists $args{expect_res_content} ) { is( $response->content, $args{expect_res_content}, "Result content for $name" ); } if( exists $args{expect_res_headers} ) { my %h = map { $_ => $response->header( $_ ) } $response->header_field_names; is_deeply( \%h, $args{expect_res_headers}, "Result headers for $name" ); } } do_test_uri( "simple HEAD", method => "HEAD", uri => URI->new( "http://host0/some/path" ), expect_req_firstline => "HEAD /some/path HTTP/1.1", expect_req_headers => { Host => "host0", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 13$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF, expect_res_code => 200, expect_res_headers => { 'Content-Length' => 13, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "", ); do_test_uri( "simple GET", method => "GET", uri => URI->new( "http://host1/some/path" ), expect_req_firstline => "GET /some/path HTTP/1.1", expect_req_headers => { Host => "host1", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 13$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "Hello, world!", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 13, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "Hello, world!", ); do_test_uri( "GET with params", method => "GET", uri => URI->new( "http://host2/cgi?param=value" ), expect_req_firstline => "GET /cgi?param=value HTTP/1.1", expect_req_headers => { Host => "host2", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 11$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "CGI content", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 11, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "CGI content", ); do_test_uri( "authenticated GET", method => "GET", uri => URI->new( "http://host3/secret" ), user => "user", pass => "pass", expect_req_firstline => "GET /secret HTTP/1.1", expect_req_headers => { Host => "host3", Authorization => "Basic dXNlcjpwYXNz", # determined using 'wget' }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 18$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "For your eyes only", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 18, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "For your eyes only", ); do_test_uri( "authenticated GET (URL embedded)", method => "GET", uri => URI->new( "http://user:pass\@host4/private" ), expect_req_firstline => "GET /private HTTP/1.1", expect_req_headers => { Host => "host4", Authorization => "Basic dXNlcjpwYXNz", # determined using 'wget' }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 6$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "Shhhh!", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 6, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "Shhhh!", ); do_test_uri( "GET with additional headers from ARRAY", method => "GET", uri => URI->new( "http://host5/" ), headers => [ "X-Net-Async-HTTP", "Test", ], expect_req_firstline => "GET / HTTP/1.1", expect_req_headers => { Host => "host5", "X-Net-Async-HTTP" => "Test", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF, expect_res_code => 200, ); do_test_uri( "GET with additional headers from HASH", method => "GET", uri => URI->new( "http://host6/" ), headers => { "X-Net-Async-HTTP", "Test", }, expect_req_firstline => "GET / HTTP/1.1", expect_req_headers => { Host => "host6", "X-Net-Async-HTTP" => "Test", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF, expect_res_code => 200, ); do_test_uri( "simple PUT", method => "PUT", uri => URI->new( "http://host7/resource" ), content => "The content", content_type => "text/plain", expect_req_firstline => "PUT /resource HTTP/1.1", expect_req_headers => { Host => "host7", 'Content-Length' => 11, 'Content-Type' => "text/plain", }, expect_req_content => "The content", response => "HTTP/1.1 201 Created$CRLF" . "Content-Length: 0$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF, expect_res_code => 201, expect_res_headers => { 'Content-Length' => 0, 'Connection' => "Keep-Alive", }, ); do_test_uri( "simple POST", method => "POST", uri => URI->new( "http://host8/handler" ), content => "New content", content_type => "text/plain", expect_req_firstline => "POST /handler HTTP/1.1", expect_req_headers => { Host => "host8", 'Content-Length' => 11, 'Content-Type' => "text/plain", }, expect_req_content => "New content", response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 11$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "New content", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 11, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "New content", ); do_test_uri( "form POST", method => "POST", uri => URI->new( "http://host9/handler" ), content => [ param => "value", another => "value with things" ], expect_req_firstline => "POST /handler HTTP/1.1", expect_req_headers => { Host => "host9", 'Content-Length' => 37, 'Content-Type' => "application/x-www-form-urlencoded", }, expect_req_content => "param=value&another=value+with+things", response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 4$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF . "Done", expect_res_code => 200, expect_res_headers => { 'Content-Length' => 4, 'Content-Type' => "text/plain", 'Connection' => "Keep-Alive", }, expect_res_content => "Done", ); do_test_uri( "plain string URI", method => "GET", uri => "http://host10/path", expect_req_firstline => "GET /path HTTP/1.1", expect_req_headers => { Host => "host10", }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . "$CRLF", expect_res_code => 200, ); do_test_uri( "simple PATCH", method => "PATCH", uri => URI->new( "http://host11/resource" ), content => "The content", content_type => "text/plain", expect_req_firstline => "PATCH /resource HTTP/1.1", expect_req_headers => { Host => "host11", 'Content-Length' => 11, 'Content-Type' => "text/plain", }, expect_req_content => "The content", response => "HTTP/1.1 201 Created$CRLF" . "Content-Length: 0$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF, expect_res_code => 201, expect_res_headers => { 'Content-Length' => 0, 'Connection' => "Keep-Alive", }, ); done_testing; Net-Async-HTTP-0.48/t/03future.t000444001750001750 474614021530440 15012 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); { my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $request = HTTP::Request->new( GET => "/some/path", [ Host => "myhost" ] ); my $future = $http->do_request( host => "myhost", request => $request, ); ok( defined $future, '$future defined for request' ); wait_for { $peersock }; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( join( $CRLF, "HTTP/1.1 200 OK", "Content-Type: text/plain", "Content-Length: 12", "" ) . $CRLF . "Hello world!" ); my $response = wait_for_future( $future )->get; isa_ok( $response, "HTTP::Response", '$future->get for request' ); is( $response->code, 200, '$response->code for request' ); } { my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $future = $http->do_request( method => "GET", uri => URI->new( "http://host0/some/path" ), ); ok( defined $future, '$future defined for uri' ); wait_for { $peersock }; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( join( $CRLF, "HTTP/1.1 200 OK", "Content-Type: text/plain", "Content-Length: 12", "" ) . $CRLF . "Hello world!" ); my $response = wait_for_future( $future )->get; isa_ok( $response, "HTTP::Response", '$future->get for uri' ); is( $response->code, 200, '$response->code for uri' ); } done_testing; Net-Async-HTTP-0.48/t/04fail.t000444001750001750 1113514021530440 14422 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; # fail_on_error false { $http->configure( fail_on_error => 0 ); my $request = HTTP::Request->new( GET => "/some/path", [ Host => "myhost" ] ); my $future = $http->do_request( method => "GET", uri => URI->new( "http://host0/some/path" ), ); ok( defined $future, '$future defined for request' ); wait_for { $peersock }; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( join( $CRLF, "HTTP/1.1 404 Not Found", "Content-Type: text/plain", "Content-Length: 9", "" ) . $CRLF . "Not Found" ); my $response = wait_for_future( $future )->get; isa_ok( $response, "HTTP::Response", '$future->get for fail_on_error false' ); is( $response->code, 404, '$response->code for fail_on_error false' ); } # fail_on_error true { $http->configure( fail_on_error => 1 ); my $request = HTTP::Request->new( GET => "/some/path", [ Host => "myhost" ] ); my ( $response_c, $request_c ); my $future = $http->do_request( method => "GET", uri => URI->new( "http://host0/some/path" ), on_error => sub { ( my $message, $response_c, $request_c ) = @_; is( $message, "404 Not Found", '$message to on_error' ); }, ); ok( defined $future, '$future defined for request' ); wait_for { $peersock }; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( join( $CRLF, "HTTP/1.1 404 Not Found", "Content-Type: text/plain", "Content-Length: 9", "" ) . $CRLF . "Not Found" ); wait_for_future( $future ); is( scalar $future->failure, "404 Not Found", '$future->failure for fail_on_error true' ); my ( undef, undef, $response_f, $request_f ) = $future->failure; is( $response_f->code, 404, '$response_f->code for fail_on_error true' ); is( $response_c->code, 404, '$response_c->code for fail_on_error true' ); is( $request_f->uri, "http://host0/some/path", '$request_f->uri for fail_on_error true' ); is( $request_c->uri, "http://host0/some/path", '$request_f->uri for fail_on_error true' ); # Now check that non-errors don't fail $future = $http->do_request( method => "GET", uri => URI->new( "http://host0/other/path" ), ); $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( join( $CRLF, "HTTP/1.1 200 OK", "Content-Type: text/plain", "Content-Length: 9", "" ) . $CRLF . "Here I am" ); my $response = wait_for_future( $future )->get; is( $response->code, 200, '$response->code for non-fail' ); } # fail_on_error non-Future (RT102022) { $http->configure( fail_on_error => 1 ); my $request = HTTP::Request->new( GET => "/some/path", [ Host => "myhost" ] ); my ( $response_c, $request_c ); $http->do_request( method => "GET", uri => URI->new( "http://host0/some/path" ), on_response => sub { die "Test failed - on_response with $_[0]"; }, on_error => sub { ( my $message, $response_c, $request_c ) = @_; is( $message, "404 Not Found", '$message to on_error' ); }, ); wait_for { $peersock }; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( join( $CRLF, "HTTP/1.1 404 Not Found", "Content-Type: text/plain", "Content-Length: 9", "" ) . $CRLF . "Not Found" ); wait_for { defined $response_c }; is( $response_c->code, 404, '$response_c->code for fail_on_error true' ); is( $request_c->uri, "http://host0/some/path", '$request_f->uri for fail_on_error true' ); } done_testing; Net-Async-HTTP-0.48/t/05redir.t000444001750001750 1673314021530440 14626 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Identity; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); { my $redir_response; my $location; my $response; my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "host0" or die "Expected $args{host} eq host0"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $future = $http->do_request( uri => URI->new( "http://host0/doc" ), timeout => 10, on_response => sub { $response = $_[0] }, on_redirect => sub { ( $redir_response, $location ) = @_ }, on_error => sub { die "Test died early - $_[0]" }, ); ok( defined $future, '$future defined for redirect' ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; my $req_firstline = $1; is( $req_firstline, "GET /doc HTTP/1.1", 'First line for request' ); # Trim headers $request_stream =~ s/^(.*)$CRLF$CRLF//s; $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: http://host0/get_doc?name=doc$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" ); wait_for { defined $location }; is( $location, "http://host0/get_doc?name=doc", 'Redirect happens' ); ok( !$future->is_ready, '$future is not yet ready after redirect' ); $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; $req_firstline = $1; is( $req_firstline, "GET /get_doc?name=doc HTTP/1.1", 'First line for redirected request' ); # Trim headers $request_stream =~ s/^(.*)$CRLF$CRLF//s; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 8$CRLF". "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" . "Document" ); wait_for { defined $response }; is( $response->content_type, "text/plain", 'Content type of final response' ); is( $response->content, "Document", 'Content of final response' ); isa_ok( $response->previous, "HTTP::Response", '$response->previous' ); my $previous = $response->previous; isa_ok( $previous->request->uri, "URI", 'Previous request URI is a URI' ); is( $previous->request->uri, "http://host0/doc", 'Previous request URI string' ); ok( $future->is_ready, '$future is now ready for final response' ); identical( scalar $future->get, $response, '$future->get yields final response' ); } { my $redir_response; my $location; my $response; my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "host1" or die "Expected $args{host} eq host1"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; $http->do_request( uri => URI->new( "http://host1/somedir" ), timeout => 10, on_response => sub { $response = $_[0] }, on_redirect => sub { ( $redir_response, $location ) = @_ }, on_error => sub { die "Test died early - $_[0]" }, ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; my $req_firstline = $1; is( $req_firstline, "GET /somedir HTTP/1.1", 'First line for request for local redirect' ); # Trim headers $request_stream =~ s/^(.*)$CRLF$CRLF//s; $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: /somedir/$CRLF" . "$CRLF" ); undef $location; wait_for { defined $location }; is( $location, "http://host1/somedir/", 'Local redirect happens' ); $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; $req_firstline = $1; is( $req_firstline, "GET /somedir/ HTTP/1.1", 'First line for locally redirected request' ); # Trim headers $request_stream =~ s/^(.*)$CRLF$CRLF//s; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 9$CRLF". "Content-Type: text/plain$CRLF" . "$CRLF" . "Directory" ); undef $response; wait_for { defined $response }; is( $response->content_type, "text/plain", 'Content type of final response to local redirect' ); is( $response->content, "Directory", 'Content of final response to local redirect' ); } # 304 Not Modified should not redirect (RT98093) { my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "host2" or die "Expected $args{host} eq host2"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $f = $http->do_request( uri => URI->new( "http://host2/unmod" ), on_redirect => sub { die "Should not be redirected" }, ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 304 Not Modified$CRLF" . $CRLF ); # 304 has no body my $response = wait_for_future( $f )->get; is( $response->code, 304, 'HTTP 304 response not redirected' ); } # Methods other than GET and HEAD should not redirect { my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "host3" or die "Expected $args{host} eq host3"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $f = $http->do_request( method => "PUT", uri => URI->new( "http://host3/somewhere" ), content => "new content", content_type => "text/plain", on_redirect => sub { die "Should not be redirected" }, ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: /somewhere/else$CRLF" . $CRLF ); my $response = wait_for_future( $f )->get; is( $response->code, 301, 'POST request not redirected' ); } done_testing; Net-Async-HTTP-0.48/t/06close.t000444001750001750 551614021530440 14604 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; $SIG{PIPE} = "IGNORE"; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new; $loop->add( $http ); my $host = "host.example"; my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq $host or die "Expected $args{host} eq $host"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; # HTTP/1.1 pipelining - if server closes after first request, others should fail { my @f = map { $http->do_request( request => HTTP::Request->new( GET => "/$_", [ Host => $host ] ), host => $host, ) } 1 .. 3; my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream = ""; $peersock->print( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); wait_for_future( $f[0] ); ok( !$f[0]->failure, 'First request succeeds before EOF' ); $peersock->close; wait_for_future( $f[1] ); ok( $f[1]->failure, 'Second request fails after EOF' ); # Not sure which error will happen like( scalar $f[1]->failure, qr/^Connection closed($| while awaiting header)/, 'Queued request gets connection closed error' ); wait_for_future( $f[2] ); ok( $f[2]->failure ); } # HTTP/1.0 connection: close behaviour. second request should get written { my @f = map { $http->do_request( request => HTTP::Request->new( GET => "/$_", [ Host => $host ] ), host => $host, ) } 1 .. 2; my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream = ""; $peersock->print( "HTTP/1.0 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . $CRLF . "Hello " ); $peersock->close; undef $peersock; wait_for_future( $f[0] ); ok( !$f[0]->failure, 'First request succeeds after HTTP/1.0 EOF' ); wait_for { defined $peersock }; ok( defined $peersock, 'A second connection is made' ); wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->print( "HTTP/1.0 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . $CRLF . "World!" ); $peersock->close; undef $peersock; wait_for_future( $f[1] ); ok( !$f[1]->failure, 'Second request succeeds after second HTTP/1.0 EOF' ); } done_testing; Net-Async-HTTP-0.48/t/07continue.t000444001750001750 365514021530440 15326 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; $SIG{PIPE} = "IGNORE"; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new; $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "host0" or die "Expected $args{host} eq host0"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $body_sent; my $resp; $http->do_request( method => "PUT", uri => URI->new( "http://host0/" ), expect_continue => 1, content_type => "text/plain", request_body => sub { return undef if $body_sent; $body_sent++; return "Here is the body content\n"; }, on_response => sub { $resp = shift }, on_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $peersock }; my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*?$CRLF$CRLF)//s; my $header = HTTP::Request->parse( $1 ); is( $header->header( "Expect" ), "100-continue", 'Received Expect header' ); ok( !$body_sent, 'request_body not yet invoked before 100 Continue' ); $peersock->print( "HTTP/1.1 100 Continue$CRLF" . $CRLF ); wait_for { $body_sent }; ok( !defined $resp, '$resp not yet defined after 100 Continue' ); $peersock->print( "HTTP/1.1 201 Created$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); wait_for { defined $resp }; ok( defined $resp, '$resp now defined after 201 Created' ); is( $resp->code, 201, '$resp->code is 201' ); done_testing; Net-Async-HTTP-0.48/t/08prepareprocess.t000444001750001750 766614021530440 16546 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = TestingHTTP->new( user_agent => "", # Don't put one in request headers ); ok( defined $http, 'defined $http' ); isa_ok( $http, "Net::Async::HTTP", '$http isa Net::Async::HTTP' ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "some.server" or die "Expected $args{host} eq some.server"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $response_header_X; { my $response; $http->do_request( uri => URI->new( "http://some.server/here" ), on_response => sub { $response = $_[0] }, on_error => sub { die "Test died early - $_[0]" }, ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; my $req_firstline = $1; is( $req_firstline, "GET /here HTTP/1.1", 'First line for request' ); # Trim headers $request_stream =~ s/^(.*)$CRLF$CRLF//s; my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); is( $req_headers{"X-Request-Foo"}, "Bar", 'Request sets X-Request-Foo header' ); $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 7$CRLF". "Content-Type: text/plain$CRLF" . "X-Response-Foo: Splot$CRLF" . "$CRLF" . "Blahbla" ); undef $response; wait_for { defined $response }; is( $response_header_X, "Splot", 'Response processed' ); } # 'headers' param { $http->configure( headers => { "X-Another-Header" => 1 } ); my $f = $http->do_request( uri => URI->new( "http://some.server/with-headers" ), ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; # Trim headers $request_stream =~ s/^(.*)$CRLF$CRLF//s; my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); is( $req_headers{"X-Another-Header"}, "1", 'Request sets X-Another-Header' ); $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF". "$CRLF" ); wait_for_future( $f )->get; } # +headers { $http->configure( "+headers" => { "X-More-Added" => 2, "X-Another-Header" => 3, }, ); my $f = $http->do_request( uri => URI->new( "http://some.server/late-header" ), ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; # Trim headers $request_stream =~ s/^(.*)$CRLF$CRLF//s; my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); is( $req_headers{"X-More-Added"}, "2", 'Request sets X-More-Added' ); is( $req_headers{"X-Another-Header"}, "3", 'Request replaces X-Another-Header' ); $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF". "$CRLF" ); wait_for_future( $f )->get; } done_testing; package TestingHTTP; use base qw( Net::Async::HTTP ); sub prepare_request { my $self = shift; my ( $request ) = @_; $self->SUPER::prepare_request( $request ); $request->header( "X-Request-Foo" => "Bar" ); } sub process_response { my $self = shift; my ( $response ) = @_; $self->SUPER::process_response( $response ); $response_header_X = $response->header( "X-Response-Foo" ); } Net-Async-HTTP-0.48/t/09cookies.t000444001750001750 626714021530440 15142 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use HTTP::Cookies; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $cookie_jar = HTTP::Cookies->new; my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers cookie_jar => $cookie_jar, ); $loop->add( $http ); my $peersock; sub do_test_req { my $name = shift; my %args = @_; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "myhost" or die "Expected $args{host} eq myhost"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $response; my $error; my $request = $args{req}; $http->do_request( request => $request, host => "myhost", on_response => sub { $response = $_[0] }, on_error => sub { $error = $_[0] }, ); # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; # Ignore first line $request_stream =~ s/^(.*)$CRLF//; $request_stream =~ s/^(.*)$CRLF$CRLF//s; my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); my $req_content; if( defined( my $len = $req_headers{'Content-Length'} ) ) { wait_for { length( $request_stream ) >= $len }; $req_content = substr( $request_stream, 0, $len ); substr( $request_stream, 0, $len ) = ""; } my $expect_req_headers = $args{expect_req_headers}; foreach my $header ( keys %$expect_req_headers ) { is( $req_headers{$header}, $expect_req_headers->{$header}, "Expected value for $header" ); } $peersock->syswrite( $args{response} ); # Wait for the server to finish its response wait_for { defined $response or defined $error }; my %h = map { $_ => $response->header( $_ ) } $response->header_field_names; is_deeply( \%h, $args{expect_res_headers}, "Result headers for $name" ); } my $req; $req = HTTP::Request->new( GET => "http://myhost/", [ Host => "myhost" ] ); do_test_req( "set cookie", req => $req, expect_req_headers => { Host => "myhost", }, response => "HTTP/1.1 200 OK$CRLF" . "Set-Cookie: X_TEST=MyCookie; path=/$CRLF" . "Content-Length: 0$CRLF" . $CRLF, expect_res_headers => { 'Content-Length' => 0, 'Set-Cookie' => "X_TEST=MyCookie; path=/", }, ); $req = HTTP::Request->new( POST => "http://myhost/", [ Host => "myhost" ] ); do_test_req( "get cookie", req => $req, expect_req_headers => { Host => "myhost", Cookie => "X_TEST=MyCookie", Cookie2 => '$Version="1"', 'Content-Length' => 0, }, response => "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF, expect_res_headers => { 'Content-Length' => 0, }, ); done_testing; Net-Async-HTTP-0.48/t/10request-streaming.t000444001750001750 1002714021530440 17162 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; { my $req = HTTP::Request->new( PUT => "/handler", [ Host => "somewhere" ]); $req->content_length( 21 ); # set this manually based on what we plan to send my $response; my $done = 0; $http->do_request( request => $req, host => "myhost", request_body => sub { if( !$done ) { pass( "Callback after headers sent" ); $done++; return "Content from callback"; } elsif( $done == 1 ) { pass( "Second request seen, returning undef" ); $done++; return undef; } else { fail( "called request_body too many times" ); } }, on_response => sub { $response = $_[0] }, on_error => sub { die "Test died early - $_[0]" }, ); # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; my $req_firstline = $1; is( $req_firstline, "PUT /handler HTTP/1.1", 'First line for streaming PUT' ); $request_stream =~ s/^(.*)$CRLF$CRLF//s; my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); is_deeply( \%req_headers, { 'Host' => "somewhere", 'Content-Length' => 21, 'Connection' => 'keep-alive', }, 'Request headers for streaming PUT' ); my $req_content; if( defined( my $len = $req_headers{'Content-Length'} ) ) { wait_for_stream { length( $request_stream ) >= $len } $peersock => $request_stream; $req_content = substr( $request_stream, 0, $len ); substr( $request_stream, 0, $len ) = ""; } is( $req_content, "Content from callback", 'Request content for streaming PUT' ); $peersock->syswrite( "HTTP/1.1 201 Created$CRLF" . "Content-Length: 0$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF ); wait_for { defined $response }; is( $response->code, 201, 'Result code for streaming PUT' ); my %res_headers = map { $_ => $response->header( $_ ) } $response->header_field_names; is_deeply( \%res_headers, { 'Content-Length' => 0, 'Connection' => "Keep-Alive", }, 'Result headers for streaming PUT' ); } { my $req = HTTP::Request->new( PUT => "/handler", [ Host => "somewhere" ]); $req->content_length( 15 ); my $body_f = $loop->new_future; my $response; $http->do_request( request => $req, request_body => $body_f, host => "myhost", on_response => sub { $response = $_[0] }, on_error => sub { die "Test died early - $_[0]" }, ); # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF$CRLF//s; $body_f->done( "Delayed content" ); wait_for_stream { length $request_stream >= 15 } $peersock => $request_stream; is( $request_stream, "Delayed content" ); $peersock->syswrite( "HTTP/1.1 201 Created$CRLF" . "Content-Length: 0$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF ); wait_for { defined $response }; is( $response->code, 201, 'Result code for streaming PUT from Future' ); } done_testing; Net-Async-HTTP-0.48/t/11response-streaming.t000444001750001750 1342014021530440 17331 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; { my $header; my $body; my $body_is_done; $http->do_request( uri => URI->new( "http://my.server/here" ), on_header => sub { ( $header ) = @_; $body = ""; return sub { @_ ? $body .= $_[0] : $body_is_done++; } }, on_error => sub { die "Test died early - $_[0]" }, ); # Wait for request but don't really care what it actually is my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 15$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" ); wait_for { defined $header }; isa_ok( $header, "HTTP::Response", '$header for Content-Length' ); is( $header->content_length, 15, '$header->content_length' ); is( $header->content_type, "text/plain", '$header->content_type' ); $peersock->syswrite( "Hello, " ); wait_for { length $body == 7 }; is( $body, "Hello, ", '$body partial Content-Length' ); $peersock->syswrite( "world!$CRLF" ); wait_for { $body_is_done }; is( $body, "Hello, world!$CRLF", '$body' ); } { my $header; my $body; my $body_is_done; $http->do_request( uri => URI->new( "http://my.server/here" ), on_header => sub { ( $header ) = @_; $body = ""; return sub { @_ ? $body .= $_[0] : $body_is_done++; } }, on_error => sub { die "Test died early - $_[0]" }, ); # Wait for request but don't really care what it actually is my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 15$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: Keep-Alive$CRLF" . "Transfer-Encoding: chunked$CRLF" . "$CRLF" ); wait_for { defined $header }; isa_ok( $header, "HTTP::Response", '$header for chunked' ); is( $header->content_length, 15, '$header->content_length' ); is( $header->content_type, "text/plain", '$header->content_type' ); $peersock->syswrite( "7$CRLF" . "Hello, " . $CRLF ); wait_for { length $body == 7 }; is( $body, "Hello, ", '$body partial chunked' ); $peersock->syswrite( "8$CRLF" . "world!$CRLF" . $CRLF ); wait_for { length $body == 15 }; is( $body, "Hello, world!$CRLF", '$body partial(2) chunked' ); $peersock->syswrite( "0$CRLF" . $CRLF ); wait_for { $body_is_done }; is( $body, "Hello, world!$CRLF", '$body chunked' ); } { my $header; my $body; my $body_is_done; $http->do_request( uri => URI->new( "http://my.server/here" ), on_header => sub { ( $header ) = @_; $body = ""; return sub { @_ ? $body .= $_[0] : $body_is_done++; } }, on_error => sub { die "Test died early - $_[0]" }, ); # Wait for request but don't really care what it actually is my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.0 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: close$CRLF" . "$CRLF" ); wait_for { defined $header }; isa_ok( $header, "HTTP::Response", '$header for EOF' ); is( $header->content_type, "text/plain", '$header->content_type' ); $peersock->syswrite( "Hello, " ); wait_for { length $body == 7 }; is( $body, "Hello, ", '$body partial EOF' ); $peersock->syswrite( "world!$CRLF" ); wait_for { length $body == 15 }; is( $body, "Hello, world!$CRLF", '$body' ); $peersock->close; wait_for { $body_is_done }; } # on_header should see a redirect once we run out of indirections (RT124920) { my $header; $http->do_request( uri => URI->new( "http://my.server.here/" ), max_redirects => 1, on_header => sub { ( $header ) = @_; return sub {}; }, on_error => sub { die "Test died early - $_[0]" }, ); # Wait for request but don't really care what it actually is my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: http://my.server.here/elsewhere$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" ); $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: http://my.server.here/try-again$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" ); wait_for { defined $header }; } done_testing; Net-Async-HTTP-0.48/t/12conn-persistence.t000444001750001750 1620714021530440 16772 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Identity; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); foreach my $close ( 0, 1, 2 ) { # We'll run an almost-identical test three times, with different server responses. # 0 == keepalive # 1 == close # 2 == close with no Content-Length my $peersock; my $connections = 0; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $connections++; $args{host} eq "host$close" or die "Expected $args{host} eq host$close"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $response; # placate IO::Async bug where this returns () instead of 0 is( scalar $http->children || 0, 0, 'scalar $http->children 0 initially' ); my $future = $http->do_request( uri => URI->new( "http://host$close/first" ), on_response => sub { $response = $_[0] }, on_error => sub { die "Test died early - $_[0]" }, ); ok( defined $future, 'defined $future' ); wait_for { $peersock }; is( $connections, 1, '->connect called once for first request' ); is( scalar $http->children, 1, 'scalar $http->children 1 after first request' ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; my $req_firstline = $1; is( $req_firstline, "GET /first HTTP/1.1", 'First line for first request' ); ok( !$future->is_ready, '$future is not ready before response given' ); $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . ( $close == 2 ? "" : "Content-Length: 3$CRLF" ) . "Content-Type: text/plain$CRLF" . ( $close ? "Connection: close$CRLF" : "Connection: Keep-Alive$CRLF" ) . "$CRLF" . "1st" ); $peersock->close, undef $peersock if $close; undef $response; wait_for { defined $response }; if( $close ) { is( scalar $http->children, 0, 'scalar $http->children now 0 again after first response' ); } else { is( scalar $http->children, 1, 'scalar $http->children still 1 after first response' ); } is( $response->content, "1st", 'Content of first response' ); identical( scalar $future->get, $response, '$future->get for first request' ); my $inner_response; my $inner_future; $future = $http->do_request( uri => URI->new( "http://host$close/second" ), on_response => sub { $response = $_[0]; $inner_future = $http->do_request( uri => URI->new( "http://host$close/inner" ), on_response => sub { $inner_response = $_[0] }, on_error => sub { die "Test died early - $_[0]" }, ); }, on_error => sub { die "Test died early - $_[0]" }, ); wait_for { $peersock }; if( $close ) { is( $connections, 2, '->connect called again for second request to same server' ); } else { is( $connections, 1, '->connect not called again for second request to same server' ); } is( scalar $http->children, 1, 'scalar $http->children 1 after second request to same server' ); $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; $req_firstline = $1; is( $req_firstline, "GET /second HTTP/1.1", 'First line for second request' ); ok( !$future->is_ready, '$future is not ready before response given for second request' ); $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . ( $close == 2 ? "" : "Content-Length: 3$CRLF" ) . "Content-Type: text/plain$CRLF" . ( $close ? "Connection: close$CRLF" : "Connection: Keep-Alive$CRLF" ) . "$CRLF" . "2nd" ); $peersock->close, undef $peersock if $close; undef $response; wait_for { defined $response }; is( $response->content, "2nd", 'Content of second response' ); identical( scalar $future->get, $response, '$future->get for second request' ); ok( defined $inner_future, 'defined $inner_future' ); wait_for { $peersock }; if( $close ) { is( $connections, 3, '->connect called again for inner request to same server' ); } else { is( $connections, 1, '->connect not called again for inner request to same server' ); } $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; $req_firstline = $1; is( $req_firstline, "GET /inner HTTP/1.1", 'First line for inner request' ); $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . ( $close == 2 ? "" : "Content-Length: 3$CRLF" ) . "Content-Type: text/plain$CRLF" . ( $close ? "Connection: close$CRLF" : "Connection: Keep-Alive$CRLF" ) . "$CRLF" . "3rd" ); $peersock->close if $close; undef $inner_response; wait_for { defined $inner_response }; is( $inner_response->content, "3rd", 'Content of inner response' ); identical( scalar $inner_future->get, $inner_response, '$inner_future->get for inner request' ); if( $close ) { is( scalar $http->children, 0, 'scalar $http->children now 0 again after inner response' ); } else { is( scalar $http->children, 1, 'scalar $http->children still 1 after inner response' ); } # Drain connections for next test undef $peersock; wait_for { scalar $http->children == 0 }; } # Check that close_after_request sets close header { my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; $http->configure( close_after_request => 1 ); my $future = $http->do_request( uri => URI->new( "http://host/closed" ), ); wait_for { $peersock }; my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; like( $request_stream, qr/^Connection: close$CRLF/m, 'Request has Connection: close header' ); $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: close$CRLF" . "$CRLF" . "Bye" ); $peersock->close; my $response = wait_for_future( $future )->get; is( $response->content, "Bye", 'Content of response' ); } done_testing; Net-Async-HTTP-0.48/t/13conn-pipeline.t000444001750001750 714614021530440 16236 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $test_mode; # Most of this function copypasted from t/01http-req.t sub do_uris { my %wait; my $wait_id = 0; my $http = Net::Async::HTTP->new( pipeline => not( $test_mode eq "no_pipeline" ) ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; while( my ( $uri, $on_resp ) = splice @_, 0, 2 ) { $wait{$wait_id} = 1; my $id = $wait_id; $http->do_request( uri => $uri, method => 'GET', timeout => 10, on_response => sub { $on_resp->( @_ ); delete $wait{$id} }, on_error => sub { die "Test failed early - $_[-1]" }, ); $wait_id++; } my $request_stream = ""; my $not_first = 0; while( keys %wait ) { # Wait for the client to send its request wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; my $req_firstline = $1; $request_stream =~ s/^(.*?)$CRLF$CRLF//s; my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); if( $test_mode ne "pipeline" ) { is( length $request_stream, 0, "Stream is idle after request for $test_mode" ); } elsif( keys %wait > 1 && $not_first++ ) { # Just in case it wasn't flushed yet, wait for another request to be # written anyway before we respond to this one wait_for_stream { length $request_stream } $peersock => $request_stream; ok( length $request_stream > 0, "Stream is not idle after middle request for $test_mode" ); } my $req_content; if( defined( my $len = $req_headers{'Content-Length'} ) ) { wait_for { length( $request_stream ) >= $len }; $req_content = substr( $request_stream, 0, $len ); substr( $request_stream, 0, $len ) = ""; } my $waitcount = keys %wait; my $body = "$req_firstline"; my $protocol = "HTTP/1.1"; $protocol = "HTTP/1.0" if $test_mode eq "http/1.0"; $peersock->syswrite( "$protocol 200 OK$CRLF" . "Content-Length: " . length( $body ) . $CRLF . "Connection: Keep-Alive$CRLF" . $CRLF . $body ); # Wait for the server to finish its response wait_for { keys %wait < $waitcount }; } $loop->remove( $http ); } # foreach $test_mode doesn't quite work as expected foreach (qw( pipeline no_pipeline http/1.0 )) { $test_mode = $_; do_uris( URI->new( "http://server/path/1" ) => sub { my ( $req ) = @_; is( $req->content, "GET /path/1 HTTP/1.1", "First of three pipeline for $test_mode" ); }, URI->new( "http://server/path/2" ) => sub { my ( $req ) = @_; is( $req->content, "GET /path/2 HTTP/1.1", "Second of three pipeline for $test_mode" ); }, URI->new( "http://server/path/3" ) => sub { my ( $req ) = @_; is( $req->content, "GET /path/3 HTTP/1.1", "Third of three pipeline for $test_mode" ); }, ); } done_testing; Net-Async-HTTP-0.48/t/14conn-max.t000444001750001750 624214021530440 15213 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Identity; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers pipeline => 0, # Disable pipelining or we'll break the tests ); $loop->add( $http ); my @peersocks; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my ( $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); push @peersocks, $peersock; return Future->done( $self ); }; foreach my $max ( 1, 2, 0 ) { $http->configure( max_connections_per_host => $max ); my @done; foreach my $idx ( 0 .. 2 ) { $http->do_request( request => HTTP::Request->new( GET => "/" ), host => "myhost", on_response => sub { $done[$idx]++ }, on_error => sub { }, ) } ## First batch of requests looks the same in all cases my $expect_conns = $max || 3; is( scalar @peersocks, $expect_conns, "Expected number of connections for max=$max" ); # Wait for all the pending requests to be written my @buffers; wait_for_stream { ($buffers[$_]||"") =~ m/$CRLF$CRLF/ } $peersocks[$_] => $buffers[$_] for 0 .. $#peersocks; $_ = "" for @buffers; # Write responses for all $_->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ) for @peersocks; wait_for { $done[$_] } for 0 .. $expect_conns-1; if( $max == 1 ) { # The other two requests come over the same initial socket wait_for_stream { ($buffers[0]||"") =~ m/$CRLF$CRLF/ } $peersocks[0] => $buffers[0]; $_ = "" for @buffers; $peersocks[0]->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); wait_for { $done[1] }; wait_for_stream { ($buffers[0]||"") =~ m/$CRLF$CRLF/ } $peersocks[0] => $buffers[0]; $_ = "" for @buffers; $peersocks[0]->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); } elsif( $max == 2 ) { # The third request will come over one of these $peersocks again, but we don't know which my $peersock; { $loop->watch_io( handle => $peersocks[0], on_read_ready => sub { $peersock = $peersocks[0] } ); $loop->watch_io( handle => $peersocks[1], on_read_ready => sub { $peersock = $peersocks[1] } ); wait_for { defined $peersock }; $loop->unwatch_io( handle => $_, on_read_ready => 1 ) for @peersocks; } wait_for_stream { ($buffers[0]||"") =~ m/$CRLF$CRLF/ } $peersock => $buffers[0]; $_ = "" for @buffers; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); } wait_for { $done[0] && $done[1] && $done[2] }; ok( 1, "All three requests are now done for max=$max" ); undef @peersocks; # CHEATING $_->remove_from_parent for @{ delete $http->{connections}{"myhost:80"} }; } done_testing; Net-Async-HTTP-0.48/t/15conn-errors.t000444001750001750 304014021530440 15734 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Identity; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); # connect errors { my @on_connect_errors; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; my $f = $self->loop->new_future; push @on_connect_errors, sub { $f->fail( @_ ) }; return $f; }; my $f1 = $http->do_request( uri => URI->new( "http://hostname/first" ), ); my $f2 = $http->do_request( uri => URI->new( "http://hostname/second" ), ); is( scalar @on_connect_errors, 1, '1 on_connect_errors queued before first connect error' ); ok( !$f1->is_ready, '$f1 still pending before connect error' ); ( shift @on_connect_errors )->( connect => "No route to host" ); wait_for_future( $f1 ); is( scalar $f1->failure, "hostname:80 - connect failed [No route to host]", '$f1->failure' ); is( scalar @on_connect_errors, 1, '1 on_connect_errors queued before second connect error' ); ok( !$f2->is_ready, '$f2 still pending before connect error' ); ( shift @on_connect_errors )->( connect => "No route to host" ); wait_for_future( $f2 ); is( scalar $f2->failure, "hostname:80 - connect failed [No route to host]", '$f2->failure' ); } done_testing; Net-Async-HTTP-0.48/t/16max-in-flight.t000444001750001750 561414021530440 16143 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( max_in_flight => 2 ); $loop->add( $http ); my $host = "host.example"; my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq $host or die "Expected $args{host} eq $host"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my @resp; $http->do_request( request => HTTP::Request->new( GET => "/$_", [ Host => $host ] ), host => $host, on_response => sub { push @resp, shift }, on_error => sub { die "Test died early - $_[-1]" }, ) for 0 .. 3; wait_for { $peersock }; # CHEATING my $conn = $http->{connections}->{"$host:80"}->[0] or die "Unable to find connection object"; ref $conn eq "Net::Async::HTTP::Connection" or die "Unable to find connection object"; my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; ok( $request_stream =~ m[^GET /0 HTTP/1\.1$CRLF.*?$CRLF$CRLF$]s, 'Request stream contains first request only' ); $request_stream = ""; # CHEATING is( scalar @{ $conn->{ready_queue} }, 3, '3 requests still queued' ); $peersock->print( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . "$CRLF" ); wait_for { $resp[0] }; is( $resp[0]->code, 200, 'Request /0 responded OK' ); wait_for_stream { $request_stream =~ m/(?:.*$CRLF$CRLF){2}/s } $peersock => $request_stream; ok( $request_stream =~ m[^GET /1 HTTP/1\.1$CRLF.*?${CRLF}${CRLF}GET /2 HTTP/1\.1$CRLF.*?${CRLF}${CRLF}$]s, 'Request stream contains second and third requests after first response' ); $request_stream = ""; # CHEATING is( scalar @{ $conn->{ready_queue} }, 1, '1 request still queued' ); $peersock->print( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 1$CRLF" . "$CRLF" . "A" ); $peersock->print( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 2$CRLF" . "$CRLF" . "AB" ); wait_for { $resp[2] }; is( $resp[1]->content, "A", 'Request /1 content' ); is( $resp[2]->content, "AB", 'Request /2 content' ); wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; ok( $request_stream =~ m[^GET /3 HTTP/1\.1$CRLF.*?$CRLF$CRLF$]s, 'Request stream contains final request' ); $peersock->print( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . "$CRLF" ); wait_for { $resp[3] }; is( $resp[3]->code, 200, 'Request /3 responded OK' ); done_testing; Net-Async-HTTP-0.48/t/17on-write.t000444001750001750 320414021530440 15235 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); $self->configure( write_len => 10 ); return Future->done( $self ); }; { my @written; my $req_f = $http->do_request( request => HTTP::Request->new( PUT => "/content", [ Host => "somewhere" ] ), host => "somewhere", request_body => "X" x 100, on_body_write => sub { push @written, $_[0] }, ); defined $peersock or die "No peersock\n"; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF$CRLF//s; wait_for_stream { $request_stream =~ m/X{100}/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 201 Created$CRLF" . "Content-Length: 0$CRLF" . "Connection: Keep-Alive$CRLF" . $CRLF ); wait_for_future( $req_f ); is_deeply( \@written, [ 10, 20, 30, 40, 50, 60, 70, 80, 90, 100 ], 'on_body_write invoked per body write call' ); } done_testing; Net-Async-HTTP-0.48/t/18content-coding.t000444001750001750 1130614021530440 16427 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers decode_content => 1, ); $loop->add( $http ); my $TEST_CONTENT = "Here is the compressed content\n"; my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "host" or die "Expected $args{host} eq 'host'"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; # RFC 2616 "gzip" SKIP: { skip "Compress::Raw::Zlib not available", 4 unless eval { require Compress::Raw::Zlib and $Compress::Raw::Zlib::VERSION >= 2.057 }; diag( "Using optional dependency Compress::Raw::Zlib $Compress::Raw::Zlib::VERSION" ); my $f = $http->GET( "http://host/gzip" ); $f->on_fail( sub { $f->get } ); { my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; my ( undef, @headers ) = split m/$CRLF/, $request_stream; ok( scalar( grep { m/^Accept-Encoding: / } @headers ), 'Request as an Accept-Encoding header' ); my $compressor = Compress::Raw::Zlib::Deflate->new( -WindowBits => Compress::Raw::Zlib::WANT_GZIP(), -AppendOutput => 1, ); my $content = ""; $compressor->deflate( $TEST_CONTENT, $content ); $compressor->flush( $content ); $peersock->syswrite( sprintf "HTTP/1.1 200 OK$CRLF" . "Content-Length: %d$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Encoding: gzip$CRLF" . $CRLF . "%s", length $content, $content ); } my $response = $f->get; is( $response->content, $TEST_CONTENT, '$response->content is decompressed from gzip' ); ok( !defined $response->header( "Content-Encoding" ), '$response has no Content-Encoding' ); is( $response->header( "X-Original-Content-Encoding" ), "gzip", '$response has X-Original-Content-Encoding' ); } # RFC 2616 "deflate" SKIP: { skip "Compress::Raw::Zlib not available", 3 unless eval { require Compress::Raw::Zlib and $Compress::Raw::Zlib::VERSION >= 2.057 }; my $f = $http->GET( "http://host/deflate" ); $f->on_fail( sub { $f->get } ); { my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; my $compressor = Compress::Raw::Zlib::Deflate->new( -WindowBits => 15, -AppendOutput => 1, ); my $content = ""; $compressor->deflate( $TEST_CONTENT, $content ); $compressor->flush( $content ); $peersock->syswrite( sprintf "HTTP/1.1 200 OK$CRLF" . "Content-Length: %d$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Encoding: deflate$CRLF" . $CRLF . "%s", length $content, $content ); } my $response = $f->get; is( $response->content, $TEST_CONTENT, '$response->content is decompressed from deflate' ); ok( !defined $response->header( "Content-Encoding" ), '$response has no Content-Encoding' ); is( $response->header( "X-Original-Content-Encoding" ), "deflate", '$response has X-Original-Content-Encoding' ); } SKIP: { # Compress::Bzip2 2.09 appears to fail skip "Compress::Bzip2 not available", 3 unless eval { require Compress::Bzip2 and $Compress::Bzip2::VERSION >= 2.10 }; diag( "Using optional dependency Compress::Bzip2 $Compress::Bzip2::VERSION" ); my $f = $http->GET( "http://host/bzip2" ); $f->on_fail( sub { $f->get } ); { my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; my $compressor = Compress::Bzip2::bzdeflateInit(); my $content = ""; $content .= $compressor->bzdeflate( my $tmp = $TEST_CONTENT ); $content .= $compressor->bzclose; $peersock->syswrite( sprintf "HTTP/1.1 200 OK$CRLF" . "Content-Length: %d$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Encoding: bzip2$CRLF" . $CRLF . "%s", length $content, $content ); } my $response = $f->get; is( $response->content, $TEST_CONTENT, '$response->content is decompressed from bzip2' ); ok( !defined $response->header( "Content-Encoding" ), '$response has no Content-Encoding' ); is( $response->header( "X-Original-Content-Encoding" ), "bzip2", '$response has X-Original-Content-Encoding' ); } done_testing; Net-Async-HTTP-0.48/t/19idle.t000444001750001750 254514021530440 14417 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Identity; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my @on_error; my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers on_error => sub { my ( undef, @args ) = @_; push @on_error, [ @args ]; }, ); $loop->add( $http ); # spurious trailing content { my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $f = $http->do_request( request => HTTP::Request->new( GET => "http://host/" ), ); wait_for { $peersock }; my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->print( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 11$CRLF" . $CRLF . "Hello world" . "more stuff here" ); wait_for_future( $f ); ok( !$f->failure, '$f is ready and does not fail' ); } done_testing; Net-Async-HTTP-0.48/t/20local-connect.t000444001750001750 346514021530440 16215 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $port; $loop->listen( host => "127.0.0.1", service => 0, socktype => "stream", on_listen => sub { $port = shift->sockport; }, on_stream => sub { my ( $stream ) = @_; $stream->configure( on_read => sub { my ( $self, $buffref ) = @_; return 0 unless $$buffref =~ m/$CRLF$CRLF/; $self->write( "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: close$CRLF" . "$CRLF" . "OK" ); $self->close_when_empty; return 0; }, ); $loop->add( $stream ); }, on_listen_error => sub { die "Test failed early - $_[-1]" }, on_resolve_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $port }; my $local_uri = URI->new( "http://127.0.0.1:$port/" ); my $response; my $connected_port; $http->do_request( uri => $local_uri, on_ready => sub { my ( $conn ) = @_; $connected_port = $conn->read_handle->peerport; Future->done; }, on_response => sub { $response = $_[0]; }, on_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $response }; is( $response->content_type, "text/plain", '$response->content_type' ); is( $response->content, "OK", '$response->content' ); is( $connected_port, $port, 'peerport visible within on_ready' ); done_testing; Net-Async-HTTP-0.48/t/21local-connect-ssl.t000444001750001750 467714021530440 17023 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; eval { require IO::Async::SSL; IO::Async::SSL->VERSION( '0.12' ); } or plan skip_all => "No IO::Async::SSL"; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers # This also checks that object-wide SSL params are applied SSL_verify_mode => 0, ); $loop->add( $http ); my $port; $loop->SSL_listen( host => "127.0.0.1", service => 0, socktype => "stream", SSL_key_file => "t/privkey.pem", SSL_cert_file => "t/server.pem", on_listen => sub { $port = shift->sockport; }, on_stream => sub { my ( $stream ) = @_; # SNI - RT#94605 SKIP: { skip "SSL server does not support SNI", 1 unless IO::Socket::SSL->can_server_sni; my $sslsocket = $stream->read_handle; is( $sslsocket->get_servername, "127.0.0.1", '->get_servername on server' ); } $stream->configure( on_read => sub { my ( $self, $buffref ) = @_; return 0 unless $$buffref =~ m/$CRLF$CRLF/; $self->write( "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Connection: close$CRLF" . "$CRLF" . "OK" ); $self->close_when_empty; return 0; }, ); $loop->add( $stream ); }, on_listen_error => sub { die "Test failed early - $_[-1]" }, on_resolve_error => sub { die "Test failed early - $_[-1]" }, on_ssl_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $port }; my $local_uri = URI->new( "https://127.0.0.1:$port/" ); my $response; $http->do_request( uri => $local_uri, on_response => sub { $response = $_[0]; }, on_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $response }; is( $response->content_type, "text/plain", '$response->content_type' ); is( $response->content, "OK", '$response->content' ); # require_SSL { $http->configure( require_SSL => 1 ); my $f = $http->GET( "http://127.0.0.1:$port/" ); ok( $f->failure, '->GET on http with require_SSL fails' ); like( scalar $f->failure, qr/require_SSL/, 'require_SSL failure' ); } done_testing; Net-Async-HTTP-0.48/t/22local-connect-pipeline.t000444001750001750 345314021530440 20017 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $port; $loop->listen( host => "127.0.0.1", service => 0, socktype => "stream", on_listen => sub { $port = shift->sockport; }, on_stream => sub { my ( $stream ) = @_; $stream->configure( on_read => sub { my ( $self, $buffref ) = @_; return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; $self->write( "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Length: 2$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" . "OK" ); return 1; }, ); $loop->add( $stream ); }, on_listen_error => sub { die "Test failed early - $_[-1]" }, on_resolve_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $port }; my @local_uris = map { URI->new( "http://127.0.0.1:$port/page/$_" ) } 1 .. 2; my @responses; $http->do_request( uri => $_, on_response => sub { push @responses, $_[0]; }, on_error => sub { die "Test failed early - $_[-1]" }, ) for @local_uris; wait_for { @responses == 2 }; is( $responses[0]->content_type, "text/plain", '$response->content_type' ); is( $responses[0]->content, "OK", '$response->content' ); is( $responses[1]->content_type, "text/plain", '$response->content_type' ); is( $responses[1]->content, "OK", '$response->content' ); done_testing; Net-Async-HTTP-0.48/t/23local-connect-redir.t000444001750001750 361614021530440 17321 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $port; $loop->listen( host => "127.0.0.1", service => 0, socktype => "stream", on_listen => sub { $port = shift->sockport; }, on_stream => sub { my ( $stream ) = @_; $stream->configure( on_read => sub { my ( $self, $buffref ) = @_; return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; my $header = $1; my $response = ( $header =~ m{^GET /redir} ) ? "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: http://127.0.0.1:$port/moved$CRLF" . "Connection: close$CRLF" . "$CRLF" : "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Length: 2$CRLF" . "Connection: close$CRLF" . "$CRLF" . "OK"; $self->write( $response ); return 1; }, ); $loop->add( $stream ); }, on_listen_error => sub { die "Test failed early - $_[-1]" }, on_resolve_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $port }; my $response; $http->do_request( uri => URI->new( "http://127.0.0.1:$port/redir" ), on_response => sub { $response = $_[0]; }, on_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $response }; is( $response->content_type, "text/plain", '$response->content_type' ); is( $response->content, "OK", '$response->content' ); done_testing; Net-Async-HTTP-0.48/t/24local-connect-redir-ssl.t000444001750001750 507114021530440 20116 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; eval { require IO::Async::SSL; IO::Async::SSL->VERSION( '0.12' ); } or plan skip_all => "No IO::Async::SSL"; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $redir_url; my $port; $loop->SSL_listen( host => "127.0.0.1", service => 0, socktype => "stream", SSL_key_file => "t/privkey.pem", SSL_cert_file => "t/server.pem", on_listen => sub { $port = shift->sockport; }, on_stream => sub { my ( $stream ) = @_; $stream->configure( on_read => sub { my ( $self, $buffref ) = @_; return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; my $header = $1; my $response = ( $header =~ m{^GET /redir} ) ? "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: $redir_url$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" : "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Length: 2$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" . "OK"; $self->write( $response ); return 1; }, ); $loop->add( $stream ); }, on_listen_error => sub { die "Test failed early - $_[-1]" }, on_resolve_error => sub { die "Test failed early - $_[-1]" }, on_ssl_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $port }; $redir_url = "https://127.0.0.1:$port/moved"; my $response; $http->do_request( uri => URI->new( "https://127.0.0.1:$port/redir" ), SSL_verify_mode => 0, on_response => sub { $response = $_[0]; }, on_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $response }; is( $response->content_type, "text/plain", '$response->content_type' ); is( $response->content, "OK", '$response->content' ); # require_SSL { $http->configure( require_SSL => 1 ); $redir_url = "http://127.0.0.1:$port/moved_to_plaintext"; my $f = $http->GET( "https://127.0.0.1:$port/redir" ); wait_for_future( $f ); ok( $f->failure, '->GET on http with require_SSL fails' ); like( scalar $f->failure, qr/require_SSL/, 'require_SSL failure' ); } done_testing; Net-Async-HTTP-0.48/t/30timeout.t000444001750001750 1360414021530440 15177 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Refcount; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; use Errno qw( EAGAIN ); my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new(); $loop->add( $http ); my $peersock; no warnings 'redefine'; my $latest_connection; local *IO::Async::Handle::connect = sub { $latest_connection = my $self = shift; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; { my $errcount; my $error; my $future = $http->do_request( uri => URI->new( "http://my.server/doc" ), timeout => 0.1, # Really quick for testing on_response => sub { die "Test died early - got a response but shouldn't have" }, on_error => sub { $errcount++; $error = $_[0] }, ); is_refcount( $http, 2, '$http refcount 2 after ->do_request with timeout' ); wait_for { defined $error }; is( $error, "Timed out", 'Received timeout error' ); is( $errcount, 1, 'on_error invoked once' ); ok( $future->is_ready, '$future is ready after timeout' ); is( scalar $future->failure, "Timed out", '$future->failure after timeout' ); is( ( $future->failure )[1], "timeout", '$future->failure [1] is timeout' ); is_refcount( $http, 2, '$http refcount 2 after ->do_request with timeout fails' ); } { my $errcount; my $error; my $future = $http->do_request( uri => URI->new( "http://my.server/redir" ), timeout => 0.1, # Really quick for testing on_response => sub { die "Test died early - got a response but shouldn't have" }, on_error => sub { $errcount++; $error = $_[0] }, ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: http://my.server/get_doc?name=doc$CRLF" . "Connection: Keep-Alive$CRLF" . "$CRLF" ); wait_for { defined $error }; is( $error, "Timed out", 'Received timeout error from redirect' ); is( $errcount, 1, 'on_error invoked once from redirect' ); ok( $future->is_ready, '$future is ready after timeout' ); is( scalar $future->failure, "Timed out", '$future->failure after timeout' ); is( ( $future->failure )[1], "timeout", '$future->failure [1] is timeout' ); } { my $error; my $errcount; $http->do_request( uri => URI->new( "http://my.server/first" ), timeout => 0.1, # Really quick for testing on_response => sub { die "Test died early - got a response but shouldn't have" }, on_error => sub { $errcount++; $error = $_[0] }, ); my $error2; my $errcount2; $http->do_request( uri => URI->new( "http://my.server/second" ), timeout => 0.3, on_response => sub { die "Test died early - got a response but shouldn't have" }, on_error => sub { $errcount2++; $error2 = $_[0] }, ); wait_for { defined $error }; is( $error, "Timed out", 'Received timeout error from pipeline' ); is( $errcount, 1, 'on_error invoked once from pipeline' ); wait_for { defined $error2 }; is( $error2, "Timed out", 'Received timeout error from pipeline(2)' ); is( $errcount2, 1, 'on_error invoked once from pipeline(2)' ); } # Stall during write { my $future = $http->do_request( uri => URI->new( "http://stalling.server/write" ), stall_timeout => 0.1, ); # Much hackery for unit-testing purposes $latest_connection->configure( writer => sub { $! = EAGAIN; return undef }, ); wait_for_future( $future ); is( scalar $future->failure, "Stalled while writing request", '$future->failure for stall during write' ); is( ( $future->failure )[1], "stall_timeout", '$future->failure [1] is stall_timeout' ); } # Stall during header read { my $future = $http->do_request( uri => URI->new( "http://stalling.server/header" ), stall_timeout => 0.1, ); # Don't write anything wait_for_future( $future ); is( scalar $future->failure, "Stalled while waiting for response", '$future->failure for stall during response header' ); is( ( $future->failure )[1], "stall_timeout", '$future->failure [1] is stall_timeout' ); } # Stall during header read { my $future = $http->do_request( uri => URI->new( "http://stalling.server/read" ), stall_timeout => 0.1, ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 100$CRLF" ); # unfinished wait_for_future( $future ); is( scalar $future->failure, "Stalled while receiving response header", '$future->failure for stall during response header' ); is( ( $future->failure )[1], "stall_timeout", '$future->failure [1] is stall_timeout' ); } # Stall during body read { my $future = $http->do_request( uri => URI->new( "http://stalling.server/read" ), stall_timeout => 0.1, ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 100$CRLF" . $CRLF ); $peersock->syswrite( "some of the content" ); # unfinished wait_for_future( $future ); is( scalar $future->failure, "Stalled while receiving body", '$future->failure for stall during response body' ); is( ( $future->failure )[1], "stall_timeout", '$future->failure [1] is stall_timeout' ); } $loop->remove( $http ); is_oneref( $http, '$http has refcount 1 before EOF' ); done_testing; Net-Async-HTTP-0.48/t/31cancel.t000444001750001750 622514021530440 14720 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers pipeline => 1, max_connections_per_host => 1, ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); $peersock->blocking(0); return Future->done( $self ); }; # Cancellation { undef $peersock; my $f1 = $http->do_request( method => "GET", uri => URI->new( "http://host1/some/path" ), ); wait_for { $peersock }; $f1->cancel; wait_for { my $ret = sysread($peersock, my $buffer, 1); defined $ret and $ret == 0 }; ok( 1, '$peersock closed' ); # Retry after cancel should establish another connection undef $peersock; my $f2 = $http->do_request( method => "GET", uri => URI->new( "http://host1/some/path" ), ); wait_for { $peersock }; # Wait for the client to send its request my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( join( $CRLF, "HTTP/1.1 200 OK", "Content-Type: text/plain", "Content-Length: 12", "" ) . $CRLF . "Hello world!" ); wait_for_future( $f2 )->get; } # Cancelling a pending unpipelined request { undef $peersock; # Make first -one- request/response to establish HTTP/1.1 pipeline ability my $f0 = $http->do_request( method => "GET", uri => URI->new( "http://host2/" ), ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $peersock->syswrite( join( $CRLF, "HTTP/1.1 200 OK", "Content-Length: 0", "" ) . $CRLF ); wait_for_future( $f0 ); my ( $f1, $f2, $f3 ) = map { $http->do_request( method => "GET", uri => URI->new( "http://host2/req/$_" ), ); } 1, 2, 3; wait_for { $peersock }; # cancel $f2 - 1 and 3 should still complete $f2->cancel; # Wait for the $f1 and $f3 $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; like( $request_stream, qr(^GET /req/1 HTTP/1.1), '$f1 request written' ); $request_stream = ""; $peersock->syswrite( join( $CRLF, "HTTP/1.1 200 OK", "Content-Length: 0", "" ) . $CRLF ); wait_for_future( $f1 ); ok( $f1->is_done, '$f1 is done' ); wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; like( $request_stream, qr(^GET /req/3 HTTP/1.1), '$f3 request written' ); $request_stream = ""; $peersock->syswrite( join( $CRLF, "HTTP/1.1 200 OK", "Content-Length: 0", "" ) . $CRLF ); wait_for_future( $f3 ); ok( $f3->is_done, '$f3 is done' ); } done_testing; Net-Async-HTTP-0.48/t/32remove.t000444001750001750 273714021530440 14775 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Refcount; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new; $loop->add( $http ); my $host = "host.example"; my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq $host or die "Expected $args{host} eq $host"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; my $f = $http->do_request( request => HTTP::Request->new( GET => "/", [ Host => $host ] ), host => $host, ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream = ""; $peersock->print( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); wait_for_future( $f ); # gut-wrenching my $conn = $http->{connections}{"$host:80"}[0]; ok( $conn, 'Found a connection' ); # 1 internally in the $http, 2 in IO::Async internals, 1 here is_refcount( $conn, 4, 'Connection has 4 references' ); $loop->remove( $http ); undef $http; is_oneref( $conn, 'Connection has 1 reference remaining at EOF' ); done_testing; Net-Async-HTTP-0.48/t/40socks.t000444001750001750 440014021530440 14606 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; BEGIN { eval { require Net::Async::SOCKS; Net::Async::SOCKS->VERSION( '0.003' ); } or plan skip_all => "No Net::Async::SOCKS"; } my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers SOCKS_host => "socks.host", SOCKS_port => "1234", ); $loop->add( $http ); my %connect_args; my $connect_f; no warnings 'redefine'; local *IO::Async::Loop::SOCKS_connect = sub { shift; ( %connect_args ) = @_; return $connect_f = Future->new; }; my $f = $http->do_request( uri => URI->new( "http://remote-site-here/" ), ); # Check that ->SOCKS_connect was invoked correctly my $handle; { wait_for { keys %connect_args }; $handle = delete $connect_args{handle}; delete @connect_args{qw( SSL on_error )}; is_deeply( \%connect_args, { family => 0, socktype => "stream", host => "remote-site-here", service => 80, is_proxy => '', SOCKS_host => "socks.host", SOCKS_port => 1234, }, 'SOCKS_connect invoked' ); } # Set up a socket connection my $peersock; { ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $handle->set_handle( $selfsock ); $connect_f->done( $handle ); } # Handle request/response cycle { my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; $request_stream =~ s/^(.*)$CRLF//; is( $1, "GET / HTTP/1.1", 'Received request firstline' ); $request_stream =~ s/^(.*)$CRLF$CRLF//s; my %req_headers = map { m/^([^:]+):\s+(.*)$/g } split( m/$CRLF/, $1 ); is_deeply( \%req_headers, { Host => "remote-site-here", Connection => "keep-alive", }, 'Received request headers' ); $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); } my $response = wait_for_future( $f )->get; is( $response->code, 200, '$response' ); done_testing; Net-Async-HTTP-0.48/t/70metrics.t000444001750001750 340014021530440 15134 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Metrics::Any; use IO::Async::Loop; use IO::Async::Test; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "host0" or die "Expected $args{host} eq host0"; $args{service} eq "80" or die "Expected $args{service} eq 80"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; { # Do a request my $f = $http->do_request( method => "GET", uri => URI->new( "http://host0" ), ); wait_for { defined $peersock }; is_metrics( { "http_client_requests_in_flight" => 1, }, 'Metrics show a request in flight' ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; my $wrotelen = $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 12$CRLF" . $CRLF . "Hello, world" ); wait_for { $f->is_ready }; $f->get; is_metrics( { "http_client_requests_in_flight" => 0, "http_client_requests method:GET" => 1, "http_client_responses method:GET code:200" => 1, "http_client_request_duration_total" => Test::Metrics::Any::positive, "http_client_response_bytes_total" => $wrotelen, # ensure every byte is accounted for }, 'Metrics are created for a request/response cycle' ); } done_testing; Net-Async-HTTP-0.48/t/80cross-http.t000444001750001750 346214021530440 15605 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use IO::Async::Stream; unless( eval { require Net::Async::HTTP::Server and Net::Async::HTTP::Server->VERSION( '0.03' ) } ) { plan skip_all => "Net::Async::HTTP::Server 0.03 is not available"; } unless( eval { require Net::Async::HTTP } ) { plan skip_all => "Net::Async::HTTP is not available"; } my $CRLF = "\x0d\x0a"; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $server = Net::Async::HTTP::Server->new( on_request => sub { my $self = shift; my ( $req ) = @_; my $content = "Response to " . join " ", $req->method, $req->path, "with " . length( $req->body ) . " bytes"; $req->write( "HTTP/1.1 200 OK$CRLF" . "Content-Length: " . length( $content ) . $CRLF . "Content-Type: text/plain$CRLF" . $CRLF . $content ); $req->done; }, ); $loop->add( $server ); $loop->add( my $client = Net::Async::HTTP->new ); my ( $host, $port ); $server->listen( addr => { family => "inet", socktype => "stream", ip => "127.0.0.1", port => 0 }, on_listen => sub { my $socket = $_[0]->read_handle; $host = $socket->sockhost; $port = $socket->sockport; }, on_listen_error => sub { die "Cannot listen - $_[-1]\n" }, ); wait_for { defined $host and defined $port }; my $response; $client->do_request( uri => URI->new( "http://$host:$port/" ), on_response => sub { ( $response ) = @_; }, on_error => sub { die "Test failed early - $_[-1]\n" }, ); wait_for { $response }; is( $response->code, 200, '$response->code' ); is( $response->content_type, "text/plain", '$response->content_type' ); is( $response->content, "Response to GET / with 0 bytes", '$response->content' ); done_testing; Net-Async-HTTP-0.48/t/81cross-https.t000444001750001750 374614021530440 15776 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use IO::Async::Stream; unless( eval { require Net::Async::HTTP::Server and Net::Async::HTTP::Server->VERSION( '0.06' ) } ) { plan skip_all => "Net::Async::HTTP::Server 0.06 is not available"; } unless( eval { require Net::Async::HTTP } ) { plan skip_all => "Net::Async::HTTP is not available"; } unless( eval { require IO::Async::SSL and IO::Async::SSL->VERSION( '0.12' ) } ) { plan skip_all => "IO::Async::SSL is not available"; } my $CRLF = "\x0d\x0a"; my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $server = Net::Async::HTTP::Server->new( on_request => sub { my $self = shift; my ( $req ) = @_; my $content = "Response to " . join " ", $req->method, $req->path, "with " . length( $req->body ) . " bytes"; $req->write( "HTTP/1.1 200 OK$CRLF" . "Content-Length: " . length( $content ) . $CRLF . "Content-Type: text/plain$CRLF" . $CRLF . $content ); $req->done; }, ); $loop->add( $server ); $loop->add( my $client = Net::Async::HTTP->new ); my ( $host, $port ); $server->listen( addr => { family => "inet", socktype => "stream", ip => "127.0.0.1", port => 0 }, on_listen => sub { my $socket = $_[0]->read_handle; $host = $socket->sockhost; $port = $socket->sockport; }, extensions => [qw( SSL )], SSL_key_file => "t/privkey.pem", SSL_cert_file => "t/server.pem", )->get; my $response; $client->do_request( uri => URI->new( "https://$host:$port/" ), SSL_verify_mode => 0, on_response => sub { ( $response ) = @_; }, on_error => sub { die "Test failed early - $_[0]\n" }, ); wait_for { $response }; is( $response->code, 200, '$response->code' ); is( $response->content_type, "text/plain", '$response->content_type' ); is( $response->content, "Response to GET / with 0 bytes", '$response->content' ); done_testing; Net-Async-HTTP-0.48/t/90rt75615.t000444001750001750 432514021530440 14534 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $port; $loop->listen( host => "127.0.0.1", service => 0, socktype => "stream", on_listen => sub { $port = shift->sockport; }, on_stream => sub { my ( $stream ) = @_; $stream->configure( on_read => sub { my ( $self, $buffref ) = @_; return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; my $header = $1; my $response = ( $header =~ m{^GET /redir} ) ? "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: /moved$CRLF" . "Connection: close$CRLF" . "$CRLF" : "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Length: 2$CRLF" . "Connection: close$CRLF" . "$CRLF" . "OK"; $self->write( $response ); return 1; }, ); $loop->add( $stream ); }, on_listen_error => sub { die "Test failed early - $_[-1]" }, on_resolve_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $port }; my $code = \&IO::Async::Handle::connect; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{service} = $port if $args{service} eq '80'; $code->($self, %args); }; my $response; my $req = HTTP::Request->new(GET => '/redir'); $req->protocol('HTTP/1.1'); $req->header(Host => '127.0.0.1'); $http->do_request( method => "GET", host => '127.0.0.1', request => $req, on_response => sub { $response = $_[0]; }, on_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $response }; is( $response->content_type, "text/plain", '$response->content_type' ); is( $response->content, "OK", '$response->content' ); done_testing; Net-Async-HTTP-0.48/t/90rt75616.t000444001750001750 441214021530440 14532 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $port; $loop->listen( host => "127.0.0.1", service => 0, socktype => "stream", on_listen => sub { $port = shift->sockport; }, on_stream => sub { my ( $stream ) = @_; $stream->configure( on_read => sub { my ( $self, $buffref ) = @_; return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; my $header = $1; my $response = ( $header =~ m{^GET /redir} ) ? "HTTP/1.1 301 Moved Permanently$CRLF" . "Content-Length: 0$CRLF" . "Location: /moved$CRLF" . "Connection: close$CRLF" . "$CRLF" : "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Length: 2$CRLF" . "Connection: close$CRLF" . "$CRLF" . "OK"; $self->write( $response ); return 1; }, ); $loop->add( $stream ); }, on_listen_error => sub { die "Test failed early - $_[-1]" }, on_resolve_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $port }; my $code = \&IO::Async::Handle::connect; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{service} = $port if $args{service} eq 'http'; $args{service} = $port if $args{service} == 80; $code->($self, %args); }; my $response; my $req = HTTP::Request->new(GET => '/redir'); $req->protocol('HTTP/1.1'); $req->header(Host => '127.0.0.1'); $http->do_request( method => "GET", host => '127.0.0.1', request => $req, on_response => sub { $response = $_[0]; }, on_error => sub { die "Test failed early - $_[-1]" }, ); wait_for { defined $response }; is( $response->content_type, "text/plain", '$response->content_type' ); is( $response->content, "OK", '$response->content' ); done_testing; Net-Async-HTTP-0.48/t/90rt92904.t000444001750001750 203414021530440 14527 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $loop = IO::Async::Loop->new; testing_loop( $loop ); my $http = Net::Async::HTTP->new( max_connections_per_host => 2, ); $loop->add( $http ); my @conn_f; no warnings 'redefine'; local *IO::Async::Loop::connect = sub { shift; my %args = @_; $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'"; $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'"; push @conn_f, my $f = $loop->new_future; return $f; }; my @f = map { $http->do_request(uri=>'http://localhost:5000/') } 0 .. 1; is( scalar @conn_f, 2, 'Two pending connect() attempts after two concurrent ->do_request' ); # Fail them both ( shift @conn_f )->fail( "Connection refused", connect => ) for 0 .. 1; ok( $f[$_]->is_ready && $f[$_]->failure, "Request [$_] Future fails after connect failure" ) for 0 .. 1; ok( !@conn_f, 'No more pending connect() attempts' ); done_testing; Net-Async-HTTP-0.48/t/90rt93232.t000444001750001750 274714021530440 14535 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Refcount; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $port; $loop->listen( host => "127.0.0.1", service => 0, socktype => "stream", on_listen => sub { $port = shift->sockport; }, on_stream => sub { my ( $stream ) = @_; $stream->configure( on_read => sub { my ( $self, $buffref ) = @_; return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; my $header = $1; $self->write( "HTTP/1.1 200 OK$CRLF" . "Content-Type: text/plain$CRLF" . "Content-Length: 2$CRLF" . "Connection: close$CRLF" . "$CRLF" . "OK" ); return 1; }, ); $loop->add( $stream ); }, )->get; my $on_body_chunk; $http->do_request( method => "GET", host => "127.0.0.1", port => $port, request => HTTP::Request->new(GET => "/"), on_header => sub { my ( $header ) = @_; # Needs to be a real closure return $on_body_chunk = sub { $header = $header; 1 }; }, )->get; is_oneref( $on_body_chunk, '$on_body_chunk has refcount 1 before EOF' ); done_testing; Net-Async-HTTP-0.48/t/90rt99142.t000444001750001750 467014021530440 14540 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers max_connections_per_host => 2, ); $loop->add( $http ); { my @pending; no warnings 'redefine'; *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'"; $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'"; push @pending, [ $self, my $f = $loop->new_future ]; return $f; }; sub await_connection { wait_for { scalar @pending }; return @{ shift @pending }; } } # Make a first connection my $req_f1 = $http->GET( "http://localhost:5000/1" ); my $peersock; { my ( $conn, $conn_f ) = await_connection; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $conn->set_handle( $selfsock ); $conn_f->done( $conn ); } # Before the first is ready, make a second one my $req_f2 = $http->GET( "http://localhost:5000/2" ); my ( $conn2, $conn_f2 ) = await_connection; ok( $conn_f2, 'Second connection request is pending' ); # Gutwrenching is( scalar @{ $http->{connections}{"localhost:5000"} }, 2, '$http has two pending connections to localhost:5000' ); my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; like( $request_stream, qr(^GET /1), 'First request written' ); $request_stream = ""; # Respond with HTTP/1.1 so client knows it can pipeline $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); wait_for_future( $req_f1 ); ok( $req_f1->is_done, '$req_f1 is done after first response' ); # At this point, req 2 should already be made down the socket wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; like( $request_stream, qr(^GET /2), 'Second request written down first socket' ); # And $conn_f2 should already be cancelled ok( $conn_f2->is_cancelled, '$conn_f2 now cancelled' ); # Gutwrenching is( scalar @{ $http->{connections}{"localhost:5000"} }, 1, '$http has only one connection to localhost:5000 at EOF' ); done_testing; Net-Async-HTTP-0.48/t/91rt100066.t000444001750001750 631514021530440 14603 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $http = Net::Async::HTTP->new( user_agent => "", # Don't put one in request headers ); $loop->add( $http ); my $peersock; no warnings 'redefine'; local *IO::Async::Handle::connect = sub { my $self = shift; my %args = @_; $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'"; $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); return Future->done( $self ); }; # Without on_error { my $f1 = $http->GET( "http://localhost:5000/1" ) ->on_done( sub { die "Oopsie" } ); my $f2 = $http->GET( "http://localhost:5000/2" ); wait_for { defined $peersock }; my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; pass( "First request is made" ); $request_stream =~ s/^.*$CRLF$CRLF//s; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); my $e = eval { $loop->loop_once(0) for 1 .. 5; 1 } ? undef : $@; like( $e, qr/^Oopsie at \Q$0\E line \d+/, 'Oopsie exception caught at loop toplevel' ); wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; pass( "Second request is made after first one dies at ->done" ); $request_stream =~ s/^.*$CRLF$CRLF//s; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); wait_for_future( $f2 ); ok( !$f2->failure, '$f2 completes successfully' ); } # With on_error { my $error; $http->configure( on_error => sub { ( undef, $error ) = @_; }, ); my $f1 = $http->GET( "http://localhost:5000/1" ) ->on_done( sub { die "Oopsie" } ); my $f2 = $http->GET( "http://localhost:5000/2" ); wait_for { defined $peersock }; my $request_stream = ""; wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; pass( "First request is made" ); $request_stream =~ s/^.*$CRLF$CRLF//s; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); my $e = eval { $loop->loop_once(0) for 1 .. 5; 1 } ? undef : $@; ok( !defined $e, 'Loop toplevel does not catch exception' ) or diag( "Caught exception was: $e" ); like( $error, qr/^Oopsie at \Q$0\E line \d+/, 'Oopsie exception caught by on_error handler' ); wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; pass( "Second request is made after first one dies at ->done" ); $request_stream =~ s/^.*$CRLF$CRLF//s; $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . "Content-Length: 0$CRLF" . $CRLF ); wait_for_future( $f2 ); ok( !$f2->failure, '$f2 completes successfully' ); } done_testing; Net-Async-HTTP-0.48/t/91rt102547.t000444001750001750 252614021530440 14611 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use Net::Async::HTTP; # When connections failed, they weren't being removed from memory # so we'd slowly leak my $loop = IO::Async::Loop->new; testing_loop( $loop ); my $http = Net::Async::HTTP->new( max_connections_per_host => 2, ); $loop->add( $http ); my @conn_f; my @remove_f; no warnings 'redefine'; local *IO::Async::Loop::connect = sub { shift; my %args = @_; $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'"; $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'"; push @conn_f, my $f = $loop->new_future; return $f; }; my $old = \&IO::Async::Notifier::remove_from_parent; # Make sure these actually get removed! local *IO::Async::Notifier::remove_from_parent = sub { my $self = shift; push @remove_f, $self; return $old->($self, @_); }; my @f = map { $http->do_request(uri=>'http://localhost:5000/') } 0 .. 2; is( scalar @conn_f, 2, 'Two pending connect() attempts after two concurrent ->do_request' ); # Fail them all ( shift @conn_f )->fail( "Connection refused", connect => ) for 0 .. 2; ok( !@conn_f, 'No more pending connect() attempts' ); is( scalar @remove_f, 3, 'Three connect() attempts removed after connection failure' ); done_testing; Net-Async-HTTP-0.48/t/99pod.t000444001750001750 25714021530440 14252 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Net-Async-HTTP-0.48/t/privkey.pem000444001750001750 321314021530440 15330 0ustar00leoleo000000000000-----BEGIN RSA PRIVATE KEY----- MIIEowIBAAKCAQEAk9NZtcKAu9FqMKWOdtn5QHtqgMbVhiGmUfpR6ropmqFciu+V jZD+30WSBOzCEuO7bYSz5s5X33qi+lna3DzEfgJ4DvZtkO1D0Wg4zQn6oYA2ZhlC b0dnmW2eWEiTmDT375DLq5U3TMH9TWEtxgn5EXdV8gW2wyDxnx4ax5FTNx6X6Ek/ 7pr2G46+ezfON2jymYPCM23U7yROu/WlZ6vz3hnafSc9zCjHsdLRQVvjoBOCXuKx PCN0KppCMCq0cA43fe5Y5bQnLydhghsEpuWTJpd37ioWlV6lbqJpqinruOxwh4YY N8czxHZ1L+4A0Aoq3HLQpUleeLh1TdLv7OqSZQIDAQABAoIBABs/adnG8FOuVhSB b7EYnIj2Nrtl6xW+Phn+Ofs6NVD7TUOOxdJCV7hv6mpd+afhsjqNq1tvzWK0CDZ9 OYo+6TkQ23Bmm+uK0GVZAJ9Kp5f9Ogm3vjckwkPVoMpFFm+H0+uklOYbqwXK/BW3 Q+itDevaQ01JIFb3S5I4ylbewqf2A/KTfosVUgkrv4U1wcr8DYat8baplfy0sp0j Q9w8P4HH4UOZL9OAjKABXLw7xDc5kvYxG1aLPf55QryEHmyr3SpRxwnK0c7/LwHZ 1lqhKnyUiDzD/yyxNMzTWQeaohV6MMb2MysAx7AiL09WLzc4gIzUIQYfeiCdHSoQ vbN7IAECgYEAw9tcSDgyi+ucRY9DOtRDGeNONhgds6Hzkeed0eNap7qDfTeRcfsF 2sCgxStyAMmwx+cMrRwA3yINkcdc68RpKDCxADD7Mk6wxys4PkNAJYiV5giupMAp U1L276op+14yL36/DKAt95M6Xhp44l+Mvpfc001nrTW2SbeuoDD9wuUCgYEAwTgr VVOn4el3izYZua/S7rGO4nj/KaUfdZXUPqyqOYgirQy9DlhrJTdtHW3kc47jXDX4 OuSoa3Xqli2o7qFBKfUaZKrZmcwZD6L9Y0kKBj9s9DM1roMlA3wiBylJ/ZNughyi jMDhvVwWdwJaXOJBPgqBWggwWh48MuTZ49HHGYECgYB5vgPZvFznDnhf4JJYohJn qBw4kbr8qsF9Qyydh6YVNmF/VygoYnGcLTqB9ORzSuuBBsShYhPEnyUyJWtD/h2j ZsjPJqMt/S3zT5ExWpon+oO6rlDoha3qZlqqVOqtnjqxvSZCUdrg1npkfi4AAIa6 /ii8i5PTXdzGa8+3MVy7ZQKBgG5S0AtMVNNdJvDJ1y57AglgQKF3TNpOegP9pM6U cC2hWYtNdrU2Lxd06kyfbo28zHzeI/ocjT2uel99erOmRzrZxFQuaUizjKus+Nkz 3xFqLZ/RjZkzMHMo8ZT9Mk4jXDnWd8m+aCZi6kDRix714SK3hNwPSOxrzxuQKAk4 wmIBAoGBAK9F/ejKimwBpzQ0kv90i8j5NyGTJNnI/tjls/KaQrnI0b/VqqRnI/xk Dm1lJabaUAG5P51b2KwitnKo7/+dhcG2hOtxJdUKGPVLzeRhfEx1KXx8bTMg9nvu n5sP1sN9Sw+jjpHm3r+YD/+QNK1eiVcAO0D6FcxSRKQ5ztHZt1tw -----END RSA PRIVATE KEY----- Net-Async-HTTP-0.48/t/regen-certs.sh000555001750001750 14414021530440 15671 0ustar00leoleo000000000000#!/bin/sh openssl genrsa -out privkey.pem openssl req -new -x509 -key privkey.pem -out server.pem Net-Async-HTTP-0.48/t/server.pem000444001750001750 233514021530440 15151 0ustar00leoleo000000000000-----BEGIN CERTIFICATE----- MIIDazCCAlOgAwIBAgIUHVSMA9ScUWYlkkHEQWBDJr+wNTswDQYJKoZIhvcNAQEL BQAwRTELMAkGA1UEBhMCQVUxEzARBgNVBAgMClNvbWUtU3RhdGUxITAfBgNVBAoM GEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDAeFw0xOTAyMTcxNDA0MzZaFw0xOTAz MTkxNDA0MzZaMEUxCzAJBgNVBAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEw HwYDVQQKDBhJbnRlcm5ldCBXaWRnaXRzIFB0eSBMdGQwggEiMA0GCSqGSIb3DQEB AQUAA4IBDwAwggEKAoIBAQCT01m1woC70WowpY522flAe2qAxtWGIaZR+lHquima oVyK75WNkP7fRZIE7MIS47tthLPmzlffeqL6WdrcPMR+AngO9m2Q7UPRaDjNCfqh gDZmGUJvR2eZbZ5YSJOYNPfvkMurlTdMwf1NYS3GCfkRd1XyBbbDIPGfHhrHkVM3 HpfoST/umvYbjr57N843aPKZg8IzbdTvJE679aVnq/PeGdp9Jz3MKMex0tFBW+Og E4Je4rE8I3QqmkIwKrRwDjd97ljltCcvJ2GCGwSm5ZMml3fuKhaVXqVuommqKeu4 7HCHhhg3xzPEdnUv7gDQCircctClSV54uHVN0u/s6pJlAgMBAAGjUzBRMB0GA1Ud DgQWBBRcIn5rxKiGpScWWrKkmbJ64+09AjAfBgNVHSMEGDAWgBRcIn5rxKiGpScW WrKkmbJ64+09AjAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBCwUAA4IBAQBo PLlcaXaVvZ0K3fN+t3Ijs6QAWEZr0yH6WTT4g4+KTTSulIWAsNLaaTgbmb1qfJkz gGXXuhjNFY2BbD9YuBZP02SeNgc0vL/UnRCGTSy7akK6jV+v0fblwaye01Fg5Plp Yh114haTA9rwQ4geXKMl70KIoB71zR6MYcNPjDYHt0WiNJqGOgvYdO6d276AccDn CP66xnx9//7ynYcHcCkhf7+5YzUv7eiNo995W9A6xUWHLq52jj0DqCpwofIoJXHx CQ15c38qYcrmzG8X7oXL+vTLIvpj2tsRjPrf0q0Q+epHonxkxo6b+h/7g4mHyIig yEe8MNBTU/gOTGGL8XnK -----END CERTIFICATE-----