Build.PL100664001751001751 45513160135067 15144 0ustar00tokuhiromtokuhirom000000000000Furl-3.13# ========================================================================= # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. # DO NOT EDIT DIRECTLY. # ========================================================================= use 5.008_001; use strict; use Module::Build::Tiny 0.035; Build_PL(); Changes100664001751001751 2766413160135067 15216 0ustar00tokuhiromtokuhirom000000000000Furl-3.13Revision history for Perl module Furl 3.13 2017-09-19T06:31:34Z - Fixed test code(skaji++) 3.12 2017-09-13T06:58:15Z commit 88cd747c78d80675c1aa4953083af16f70085252 Author: Shoichi Kaji Date: Mon Aug 14 00:50:55 2017 +0900 check whether sockets are readable or not before reusing them commit 90f3e48ce20845e0f11be40bb975f9c23c86ad8a Author: ktat Date: Mon May 29 14:26:55 2017 +0900 uri_unescape user & password for Basic auth 3.11 2017-05-16T23:54:24Z - added docs 3.10 2017-04-05T16:52:32Z - Fix tests for newer Perl @INC issue 3.09 2016-07-21T14:10:52Z - Support 1xx status - Fix test on Windows issue - Fix httpoxy 3.08 2015-08-06T09:32:19Z - Handle cookies while redirection. (tokuhirom) - delete method accept message body (kimoto) 3.07 2015-04-21T03:42:39Z - Depends on latest Test::TCP https://github.com/tokuhirom/Test-TCP/issues/31#issuecomment-94378132 3.06 2015-02-09T23:05:09Z commit 8a7786905c101eeab9db1d7baa8c4ec2076f9514 Author: Jari Salmela Date: Fri Feb 6 08:36:55 2015 +0200 Update HTTP.pm fix for keep-alive as zmmail proposed. "In line 526 of Furl/HTTP.pm, FURL checks the HTTP response headers it gets from the server. It will read the C onnection from the response header there, and compare the header value with the string keep-alive. The problem is t hat this does not take into account a different case of the response header. Some HTTP server returns a header valu e of Keep-Alive (mind the caps), so FURL does not recognize it properly. I think the following change to Furl/HTTP.pm is more robust. if ($connection_header eq 'keep-alive') { if (lc($connection_header) eq 'keep-alive') {" commit 91ebdf86693c5bfbda497df167977813e2ad75aa Author: Kazuho Oku Date: Wed Dec 24 16:26:07 2014 +0900 fix incorrect regex used for testing the response line (amends #80) commit 65d0bc170a6344ebd24e0726a44260f3771fda0b Author: HIROSE Masaaki Date: Wed Dec 24 13:49:43 2014 +0900 Check only status code when connect SSL over proxy 3.05 2014-09-24T03:47:02Z - Validate content-length before processing. (Implemented by tokuhirom) (Reviewed by kazuho++) 3.04 2014-09-22T10:08:04Z - remove trailing whitespace of Authorization header (kazeburo++) 3.03 2014-07-09T23:33:51Z commit 8da0f43f2a6b3f04806288ce63a7bdc4df7f9a46 Author: Toshio Ito Date: Sat Jun 7 10:34:13 2014 +0900 t/100_low/07_timeout.t: iteratively increase content size instead of guessing the size of the se c.f: gh #71, gh #56 3.02 2014-03-18T20:52:07Z - Added new experimental cookie_jar support. (tokuhirom) 3.01 2014-02-13T06:19:47Z - Fixed documentation bug(Reported by Yappo++) 3.00 2013-11-13T09:39:38Z - implement inactivity_timeout (for read / write), requested by autarch++ (kazuho) - Implemented a new callback called `get_address`. That fixes the two shortcomings of the existing inet_aton callback listed below. * cannot override the port number * cannot support protocols other than IPv4 (e.g. IPv6, unix socket, ...) (kazuho) 2.19 2013-08-26T02:10:09Z - Testing fix for Starlet >= 0.20. force response HTTP/1.0. Starlet >= 0.20 support HTTP/1.1 (kazeburo) 2.18 2013-08-08T07:11:30Z - Furl::Response::decoded_content returns undef if user specifies 'Accept-Encoding' for data compression. Because content is already inflated, so HTTP::Message::decoded_content failed and return undef. (syohex) 2.17 2013-07-01T03:11:49Z - Fix Furl::Request#as_string the request contains ARRAY or HASH. (tokuhirom) 2.16 2013-05-22T07:48:21Z - Fix timeout problem(#56) on recent Linux(3.8 or later) (syohex) - Added Furl::Request#as_string (tokuhirom) 2.15 2013-05-10T08:40:10Z - Added Furl::Response#as_string. (tokuhirom) 2.14 2013-04-19T02:11:43Z - Fixed testing issue 2.13 2013-04-17T07:52:37Z - Tiny test fix. (tokuhirom) 2.12 2013-04-15T08:38:49Z - Clean up dependencies. I confused about 'recommends' and 'suggests'. Do not use 'recommends' for optional things. (tokuhirom) 2.11 2013-04-04T03:02:13Z - [EXPERIMENTAL] Added Furl::Response#encoding (tokuhirom) 2.10 2013-03-18T16:08:02 [INCOMPATIBLE CHANGES] - 'keep_request' parameter introduced in 2.08 was *removed*. - Furl::Response#request is always useful if you are using highlevel API. - Added Furl::Response#captured_req_content and Furl::Response#captured_req_headers 2.09 2013-03-07T06:59:44 - switch to cpanfile(no feature changes) (tokuhirom) 2.08 2013-03-06T18:42:22 - Added Furl::Request (ikasam_a) 2.07 2013-03-02T18:52:33 - added Furl::Response#to_psgi (tokuhirom) 2.06 2013-02-14T19:01:27 - Added Furl::Response#as_hashref 2.05 2013-02-12T15:00:31 [EXPERIMENTAL FEATURE] - Add "X-Internal-Respponse: 1" header for Internal response. It's compatible with LWP. (tokuhirom) - Reverted Client-Warning header introduced in 2.04 2.04 2013-02-12T14:28:53 [EXPERIMENTAL FEATURE] - Add "Client-Warning: Internal Response" header for Internal response. It's compatible with LWP. (tokuhirom) 2.03 2013-02-09T18:17:13 - Support URL based authorization. Both Proxy-Authorization and Basic Authorization. 2.02 2013-02-06T17:25:11 - Added Furl::Response#decoded_content (xaicron++) - Added Furl::Headers#clone (tokuhirom) 2.01 2013-01-23T19:17:47 - pass SSL_verifycn_name on connecting ssl over proxy. IO::Socket::SSL detects host name from PeerHost, but it can't when user is using proxy. (aska++) - SSL_verifycn_scheme is not required if skipping verification if skip verification, does not requires SSL_verifycn_scheme (kazeburo++) 2.00 2013-01-23T15:46:46 *** VERY IMPORTANT INCOMPATIBLE CHANGE *** - Furl verify SSL certs by default. If it's fail, furl returns error response. (tokuhirom) *** VERY IMPORTANT INCOMPATIBLE CHANGE *** 1.04 2013-01-22 - use `ssl_opts` option in SSL over http proxy (aska++) 1.03 2013-01-12 - fixed testing issue on perl 5.18 hash randomization (gfx) 1.02 2013-01-07 - Use Mozilla::CA if SSL_ca_file and SSL_ca_path is not set. This behavior respects LWP::Protocol::https. (tokuhirom) 1.01 2013-01-03 - added `ssl_opts` option to configuring IO::Socket::SSL (gfx) 1.00 2012-10-19 - Bump up version 0.42 2012-10-15 [INCOMPATIBLE CHANGE] - Furl::HTTP is no longer reading Furl.pm. This change may breaks your code. If you are using Furl class without loading Furl::HTTP, it will fail after this release. 0.41 2012-09-25 [BUG FIX] - Furl#agent does not works in past version. (Syohei YOSHIDA) 0.40 2012-06-04 - fixed meta data(Slaven++) https://github.com/tokuhirom/Furl/issues/35 0.39 2012-05-29 - unexpected eof in reading chunked body. It makes busy loop. (kazeburo++) 0.38 2011-09-05 - added ->agent method(bayashi++) 0.37 2011-08-24 - fixed SSL closing issue (reported by sugyan++, resolved by kazuho++, and implemented by gfx++) 0.36 2011-08-23 - win32 ssl proxy fix(mattn++) 0.35 2011-08-11 - Compensate for slash of path-query.(xaicron) 'http://example.com?foo=bar' → 'http://example.com/?foo=bar' 0.34 2011-07-15 - accept the domain using '_' charcter(xaicron) 0.33 2011-07-13 - support url doesn't have trailing slash like 'http://example.com?gfx=isogashi' (xaicron++) 0.32 2011-05-30 - remove duplicated Host header on high level API(xaicron) 0.31 2011-02-25 - CarpLevel++(xaicron) 0.30 2011-02-25 - allow '0000000' as end of chunked response. 0.29 2011-02-23 - move live tests to xt/. 0.28 2011-02-22 - fixed bug on proxy with redirect(mattn) 0.27 2011-02-20 - Add support for 307 (it was not handled as a redirect), with tests for all redirects. (307 is implemented the same as 301, preserving the original requesting method.) (audreyt++) 0.26 2011-02-17 - tiny pod fix(tokuhirom) 0.25 2011-02-16 - move fucking ssl test to xt/. 0.24 2011-02-08 - workaround for windows (mattn++, xaicron++) 0.23 2011-01-30 - properly implement Furl::env_proxy as a delegate to Furl::HTTP::env_proxy (as was already documented) (lestrrat) 0.22 2011-01-25 - Remove default ports from the Host header 0.21 2011-01-11 - use keep-alive on redirection, do not activate the "write_code" or the "write_func" feature when redirection(kazuho) - silently try to resend a request only when the server returned no respnose at all(kazuho) 0.20 2010-12-20 - add internal error response message to status message (tokuhirom) 0.19 2010-12-20 - fixed documentation bug(tokuhirom) - errorneously returned 500 error when closing of the socket was used to indicate eof (i.e. no Content-Encoding or Content-Length) (Kazuho Oku) 0.18 2010-12-06 - fixed testing issue(reported by many people) 0.17 2010-12-03 - only send the connection header with the highest precedence (Furl::request => Furl::new) (Kazuho Oku) - close the connection when furl requested as such, even if the server sent "connection: keep-alive" (Kazuho Oku) - support keep-alive for $furl->request(method => 'HEAD', headers => [ qw(connection keep-alive) ]) (Kazuho Oku) - always send the connection header (support for automatic keep-alive with HTTP/1.0 servers) (Kazuho Oku) 0.16 2010-12-01 - support for status codes wo. content(kazuho oku) 0.15 2010-11-28 - doc enhancements(tokuhirom) 0.14 2010-11-22 - changed the semantics of the "timeout" parameter from per-IO timeout to request timeout(Kazuho Oku) - optional support for name resolution timeouts using Net::DNS::Lite(Kazuho Oku) - make blocking operations cancellable (through the "stop_if" callback)(Kazuho Oku) 0.13 2010-11-15 - do not die when $content is empty string. 0.12 2010-11-10 - fixed testing issue. 0.11 2010-11-04 - fixed testing issue gh#6 (reported by ichesnokov) 0.10 2010-11-02 - change request() to accept HTTP::Request, and remove request_with_http_request(lestrrat) - Furl::ConnPool.pm was renamed to Furl::ConnectionCache.pm(tokuhirom) 0.09 2010-11-01 - fixed packaging. 0.08 2010-11-01 - rewrote connection pooling strategy(tokuhirom) (suggested by kazuho++) - updated docs(tokuhirom) - support relative url in redirection #5(tokuhirom) 0.07 2010-11-01 - Do not use reference_from, it makes installing issue(reported by y). http://github.com/tokuhirom/Furl/issues#issue/4 0.06 2010-10-31 - now Perl 5.8.1 or later is required.(tokuhirom) - High level interface is now available(tokuhirom) - Keep alive on HTTP/1.0(kazuho, gfx) - Retry requests if the connection is closed while in keep-alive(gfx) 0.05 2010-10-30 - use HTTP::Parser::XS - optimization - users can be set your own special headers. - fixed Deep recursion when redirect over max_redirects. - now, header_get is not public api. 0.04 2010-10-26 - fixed retval handling around Compress::Raw::Zlib(gfx) - Change chuked tests not to use Starman(gfx) - use binmode() for fucking win32(gfx) 0.03 2010-10-25 - support no_proxy - fixed keep-alive issue - fix ppport issue for perl < 5.12 - THX fix - doc fix - micro optimization - a lot of tweaks [0.02 not released] - doc enhancements - micro optimization - more test cases 0.01 2010-10-24 - original version LICENSE100664001751001751 4363413160135067 14723 0ustar00tokuhiromtokuhirom000000000000Furl-3.13This software is copyright (c) 2013 by unknown. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by unknown. 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, Suite 500, Boston, MA 02110-1335 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) 2013 by unknown. 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 META.json100664001751001751 1153413160135067 15331 0ustar00tokuhiromtokuhirom000000000000Furl-3.13{ "abstract" : "Lightning-fast URL fetcher", "author" : [ "Tokuhiro Matsuno " ], "dynamic_config" : 0, "generated_by" : "Minilla/v3.0.9", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Furl", "no_index" : { "directory" : [ "t", "xt", "inc", "share", "eg", "examples", "author", "builder" ] }, "prereqs" : { "configure" : { "requires" : { "Module::Build::Tiny" : "0.035" } }, "develop" : { "requires" : { "Test::CPAN::Meta" : "0", "Test::MinimumVersion::Fast" : "0.04", "Test::PAUSE::Permissions" : "0.04", "Test::Pod" : "1.41", "Test::Spellunker" : "v0.2.7" }, "suggests" : { "Child" : "0", "Getopt::Long" : "0", "HTTP::Lite" : "0", "IO::Callback" : "0", "LWP::UserAgent" : "0", "Net::DNS::Lite" : "0", "Net::IDN::Encode" : "0", "Plack::Loader" : "0", "Starman" : "0", "Test::LeakTrace" : "0", "Test::More" : "0", "Test::Requires" : "0", "Test::TCP" : "0", "URI" : "0", "WWW::Curl::Easy" : "4.14", "autodie" : "0", "parent" : "0" } }, "runtime" : { "recommends" : { "Compress::Raw::Zlib" : "0", "HTTP::CookieJar" : "0", "IO::Socket::SSL" : "0", "Net::IDN::Encode" : "0" }, "requires" : { "Class::Accessor::Lite" : "0", "Encode" : "0", "HTTP::Parser::XS" : "0.11", "MIME::Base64" : "0", "Mozilla::CA" : "0", "Scalar::Util" : "0", "Socket" : "0", "Time::HiRes" : "0", "perl" : "5.008001" }, "suggests" : { "HTTP::Headers" : "0", "HTTP::Request" : "0", "HTTP::Response" : "0" } }, "test" : { "requires" : { "File::Temp" : "0", "Test::More" : "0.96", "Test::Requires" : "0", "Test::TCP" : "2.11" }, "suggests" : { "HTTP::CookieJar" : "0", "HTTP::Proxy" : "0", "HTTP::Server::PSGI" : "0", "Plack" : "0", "Plack::Loader" : "0", "Plack::Request" : "0", "Starlet::Server" : "0", "Test::Fake::HTTPD" : "0", "Test::SharedFork" : "0", "Test::Valgrind" : "0", "URI" : "0", "parent" : "0" } } }, "provides" : { "Furl" : { "file" : "lib/Furl.pm", "version" : "3.13" }, "Furl::ConnectionCache" : { "file" : "lib/Furl/ConnectionCache.pm" }, "Furl::HTTP" : { "file" : "lib/Furl/HTTP.pm", "version" : "3.13" }, "Furl::Headers" : { "file" : "lib/Furl/Headers.pm" }, "Furl::Request" : { "file" : "lib/Furl/Request.pm" }, "Furl::Response" : { "file" : "lib/Furl/Response.pm" }, "Furl::ZlibStream" : { "file" : "lib/Furl/ZlibStream.pm" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/tokuhirom/Furl/issues" }, "homepage" : "https://github.com/tokuhirom/Furl", "repository" : { "url" : "git://github.com/tokuhirom/Furl.git", "web" : "https://github.com/tokuhirom/Furl" } }, "version" : "3.13", "x_contributors" : [ "Keiji, Yoshimi ", "Fuji, Goro ", "lestrrat ", "Audrey Tang ", "Fuji Goro ", "Fuji, Goro ", "s-aska ", "ikasam_a ", "xaicron ", "Neil Bowers ", "Toshio Ito ", "bayashi ", "Masahiro Nagano ", "HIROSE Masaaki ", "Kazuho Oku ", "Jari Salmela ", "tarao ", "kimoto ", "Breno G. de Oliveira ", "Jiro Nishiguchi ", "Yasuhiro Matsumoto ", "Syohei YOSHIDA ", "ktat ", "Shoichi Kaji " ], "x_serialization_backend" : "JSON::PP version 2.27400" } README.md100664001751001751 2171613160135067 15172 0ustar00tokuhiromtokuhirom000000000000Furl-3.13# NAME Furl - Lightning-fast URL fetcher # SYNOPSIS use Furl; my $furl = Furl->new( agent => 'MyGreatUA/2.0', timeout => 10, ); my $res = $furl->get('http://example.com/'); die $res->status_line unless $res->is_success; print $res->content; my $res = $furl->post( 'http://example.com/', # URL [...], # headers [ foo => 'bar' ], # form data (HashRef/FileHandle are also okay) ); # Accept-Encoding is supported but optional $furl = Furl->new( headers => [ 'Accept-Encoding' => 'gzip' ], ); my $body = $furl->get('http://example.com/some/compressed'); # DESCRIPTION Furl is yet another HTTP client library. LWP is the de facto standard HTTP client for Perl 5, but it is too slow for some critical jobs, and too complex for weekend hacking. Furl resolves these issues. Enjoy it! # INTERFACE ## Class Methods ### `Furl->new(%args | \%args) :Furl` Creates and returns a new Furl client with _%args_. Dies on errors. _%args_ might be: - agent :Str = "Furl/$VERSION" - timeout :Int = 10 - max\_redirects :Int = 7 - capture\_request :Bool = false If this parameter is true, [Furl::HTTP](https://metacpan.org/pod/Furl::HTTP) captures raw request string. You can get it by `$res->captured_req_headers` and `$res->captured_req_content`. - proxy :Str - no\_proxy :Str - headers :ArrayRef - cookie\_jar :Object (EXPERIMENTAL) An instance of HTTP::CookieJar or equivalent class that supports the add and cookie\_header methods ## Instance Methods ### `$furl->request([$request,] %args) :Furl::Response` Sends an HTTP request to a specified URL and returns a instance of [Furl::Response](https://metacpan.org/pod/Furl::Response). _%args_ might be: - scheme :Str = "http" Protocol scheme. May be `http` or `https`. - host :Str Server host to connect. You must specify at least `host` or `url`. - port :Int = 80 Server port to connect. The default is 80 on `scheme => 'http'`, or 443 on `scheme => 'https'`. - path\_query :Str = "/" Path and query to request. - url :Str URL to request. You can use `url` instead of `scheme`, `host`, `port` and `path_query`. - headers :ArrayRef HTTP request headers. e.g. `headers => [ 'Accept-Encoding' => 'gzip' ]`. - content : Str | ArrayRef\[Str\] | HashRef\[Str\] | FileHandle Content to request. If the number of arguments is an odd number, this method assumes that the first argument is an instance of `HTTP::Request`. Remaining arguments can be any of the previously describe values (but currently there's no way to really utilize them, so don't use it) my $req = HTTP::Request->new(...); my $res = $furl->request($req); You can also specify an object other than HTTP::Request (e.g. Furl::Request), but the object must implement the following methods: - uri - method - content - headers These must return the same type of values as their counterparts in `HTTP::Request`. You must encode all the queries or this method will die, saying `Wide character in ...`. ### `$furl->get($url :Str, $headers :ArrayRef[Str] )` This is an easy-to-use alias to `request()`, sending the `GET` method. ### `$furl->head($url :Str, $headers :ArrayRef[Str] )` This is an easy-to-use alias to `request()`, sending the `HEAD` method. ### `$furl->post($url :Str, $headers :ArrayRef[Str], $content :Any)` This is an easy-to-use alias to `request()`, sending the `POST` method. ### `$furl->put($url :Str, $headers :ArrayRef[Str], $content :Any)` This is an easy-to-use alias to `request()`, sending the `PUT` method. ### `$furl->delete($url :Str, $headers :ArrayRef[Str] )` This is an easy-to-use alias to `request()`, sending the `DELETE` method. ### `$furl->env_proxy()` Loads proxy settings from `$ENV{HTTP_PROXY}` and `$ENV{NO_PROXY}`. # TIPS - [IO::Socket::SSL](https://metacpan.org/pod/IO::Socket::SSL) preloading Furl interprets the `timoeut` argument as the maximum time the module is permitted to spend before returning an error. The module also lazy-loads [IO::Socket::SSL](https://metacpan.org/pod/IO::Socket::SSL) when an HTTPS request is being issued for the first time. Loading the module usually takes ~0.1 seconds. The time spent for loading the SSL module may become an issue in case you want to impose a very small timeout value for connection establishment. In such case, users are advised to preload the SSL module explicitly. # FAQ - Does Furl depends on XS modules? No. Although some optional features require XS modules, basic features are available without XS modules. Note that Furl requires HTTP::Parser::XS, which seems an XS module but includes a pure Perl backend, HTTP::Parser::XS::PP. - I need more speed. See [Furl::HTTP](https://metacpan.org/pod/Furl::HTTP), which provides the low level interface of [Furl](https://metacpan.org/pod/Furl). It is faster than `Furl.pm` since [Furl::HTTP](https://metacpan.org/pod/Furl::HTTP) does not create response objects. - How do you use cookie\_jar? Furl does not directly support the cookie\_jar option available in LWP. You can use [HTTP::Cookies](https://metacpan.org/pod/HTTP::Cookies), [HTTP::Request](https://metacpan.org/pod/HTTP::Request), [HTTP::Response](https://metacpan.org/pod/HTTP::Response) like following. my $f = Furl->new(); my $cookies = HTTP::Cookies->new(); my $req = HTTP::Request->new(...); $cookies->add_cookie_header($req); my $res = $f->request($req)->as_http_response; $res->request($req); $cookies->extract_cookies($res); # and use $res. - How do you limit the response content length? You can limit the content length by callback function. my $f = Furl->new(); my $content = ''; my $limit = 1_000_000; my %special_headers = ('content-length' => undef); my $res = $f->request( method => 'GET', url => $url, special_headers => \%special_headers, write_code => sub { my ( $status, $msg, $headers, $buf ) = @_; if (($special_headers{'content-length'}||0) > $limit || length($content) > $limit) { die "over limit: $limit"; } $content .= $buf; } ); - How do you display the progress bar? my $bar = Term::ProgressBar->new({count => 1024, ETA => 'linear'}); $bar->minor(0); $bar->max_update_rate(1); my $f = Furl->new(); my $content = ''; my %special_headers = ('content-length' => undef);; my $did_set_target = 0; my $received_size = 0; my $next_update = 0; $f->request( method => 'GET', url => $url, special_headers => \%special_headers, write_code => sub { my ( $status, $msg, $headers, $buf ) = @_; unless ($did_set_target) { if ( my $cl = $special_headers{'content-length'} ) { $bar->target($cl); $did_set_target++; } else { $bar->target( $received_size + 2 * length($buf) ); } } $received_size += length($buf); $content .= $buf; $next_update = $bar->update($received_size) if $received_size >= $next_update; } ); - HTTPS requests claims warnings! When you make https requests, IO::Socket::SSL may complain about it like: ******************************************************************* Using the default of SSL_verify_mode of SSL_VERIFY_NONE for client is depreciated! Please set SSL_verify_mode to SSL_VERIFY_PEER together with SSL_ca_file|SSL_ca_path for verification. If you really don't want to verify the certificate and keep the connection open to Man-In-The-Middle attacks please set SSL_verify_mode explicitly to SSL_VERIFY_NONE in your application. ******************************************************************* You should set `SSL_verify_mode` explicitly with Furl's `ssl_opts`. use IO::Socket::SSL; my $ua = Furl->new( ssl_opts => { SSL_verify_mode => SSL_VERIFY_PEER(), }, ); See [IO::Socket::SSL](https://metacpan.org/pod/IO::Socket::SSL) for details. # AUTHOR Tokuhiro Matsuno Fuji, Goro (gfx) # THANKS TO Kazuho Oku mala mattn lestrrat walf443 lestrrat audreyt # SEE ALSO [LWP](https://metacpan.org/pod/LWP) [IO::Socket::SSL](https://metacpan.org/pod/IO::Socket::SSL) [Furl::HTTP](https://metacpan.org/pod/Furl::HTTP) [Furl::Response](https://metacpan.org/pod/Furl::Response) # LICENSE Copyright (C) Tokuhiro Matsuno. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. TODO100664001751001751 14113160135067 14330 0ustar00tokuhiromtokuhirom000000000000Furl-3.13- max_redirects - redirect support - win32 support - ssl support - 多言語ドメイン support byown.pl100664001751001751 316013160135067 20613 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/author/benchmarkuse strict; use warnings; use autodie; use Benchmark ':all'; use Starman; use LWP::UserAgent; use WWW::Curl::Easy 4.14; use Furl::HTTP; use Child; use Test::TCP qw/empty_port/; use Plack::Loader; use Config; use HTTP::Lite; printf "Perl/%vd on %s\n", $^V, $Config{archname}; printf "Furl/$Furl::VERSION, LWP/$LWP::VERSION, WWW::Curl/$WWW::Curl::VERSION, HTTP::Lite/$HTTP::Lite::VERSION, libcurl[@{[ WWW::Curl::Easy::version() ]}]\n"; my $port = empty_port(); my $ua = LWP::UserAgent->new(parse_head => 0, keep_alive => 1); my $curl = WWW::Curl::Easy->new(); my $furl = Furl::HTTP->new(parse_header => 0); my $url = "http://127.0.0.1:$port/foo/bar"; my $child = Child->new( sub { Plack::Loader->load( 'Starman', port => $port ) ->run( sub { [ 200, ['Content-Length' => length('Hi')], ['Hi'] ] } ); } ); my $proc = $child->start(); cmpthese( -1, { lwp => sub { my $res = $ua->get($url); }, curl => sub { my @headers; $curl->setopt(CURLOPT_URL, $url); $curl->setopt(CURLOPT_HTTPGET, 1); $curl->setopt(CURLOPT_HEADER, 0); $curl->setopt(CURLOPT_NOPROGRESS, 1); $curl->setopt(CURLOPT_HEADERFUNCTION, sub { push @headers, @_; length($_[0]); }); my $content = ''; $curl->setopt(CURLOPT_WRITEDATA, \$content); $curl->perform(); my $code = $curl->getinfo(CURLINFO_HTTP_CODE); }, furl => sub { $furl->request(method => 'GET', url => $url); }, }, ); $proc->kill('TERM'); note.mkdn100664001751001751 1652613160135067 20772 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/author/benchmark### On tokuhirom's SC440 0.01 3534c7b341136a18bd52449af6e28570ca87a36f Rate lwp furl curl lwp 792/s -- -88% -90% furl 6461/s 715% -- -15% curl 7587/s 857% 17% -- 0.02 fbb922531d3236b2da84acd0c22f554e61060446 Rate lwp http_lite furl curl lwp 823/s -- -8% -74% -89% http_lite 896/s 9% -- -72% -88% furl 3170/s 285% 254% -- -59% curl 7657/s 831% 754% 142% -- 25998b62ae12445ae0a8bdd5329ffe8f9bd71dd2 Rate lwp http_lite furl curl lwp 792/s -- -25% -76% -91% http_lite 1056/s 33% -- -68% -88% furl 3326/s 320% 215% -- -62% curl 8783/s 1010% 732% 164% -- 496a941ca1fd8cfcc8925c91fab501d516fdfa8e fixed bug. Rate lwp http_lite furl curl lwp 767/s -- -27% -88% -91% http_lite 1046/s 36% -- -84% -88% furl 6461/s 742% 518% -- -26% curl 8783/s 1045% 740% 36% -- #### micro optimization commit c8f4c4655966ecb1b2fef98769a72e437dd467fe Perl/5.12.1 on x86_64-linux Furl/0.02, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2 Server: nginx/0.8.48 -- Rate lwp http_lite furl curl lwp 800/s -- -23% -88% -91% http_lite 1036/s 30% -- -84% -88% furl 6587/s 723% 536% -- -24% curl 8650/s 981% 735% 31% -- #### 0.04 0065f2144c7636fc79ae1b30ae01c8e5f25de178 Perl/5.12.1 on x86_64-linux Furl/0.04, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2 Server: nginx/0.8.48 -- Rate lwp http_lite furl curl lwp 807/s -- -23% -88% -91% http_lite 1046/s 30% -- -84% -88% furl 6698/s 730% 540% -- -22% curl 8615/s 968% 724% 29% -- #### http-parser-xs 9cf2a06ee9aed52232effdeb432f5a6668f42636 Perl/5.12.1 on x86_64-linux Furl/0.04, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18] Server: nginx/0.8.48 Content-Length: 2947 -- Rate lwp http_lite furl curl lwp 800/s -- -24% -88% -91% http_lite 1047/s 31% -- -84% -88% furl 6575/s 722% 528% -- -25% curl 8727/s 991% 734% 33% -- ##### same revsion, but access to real server 9cf2a06ee9aed52232effdeb432f5a6668f42636 Perl/5.12.1 on x86_64-linux Furl/0.04, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18] Server: Apache -- Rate lwp http_lite furl curl lwp 111/s -- -61% -62% -81% http_lite 288/s 159% -- -3% -50% furl 296/s 166% 3% -- -49% curl 581/s 422% 102% 96% -- ##### 1MB response 7389e930aa93b20a56eb2e7a9408c4b2ff056c8d Perl/5.12.1 on x86_64-linux Furl/0.04, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18] Date: Fri, 29 Oct 2010 11:43:37 GMT Server: KyotoTycoon/0.8.1 Content-Length: 1000000 Client-Date: Fri, 29 Oct 2010 11:43:37 GMT Client-Peer: 127.0.0.1:1978 Client-Response-Num: 1 -- Rate lwp http_lite furl curl lwp 74.1/s -- -62% -72% -90% http_lite 196/s 165% -- -26% -74% furl 265/s 258% 35% -- -65% curl 760/s 926% 287% 187% -- ### useragent branch. fbe216421eaa343ed86a8a3636a9ac3925018f61 Perl/5.12.1 on x86_64-linux Furl/0.04, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18] -- Connection: keep-alive Date: Mon, 01 Nov 2010 03:16:02 GMT Accept-Ranges: bytes Server: nginx/0.8.48 Content-Length: 2947 Content-Type: text/html Last-Modified: Sat, 05 Jun 2010 23:53:36 GMT Client-Date: Mon, 01 Nov 2010 03:16:02 GMT Client-Peer: 192.168.1.3:80 Client-Response-Num: 1 -- bufsize: 10240 -- Rate lwp http_lite furl_high furl_low curl lwp 799/s -- -24% -83% -88% -91% http_lite 1057/s 32% -- -78% -84% -88% furl_high 4699/s 488% 345% -- -31% -46% furl_low 6762/s 746% 540% 44% -- -22% curl 8650/s 982% 719% 84% 28% -- ### 0.07 58868db2dbe06394ac6b8344fbbf47acf334daf1 Perl/5.12.1 on x86_64-linux Furl/0.07, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18] -- Connection: keep-alive Date: Tue, 02 Nov 2010 00:24:44 GMT Accept-Ranges: bytes Server: nginx/0.8.48 Content-Length: 2947 Content-Type: text/html Last-Modified: Sat, 05 Jun 2010 23:53:36 GMT Client-Date: Tue, 02 Nov 2010 00:24:44 GMT Client-Peer: 192.168.1.3:80 Client-Response-Num: 1 -- bufsize: 10240 -- Rate lwp http_lite furl_high furl_low curl lwp 792/s -- -24% -83% -88% -91% http_lite 1046/s 32% -- -78% -84% -88% furl_high 4757/s 501% 355% -- -25% -45% furl_low 6342/s 701% 506% 33% -- -27% curl 8650/s 993% 727% 82% 36% -- ### kazuho perl -Ilib benchmperl -Ilib benchmark/simple.pl [~/dev/Furl] 水 17 19:05 65d1df9882c8f5330f9cc93a03722887867e303c Perl/5.12.1 on x86_64-linux Furl/0.13, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18] -- Connection: keep-alive Date: Wed, 17 Nov 2010 10:05:52 GMT Accept-Ranges: bytes Server: nginx/0.8.48 Content-Length: 2947 Content-Type: text/html Last-Modified: Sat, 05 Jun 2010 23:53:36 GMT Client-Date: Wed, 17 Nov 2010 10:05:52 GMT Client-Peer: 192.168.1.3:80 Client-Response-Num: 1 -- bufsize: 10240 -- Rate lwp http_lite furl_high furl_low curl lwp 800/s -- -24% -79% -84% -91% http_lite 1056/s 32% -- -72% -79% -88% furl_high 3759/s 370% 256% -- -24% -57% furl_low 4978/s 522% 372% 32% -- -43% curl 8698/s 987% 724% 131% 75% -- profile.pl100664001751001751 114113160135067 21112 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/author/benchmarkuse strict; use warnings; use Furl::HTTP qw/HEADERS_NONE HEADERS_AS_ARRAYREF/; use URI; my $url = shift @ARGV || 'http://127.0.0.1:80/'; my $uri = URI->new($url); my $host = $uri->host; my $port = $uri->port; my $path_query = $uri->path_query; my $furl = Furl::HTTP->new(header_format => HEADERS_NONE, bufsize => 10_000_000); for (1..1000) { my ( $version, $code, $msg, $headers, $content ) = $furl->request( method => 'GET', host => $host, port => $port, path_query => $path_query, ); $code == 200 or die "oops : $code, $content"; } simple.pl100664001751001751 671313160135067 20755 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/author/benchmarkuse strict; use warnings; use Benchmark ':all'; use LWP::UserAgent; use WWW::Curl::Easy 4.14; use HTTP::Lite; use Furl::HTTP qw/HEADERS_NONE HEADERS_AS_ARRAYREF/; use Furl; use Config; use Getopt::Long; GetOptions( 'busize=i' => \my $bufsize, ); printf `git rev-parse HEAD`; printf "Perl/%vd on %s\n", $^V, $Config{archname}; printf "Furl/$Furl::VERSION, LWP/$LWP::VERSION, WWW::Curl/$WWW::Curl::VERSION, HTTP::Lite/$HTTP::Lite::VERSION, libcurl[@{[ WWW::Curl::Easy::version() ]}]\n"; my $url = shift @ARGV || 'http://192.168.1.3:80/'; my $ua = LWP::UserAgent->new(parse_head => 0, keep_alive => 1); my $curl = WWW::Curl::Easy->new(); my $furl_low = Furl::HTTP->new(header_format => HEADERS_NONE); my $furl_high = Furl->new(); $furl_high->{bufsize} = $bufsize if defined $bufsize; $furl_low->{bufsize} = $bufsize if defined $bufsize; my $uri = URI->new($url); my $host = $uri->host; my $scheme = $uri->scheme; my $port = $uri->port; my $path_query = $uri->path_query; my $lite = HTTP::Lite->new(); $lite->http11_mode(1); my $res = $ua->get($url); print "--\n"; print $res->headers_as_string; print "--\n"; printf "bufsize: %d\n", $furl_low->{bufsize}; print "--\n\n"; my $body_content_length = length($res->content); $body_content_length == $res->content_length or die; cmpthese( -1, { http_lite => sub { my $req = $lite->request($url) or die; $lite->status == 200 or die; length($lite->body) == $body_content_length or die "Lite failed: @{[ length($lite->body) ]} != $body_content_length"; $lite->reset(); # This is *required* for re-use instance. }, lwp => sub { my $res = $ua->get($url); $res->code == 200 or die; length($res->content) == $body_content_length or die; }, curl => sub { my @headers; $curl->setopt(CURLOPT_HEADER, 0); $curl->setopt(CURLOPT_NOPROGRESS, 1); $curl->setopt(CURLOPT_URL, $url); $curl->setopt(CURLOPT_HTTPGET, 1); $curl->setopt(CURLOPT_HEADERFUNCTION, sub { push @headers, @_; length($_[0]); }); my $content = ''; $curl->setopt(CURLOPT_WRITEDATA, \$content); my $ret = $curl->perform(); $ret == 0 or die "$ret : " . $curl->strerror($ret); my $code = $curl->getinfo(CURLINFO_HTTP_CODE); $code == 200 or die "oops: $code"; length($content) == $body_content_length or die; }, furl_high => sub { my $res = $furl_high->request( method => 'GET', host => $host, port => $port, scheme => $scheme, path_query => $path_query, headers => [ 'Content-Length' => 0 ] ); $res->code == 200 or die "oops"; length($res->content) == $body_content_length or die; }, furl_low => sub { my ( $version, $code, $msg, $headers, $content ) = $furl_low->request( method => 'GET', host => $host, port => $port, scheme => $scheme, path_query => $path_query, headers => [ 'Content-Length' => 0 ] ); $code == 200 or die "oops: $code, $content"; length($content) == $body_content_length or die; }, }, ); mk-chunked-response.pl100664001751001751 123313160135067 21404 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/author#!perl -w use strict; use Furl; use Plack::Loader; use Child; { package Furl::Verbose; use parent qw(Furl); sub read_timeout { my $self = shift; my $ret = $self->SUPER::read_timeout(@_); print ${$_[1]}; return $ret; } } my $content = "The quick brown fox jumps over the lazy dog.\n" x 100; my $child = Child->new( sub { Plack::Loader->load('Starman', host => '127.0.0.1', port => 1234 ) ->run( sub { [ 200, ['Transfer-Encoding' => 'chunked' ], [$content] ] } ); } ); my $proc = $child->start(); sleep 1; Furl::Verbose->new->get('http://127.0.0.1:1234/'); $proc->kill('TERM'); cpanfile100664001751001751 307413160135067 15374 0ustar00tokuhiromtokuhirom000000000000Furl-3.13requires 'perl', 5.008_001; requires 'HTTP::Parser::XS' => 0.11; requires 'Mozilla::CA'; requires 'MIME::Base64'; requires 'Class::Accessor::Lite'; requires 'Encode'; requires 'Scalar::Util'; requires 'Socket'; requires 'Time::HiRes'; suggests 'HTTP::Headers'; # Furl::Headers suggests 'HTTP::Request'; # Furl::Request suggests 'HTTP::Response'; # Furl::Response recommends 'Net::IDN::Encode'; # for International Domain Name recommends 'IO::Socket::SSL'; # for SSL recommends 'Compress::Raw::Zlib'; # for Content-Encoding recommends 'HTTP::CookieJar'; on test => sub { requires 'Test::More' => 0.96; # done_testing, subtest requires 'Test::TCP' => '2.11'; requires 'Test::Requires'; requires 'File::Temp'; suggests 'Test::Fake::HTTPD'; suggests 'HTTP::Proxy'; suggests 'HTTP::Server::PSGI'; suggests 'Plack::Loader'; suggests 'Plack::Request'; suggests 'Starlet::Server'; suggests 'Test::SharedFork'; suggests 'URI'; suggests 'parent'; suggests 'Plack'; suggests 'Test::Valgrind'; suggests 'HTTP::CookieJar'; }; on develop => sub { suggests 'Child'; suggests 'Getopt::Long'; suggests 'HTTP::Lite'; suggests 'LWP::UserAgent'; suggests 'Plack::Loader'; suggests 'Starman'; suggests 'Test::More'; suggests 'Test::Requires'; suggests 'Test::TCP'; suggests 'URI'; suggests 'WWW::Curl::Easy', '4.14'; suggests 'IO::Callback'; suggests 'autodie'; suggests 'parent'; suggests 'Net::IDN::Encode'; suggests 'Test::LeakTrace'; suggests 'Net::DNS::Lite'; }; get.pl100664001751001751 35613160135067 16417 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/example#!perl -w use strict; use Furl; use HTTP::Response; my $uri = shift(@ARGV) or die "Usage: $0 URI\n"; my $furl = Furl->new(headers => ['Accept-Encoding' => 'gzip']); $furl->env_proxy; print $furl->get($uri)->as_http_response->as_string; Furl.pm100664001751001751 2566513160135067 15736 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/libpackage Furl; use strict; use warnings; use utf8; use Furl::HTTP; use Furl::Request; use Furl::Response; use Carp (); our $VERSION = '3.13'; use 5.008001; $Carp::Internal{+__PACKAGE__} = 1; sub new { my $class = shift; bless \(Furl::HTTP->new(header_format => Furl::HTTP::HEADERS_AS_HASHREF(), @_)), $class; } sub get { my ( $self, $url, $headers ) = @_; $self->request( method => 'GET', url => $url, headers => $headers ); } sub head { my ( $self, $url, $headers ) = @_; $self->request( method => 'HEAD', url => $url, headers => $headers ); } sub post { my ( $self, $url, $headers, $content ) = @_; $self->request( method => 'POST', url => $url, headers => $headers, content => $content ); } sub put { my ( $self, $url, $headers, $content ) = @_; $self->request( method => 'PUT', url => $url, headers => $headers, content => $content ); } sub delete { my ( $self, $url, $headers, $content ) = @_; $self->request( method => 'DELETE', url => $url, headers => $headers, content => $content ); } sub agent { @_ == 2 ? ${$_[0]}->agent($_[1]) : ${$_[0]}->agent; } sub env_proxy { my $self = shift; $$self->env_proxy; } sub request { my $self = shift; my %args; if (@_ % 2 == 0) { %args = @_; } else { # convert HTTP::Request to hash for Furl::HTTP. my $req = shift; %args = @_; my $req_headers= $req->headers; $req_headers->remove_header('Host'); # suppress duplicate Host header my $headers = +[ map { my $k = $_; map { ( $k => $_ ) } $req_headers->header($_); } $req_headers->header_field_names ]; $args{url} = $req->uri; $args{method} = $req->method; $args{content} = $req->content; $args{headers} = $headers; } my ( $res_minor_version, $res_status, $res_msg, $res_headers, $res_content, $captured_req_headers, $captured_req_content, $captured_res_headers, $captured_res_content, $request_info, ) = ${$self}->request(%args); my $res = Furl::Response->new($res_minor_version, $res_status, $res_msg, $res_headers, $res_content); $res->set_request_info(\%args, $captured_req_headers, $captured_req_content); return $res; } 1; __END__ =encoding utf8 =head1 NAME Furl - Lightning-fast URL fetcher =head1 SYNOPSIS use Furl; my $furl = Furl->new( agent => 'MyGreatUA/2.0', timeout => 10, ); my $res = $furl->get('http://example.com/'); die $res->status_line unless $res->is_success; print $res->content; my $res = $furl->post( 'http://example.com/', # URL [...], # headers [ foo => 'bar' ], # form data (HashRef/FileHandle are also okay) ); # Accept-Encoding is supported but optional $furl = Furl->new( headers => [ 'Accept-Encoding' => 'gzip' ], ); my $body = $furl->get('http://example.com/some/compressed'); =head1 DESCRIPTION Furl is yet another HTTP client library. LWP is the de facto standard HTTP client for Perl 5, but it is too slow for some critical jobs, and too complex for weekend hacking. Furl resolves these issues. Enjoy it! =head1 INTERFACE =head2 Class Methods =head3 C<< Furl->new(%args | \%args) :Furl >> Creates and returns a new Furl client with I<%args>. Dies on errors. I<%args> might be: =over =item agent :Str = "Furl/$VERSION" =item timeout :Int = 10 =item max_redirects :Int = 7 =item capture_request :Bool = false If this parameter is true, L captures raw request string. You can get it by C<< $res->captured_req_headers >> and C<< $res->captured_req_content >>. =item proxy :Str =item no_proxy :Str =item headers :ArrayRef =item cookie_jar :Object (EXPERIMENTAL) An instance of HTTP::CookieJar or equivalent class that supports the add and cookie_header methods =back =head2 Instance Methods =head3 C<< $furl->request([$request,] %args) :Furl::Response >> Sends an HTTP request to a specified URL and returns a instance of L. I<%args> might be: =over =item scheme :Str = "http" Protocol scheme. May be C or C. =item host :Str Server host to connect. You must specify at least C or C. =item port :Int = 80 Server port to connect. The default is 80 on C<< scheme => 'http' >>, or 443 on C<< scheme => 'https' >>. =item path_query :Str = "/" Path and query to request. =item url :Str URL to request. You can use C instead of C, C, C and C. =item headers :ArrayRef HTTP request headers. e.g. C<< headers => [ 'Accept-Encoding' => 'gzip' ] >>. =item content : Str | ArrayRef[Str] | HashRef[Str] | FileHandle Content to request. =back If the number of arguments is an odd number, this method assumes that the first argument is an instance of C. Remaining arguments can be any of the previously describe values (but currently there's no way to really utilize them, so don't use it) my $req = HTTP::Request->new(...); my $res = $furl->request($req); You can also specify an object other than HTTP::Request (e.g. Furl::Request), but the object must implement the following methods: =over 4 =item uri =item method =item content =item headers =back These must return the same type of values as their counterparts in C. You must encode all the queries or this method will die, saying C. =head3 C<< $furl->get($url :Str, $headers :ArrayRef[Str] ) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->head($url :Str, $headers :ArrayRef[Str] ) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->post($url :Str, $headers :ArrayRef[Str], $content :Any) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->put($url :Str, $headers :ArrayRef[Str], $content :Any) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->delete($url :Str, $headers :ArrayRef[Str] ) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->env_proxy() >> Loads proxy settings from C<< $ENV{HTTP_PROXY} >> and C<< $ENV{NO_PROXY} >>. =head1 TIPS =over 4 =item L preloading Furl interprets the C argument as the maximum time the module is permitted to spend before returning an error. The module also lazy-loads L when an HTTPS request is being issued for the first time. Loading the module usually takes ~0.1 seconds. The time spent for loading the SSL module may become an issue in case you want to impose a very small timeout value for connection establishment. In such case, users are advised to preload the SSL module explicitly. =back =head1 FAQ =over 4 =item Does Furl depends on XS modules? No. Although some optional features require XS modules, basic features are available without XS modules. Note that Furl requires HTTP::Parser::XS, which seems an XS module but includes a pure Perl backend, HTTP::Parser::XS::PP. =item I need more speed. See L, which provides the low level interface of L. It is faster than C since L does not create response objects. =item How do you use cookie_jar? Furl does not directly support the cookie_jar option available in LWP. You can use L, L, L like following. my $f = Furl->new(); my $cookies = HTTP::Cookies->new(); my $req = HTTP::Request->new(...); $cookies->add_cookie_header($req); my $res = $f->request($req)->as_http_response; $res->request($req); $cookies->extract_cookies($res); # and use $res. =item How do you limit the response content length? You can limit the content length by callback function. my $f = Furl->new(); my $content = ''; my $limit = 1_000_000; my %special_headers = ('content-length' => undef); my $res = $f->request( method => 'GET', url => $url, special_headers => \%special_headers, write_code => sub { my ( $status, $msg, $headers, $buf ) = @_; if (($special_headers{'content-length'}||0) > $limit || length($content) > $limit) { die "over limit: $limit"; } $content .= $buf; } ); =item How do you display the progress bar? my $bar = Term::ProgressBar->new({count => 1024, ETA => 'linear'}); $bar->minor(0); $bar->max_update_rate(1); my $f = Furl->new(); my $content = ''; my %special_headers = ('content-length' => undef);; my $did_set_target = 0; my $received_size = 0; my $next_update = 0; $f->request( method => 'GET', url => $url, special_headers => \%special_headers, write_code => sub { my ( $status, $msg, $headers, $buf ) = @_; unless ($did_set_target) { if ( my $cl = $special_headers{'content-length'} ) { $bar->target($cl); $did_set_target++; } else { $bar->target( $received_size + 2 * length($buf) ); } } $received_size += length($buf); $content .= $buf; $next_update = $bar->update($received_size) if $received_size >= $next_update; } ); =item HTTPS requests claims warnings! When you make https requests, IO::Socket::SSL may complain about it like: ******************************************************************* Using the default of SSL_verify_mode of SSL_VERIFY_NONE for client is depreciated! Please set SSL_verify_mode to SSL_VERIFY_PEER together with SSL_ca_file|SSL_ca_path for verification. If you really don't want to verify the certificate and keep the connection open to Man-In-The-Middle attacks please set SSL_verify_mode explicitly to SSL_VERIFY_NONE in your application. ******************************************************************* You should set C explicitly with Furl's C. use IO::Socket::SSL; my $ua = Furl->new( ssl_opts => { SSL_verify_mode => SSL_VERIFY_PEER(), }, ); See L for details. =back =head1 AUTHOR Tokuhiro Matsuno Etokuhirom@gmail.comE Fuji, Goro (gfx) =head1 THANKS TO Kazuho Oku mala mattn lestrrat walf443 lestrrat audreyt =head1 SEE ALSO L L L L =head1 LICENSE Copyright (C) Tokuhiro Matsuno. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut ConnectionCache.pm100664001751001751 64713160135067 20712 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/lib/Furlpackage Furl::ConnectionCache; use strict; use warnings; use utf8; sub new { bless [''], shift } sub steal { my ($self, $host, $port) = @_; if ($self->[0] eq "$host:$port") { my $sock = $self->[1]; @{$self} = (''); return $sock; } else { return undef; } } sub push { my ($self, $host, $port, $sock) = @_; $self->[0] = "$host:$port"; $self->[1] = $sock; } 1; HTTP.pm100664001751001751 13317513160135067 16531 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/lib/Furlpackage Furl::HTTP; use strict; use warnings; use base qw/Exporter/; use 5.008001; our $VERSION = '3.13'; use Carp (); use Furl::ConnectionCache; use Scalar::Util (); use Errno qw(EAGAIN ECONNRESET EINPROGRESS EINTR EWOULDBLOCK ECONNABORTED EISCONN); use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK SEEK_SET SEEK_END); use Socket qw( PF_INET SOCK_STREAM IPPROTO_TCP TCP_NODELAY pack_sockaddr_in ); use Time::HiRes qw(time); use constant WIN32 => $^O eq 'MSWin32'; use HTTP::Parser::XS qw/HEADERS_NONE HEADERS_AS_ARRAYREF HEADERS_AS_HASHREF/; our @EXPORT_OK = qw/HEADERS_NONE HEADERS_AS_ARRAYREF HEADERS_AS_HASHREF/; # ref. RFC 2616, 3.5 Content Codings: # For compatibility with previous implementations of HTTP, # applications SHOULD consider "x-gzip" and "x-compress" to be # equivalent to "gzip" and "compress" respectively. # ("compress" is not supported, though) my %COMPRESSED = map { $_ => undef } qw(gzip x-gzip deflate); my $HTTP_TOKEN = '[^\x00-\x31\x7F]+'; my $HTTP_QUOTED_STRING = q{"([^"]+|\\.)*"}; sub new { my $class = shift; my %args = @_ == 1 ? %{$_[0]} : @_; my @headers = ( 'User-Agent' => (delete($args{agent}) || __PACKAGE__ . '/' . $Furl::HTTP::VERSION), ); my $connection_header = 'keep-alive'; if(defined $args{headers}) { my $in_headers = delete $args{headers}; for (my $i = 0; $i < @$in_headers; $i += 2) { my $name = $in_headers->[$i]; if (lc($name) eq 'connection') { $connection_header = $in_headers->[$i + 1]; } else { push @headers, $name, $in_headers->[$i + 1]; } } } bless { timeout => 10, max_redirects => 7, bufsize => 10*1024, # no mmap headers => \@headers, connection_header => $connection_header, proxy => '', no_proxy => '', connection_pool => Furl::ConnectionCache->new(), header_format => HEADERS_AS_ARRAYREF, stop_if => sub {}, inet_aton => sub { Socket::inet_aton($_[0]) }, ssl_opts => {}, capture_request => $args{capture_request} || 0, inactivity_timeout => 600, %args }, $class; } sub get { my ( $self, $url, $headers ) = @_; $self->request( method => 'GET', url => $url, headers => $headers ); } sub head { my ( $self, $url, $headers ) = @_; $self->request( method => 'HEAD', url => $url, headers => $headers ); } sub post { my ( $self, $url, $headers, $content ) = @_; $self->request( method => 'POST', url => $url, headers => $headers, content => $content ); } sub put { my ( $self, $url, $headers, $content ) = @_; $self->request( method => 'PUT', url => $url, headers => $headers, content => $content ); } sub delete { my ( $self, $url, $headers, $content ) = @_; $self->request( method => 'DELETE', url => $url, headers => $headers, content => $content ); } sub agent { if ( @_ == 2 ) { _header_set(shift->{headers}, 'User-Agent', shift); } else { return _header_get(shift->{headers}, 'User-Agent'); } } sub _header_set { my ($headers, $key, $value) = (shift, lc shift, shift); for (my $i=0; $i<@$headers; $i+=2) { if (lc($headers->[$i]) eq $key) { $headers->[$i+1] = $value; return; } } push @$headers, $key, $value; } sub _header_get { my ($headers, $key) = (shift, lc shift); for (my $i=0; $i<@$headers; $i+=2) { return $headers->[$i+1] if lc($headers->[$i]) eq $key; } return undef; } sub _requires { my($file, $feature, $library) = @_; return if exists $INC{$file}; unless(eval { require $file }) { if ($@ =~ /^Can't locate/) { $library ||= do { local $_ = $file; s/ \.pm \z//xms; s{/}{::}g; $_; }; Carp::croak( "$feature requires $library, but it is not available." . " Please install $library using your prefer CPAN client" ); } else { die $@; } } } # returns $scheme, $host, $port, $path_query sub _parse_url { my($self, $url) = @_; $url =~ m{\A ([a-z]+) # scheme :// (?: ([^/:@?]+) # user : ([^/:@?]+) # password @ )? ([^/:?]+) # host (?: : (\d+) )? # port (?: ( /? \? .* | / .*) )? # path_query \z}xms or Carp::croak("Passed malformed URL: $url"); return( $1, $2, $3, $4, $5, $6 ); } sub make_x_www_form_urlencoded { my($self, $content) = @_; my @params; my @p = ref($content) eq 'HASH' ? %{$content} : ref($content) eq 'ARRAY' ? @{$content} : Carp::croak("Cannot coerce $content to x-www-form-urlencoded"); while ( my ( $k, $v ) = splice @p, 0, 2 ) { foreach my $s($k, $v) { utf8::downgrade($s); # will die in wide characters # escape unsafe chars (defined by RFC 3986) $s =~ s/ ([^A-Za-z0-9\-\._~]) / sprintf '%%%02X', ord $1 /xmsge; } push @params, "$k=$v"; } return join( "&", @params ); } sub env_proxy { my $self = shift; # Under CGI, bypass HTTP_PROXY as request sets it from Proxy header # Note: This doesn't work on windows correctly. local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD}; $self->{proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy}; $self->{no_proxy} = $ENV{NO_PROXY} || ''; $self; } sub request { my $self = shift; my %args = @_; my $timeout_at = time + $self->{timeout}; my ($scheme, $username, $password, $host, $port, $path_query); if (defined(my $url = $args{url})) { ($scheme, $username, $password, $host, $port, $path_query) = $self->_parse_url($url); } else { ($scheme, $host, $port, $path_query) = @args{qw/scheme host port path_query/}; if (not defined $host) { Carp::croak("Missing host name in arguments"); } } if (not defined $scheme) { $scheme = 'http'; } elsif($scheme ne 'http' && $scheme ne 'https') { Carp::croak("Unsupported scheme: $scheme"); } my $default_port = $scheme eq 'http' ? 80 : 443; if(not defined $port) { $port = $default_port; } if(not defined $path_query) { $path_query = '/'; } unless (substr($path_query, 0, 1) eq '/') { $path_query = "/$path_query"; # Compensate for slash (?foo=bar => /?foo=bar) } # Note. '_' is a invalid character for URI, but some servers using fucking underscore for domain name. Then, I accept the '_' character for domain name. if ($host =~ /[^A-Za-z0-9._-]/) { _requires('Net/IDN/Encode.pm', 'Internationalized Domain Name (IDN)'); $host = Net::IDN::Encode::domain_to_ascii($host); } my $proxy = $self->{proxy}; my $no_proxy = $self->{no_proxy}; if ($proxy && $no_proxy) { if ($self->match_no_proxy($no_proxy, $host)) { undef $proxy; } } local $SIG{PIPE} = 'IGNORE'; my $sock = $self->{connection_pool}->steal($host, $port); my $in_keepalive; if (defined $sock) { if ($self->_do_select(0, $sock, 0)) { close $sock; undef $sock; } else { $in_keepalive = 1; } } if(!$in_keepalive) { my $err_reason; if ($proxy) { my (undef, $proxy_user, $proxy_pass, $proxy_host, $proxy_port, undef) = $self->_parse_url($proxy); my $proxy_authorization; if (defined $proxy_user) { _requires('URI/Escape.pm', 'Basic auth'); my($unescape_proxy_user) = URI::Escape::uri_unescape($proxy_user); my($unescape_proxy_pass) = URI::Escape::uri_unescape($proxy_pass); _requires('MIME/Base64.pm', 'Basic auth'); $proxy_authorization = 'Basic ' . MIME::Base64::encode_base64("$unescape_proxy_user:$unescape_proxy_pass",""); } if ($scheme eq 'http') { ($sock, $err_reason) = $self->connect($proxy_host, $proxy_port, $timeout_at); if (defined $proxy_authorization) { $self->{proxy_authorization} = $proxy_authorization; } } else { ($sock, $err_reason) = $self->connect_ssl_over_proxy( $proxy_host, $proxy_port, $host, $port, $timeout_at, $proxy_authorization); } } else { if ($scheme eq 'http') { ($sock, $err_reason) = $self->connect($host, $port, $timeout_at); } else { ($sock, $err_reason) = $self->connect_ssl($host, $port, $timeout_at); } } return $self->_r500($err_reason) unless $sock; } # keep request dump my ($req_headers, $req_content) = ("", ""); # write request my $method = $args{method} || 'GET'; my $connection_header = $self->{connection_header}; my $cookie_jar = $self->{cookie_jar}; { my @headers = @{$self->{headers}}; $connection_header = 'close' if $method eq 'HEAD'; if (my $in_headers = $args{headers}) { for (my $i = 0; $i < @$in_headers; $i += 2) { my $name = $in_headers->[$i]; if (lc($name) eq 'connection') { $connection_header = $in_headers->[$i + 1]; } else { push @headers, $name, $in_headers->[$i + 1]; } } } unshift @headers, 'Connection', $connection_header; if (exists $self->{proxy_authorization}) { push @headers, 'Proxy-Authorization', $self->{proxy_authorization}; } if (defined $username) { _requires('URI/Escape.pm', 'Basic auth'); my($unescape_username) = URI::Escape::uri_unescape($username); my($unescape_password) = URI::Escape::uri_unescape($password); _requires('MIME/Base64.pm', 'Basic auth'); push @headers, 'Authorization', 'Basic ' . MIME::Base64::encode_base64("${unescape_username}:${unescape_password}",""); } # set Cookie header if (defined $cookie_jar) { my $url; if ($args{url}) { $url = $args{url}; } else { $url = join( '', $args{scheme}, '://', $args{host}, (exists($args{port}) ? ":$args{port}" : ()), exists($args{path_query}) ? $args{path_query} : '/', ); } push @headers, 'Cookie' => $cookie_jar->cookie_header($url); } my $content = $args{content}; my $content_is_fh = 0; if(defined $content) { $content_is_fh = Scalar::Util::openhandle($content); if(!$content_is_fh && ref $content) { $content = $self->make_x_www_form_urlencoded($content); if(!defined _header_get(\@headers, 'Content-Type')) { push @headers, 'Content-Type' => 'application/x-www-form-urlencoded'; } } if(!defined _header_get(\@headers, 'Content-Length')) { my $content_length; if($content_is_fh) { my $assert = sub { $_[0] or Carp::croak( "Failed to $_[1] for Content-Length: $!", ); }; $assert->(defined(my $cur_pos = tell($content)), 'tell'); $assert->(seek($content, 0, SEEK_END), 'seek'); $assert->(defined(my $end_pos = tell($content)), 'tell'); $assert->(seek($content, $cur_pos, SEEK_SET), 'seek'); $content_length = $end_pos - $cur_pos; } else { $content_length = length($content); } push @headers, 'Content-Length' => $content_length; } } # finally, set Host header my $request_target = ($port == $default_port) ? $host : "$host:$port"; push @headers, 'Host' => $request_target; my $request_uri = $proxy && $scheme eq 'http' ? "$scheme://$request_target$path_query" : $path_query; my $p = "$method $request_uri HTTP/1.1\015\012"; for (my $i = 0; $i < @headers; $i += 2) { my $val = $headers[ $i + 1 ]; # the de facto standard way to handle [\015\012](by kazuho-san) $val =~ tr/\015\012/ /; $p .= "$headers[$i]: $val\015\012"; } $p .= "\015\012"; $self->write_all($sock, $p, $timeout_at) or return $self->_r500( "Failed to send HTTP request: " . _strerror_or_timeout()); if ($self->{capture_request}) { $req_headers = $p; } if (defined $content) { if ($content_is_fh) { my $ret; my $buf; SENDFILE: while (1) { $ret = read($content, $buf, $self->{bufsize}); if (not defined $ret) { Carp::croak("Failed to read request content: $!"); } elsif ($ret == 0) { # EOF last SENDFILE; } $self->write_all($sock, $buf, $timeout_at) or return $self->_r500( "Failed to send content: " . _strerror_or_timeout() ); if ($self->{capture_request}) { $req_content .= $buf; } } } else { # simple string if (length($content) > 0) { $self->write_all($sock, $content, $timeout_at) or return $self->_r500( "Failed to send content: " . _strerror_or_timeout() ); if ($self->{capture_request}) { $req_content = $content; } } } } } # read response my $buf = ''; my $rest_header; my $res_minor_version; my $res_status; my $res_msg; my $res_headers; my $special_headers = $args{special_headers} || +{}; $special_headers->{'connection'} = ''; $special_headers->{'content-length'} = undef; $special_headers->{'location'} = ''; $special_headers->{'content-encoding'} = ''; $special_headers->{'transfer-encoding'} = ''; LOOP: while (1) { my $n = $self->read_timeout($sock, \$buf, $self->{bufsize}, length($buf), $timeout_at); if(!$n) { # error or eof if ($in_keepalive && length($buf) == 0 && (defined($n) || $!==ECONNRESET || (WIN32 && $! == ECONNABORTED))) { # the server closes the connection (maybe because of keep-alive timeout) return $self->request(%args); } return $self->_r500( !defined($n) ? "Cannot read response header: " . _strerror_or_timeout() : "Unexpected EOF while reading response header" ); } else { my $ret; ( $ret, $res_minor_version, $res_status, $res_msg, $res_headers ) = HTTP::Parser::XS::parse_http_response( $buf, $self->{header_format}, $special_headers ); if ( $ret == -1 ) { return $self->_r500("Invalid HTTP response"); } elsif ( $ret == -2 ) { # partial response next LOOP; } else { # succeeded $rest_header = substr( $buf, $ret ); if ((int $res_status / 100) eq 1) { # Continue # The origin server must not wait for the request body # before sending the 100 (Continue) response. # see http://greenbytes.de/tech/webdav/rfc2616.html#status.100 $buf = $rest_header; next LOOP; } last LOOP; } } } my $max_redirects = 0; my $do_redirect = undef; if ($special_headers->{location}) { $max_redirects = defined($args{max_redirects}) ? $args{max_redirects} : $self->{max_redirects}; $do_redirect = $max_redirects && $res_status =~ /^30[1237]$/; } my $res_content = ''; unless ($do_redirect) { if (my $fh = $args{write_file}) { $res_content = Furl::FileStream->new( $fh ); } elsif (my $coderef = $args{write_code}) { $res_content = Furl::CallbackStream->new( sub { $coderef->($res_status, $res_msg, $res_headers, @_) } ); } } if (exists $COMPRESSED{ $special_headers->{'content-encoding'} }) { _requires('Furl/ZlibStream.pm', 'Content-Encoding', 'Compress::Raw::Zlib'); $res_content = Furl::ZlibStream->new($res_content); } my $chunked = ($special_headers->{'transfer-encoding'} eq 'chunked'); my $content_length = $special_headers->{'content-length'}; if (defined($content_length) && $content_length !~ /\A[0-9]+\z/) { return $self->_r500("Bad Content-Length: ${content_length}"); } unless ($method eq 'HEAD' || ($res_status < 200 && $res_status >= 100) || $res_status == 204 || $res_status == 304) { my @err; if ( $chunked ) { @err = $self->_read_body_chunked($sock, \$res_content, $rest_header, $timeout_at); } else { $res_content .= $rest_header; if (ref $res_content || !defined($content_length)) { @err = $self->_read_body_normal($sock, \$res_content, length($rest_header), $content_length, $timeout_at); } else { @err = $self->_read_body_normal_to_string_buffer($sock, \$res_content, length($rest_header), $content_length, $timeout_at); } } if(@err) { return @err; } } # manage connection cache (i.e. keep-alive) if (lc($connection_header) eq 'keep-alive') { my $connection = lc $special_headers->{'connection'}; if (($res_minor_version == 0 ? $connection eq 'keep-alive' # HTTP/1.0 needs explicit keep-alive : $connection ne 'close') # HTTP/1.1 can keep alive by default && ( defined $content_length or $chunked)) { $self->{connection_pool}->push($host, $port, $sock); } } # explicitly close here, just after returning the socket to the pool, # since it might be reused in the upcoming recursive call undef $sock; # process 'Set-Cookie' header. if (defined $cookie_jar) { my $req_url = join( '', $scheme, '://', (defined($username) && defined($password) ? "${username}:${password}@" : ()), "$host:${port}${path_query}", ); my $cookies = $res_headers->{'set-cookie'}; $cookies = [$cookies] if !ref$cookies; for my $cookie (@$cookies) { $cookie_jar->add($req_url, $cookie); } } if ($do_redirect) { my $location = $special_headers->{location}; unless ($location =~ m{^[a-z0-9]+://}) { # RFC 2616 14.30 says Location header is absolute URI. # But, a lot of servers return relative URI. _requires("URI.pm", "redirect with relative url"); $location = URI->new_abs($location, "$scheme://$host:$port$path_query")->as_string; } # Note: RFC 1945 and RFC 2068 specify that the client is not allowed # to change the method on the redirected request. However, most # existing user agent implementations treat 302 as if it were a 303 # response, performing a GET on the Location field-value regardless # of the original request method. The status codes 303 and 307 have # been added for servers that wish to make unambiguously clear which # kind of reaction is expected of the client. return $self->request( @_, method => ($res_status eq '301' or $res_status eq '307') ? $method : 'GET', url => $location, max_redirects => $max_redirects - 1, ); } # return response. if (ref $res_content) { $res_content = $res_content->get_response_string; } return ( $res_minor_version, $res_status, $res_msg, $res_headers, $res_content, $req_headers, $req_content, undef, undef, [$scheme, $username, $password, $host, $port, $path_query], ); } # connects to $host:$port and returns $socket sub connect :method { my($self, $host, $port, $timeout_at) = @_; my $sock; my $timeout = $timeout_at - time; return (undef, "Failed to resolve host name: timeout") if $timeout <= 0; my ($sock_addr, $err_reason) = $self->_get_address($host, $port, $timeout); return (undef, "Cannot resolve host name: $host (port: $port), " . ($err_reason || $!)) unless $sock_addr; RETRY: socket($sock, Socket::sockaddr_family($sock_addr), SOCK_STREAM, 0) or Carp::croak("Cannot create socket: $!"); _set_sockopts($sock); if (connect($sock, $sock_addr)) { # connected } elsif ($! == EINPROGRESS || (WIN32 && $! == EWOULDBLOCK)) { $self->do_select(1, $sock, $timeout_at) or return (undef, "Cannot connect to ${host}:${port}: timeout"); # connected } else { if ($! == EINTR && ! $self->{stop_if}->()) { close $sock; goto RETRY; } return (undef, "Cannot connect to ${host}:${port}: $!"); } $sock; } sub _get_address { my ($self, $host, $port, $timeout) = @_; if ($self->{get_address}) { return $self->{get_address}->($host, $port, $timeout); } # default rule (TODO add support for IPv6) my $iaddr = $self->{inet_aton}->($host, $timeout) or return (undef, $!); pack_sockaddr_in($port, $iaddr); } sub _ssl_opts { my $self = shift; my $ssl_opts = $self->{ssl_opts}; unless (exists $ssl_opts->{SSL_verify_mode}) { # set SSL_VERIFY_PEER as default. $ssl_opts->{SSL_verify_mode} = IO::Socket::SSL::SSL_VERIFY_PEER(); unless (exists $ssl_opts->{SSL_verifycn_scheme}) { $ssl_opts->{SSL_verifycn_scheme} = 'www' } } if ($ssl_opts->{SSL_verify_mode}) { unless (exists $ssl_opts->{SSL_ca_file} || exists $ssl_opts->{SSL_ca_path}) { require Mozilla::CA; $ssl_opts->{SSL_ca_file} = Mozilla::CA::SSL_ca_file(); } } $ssl_opts; } # connect SSL socket. # You can override this method in your child class, if you want to use Crypt::SSLeay or some other library. # @return file handle like object sub connect_ssl { my ($self, $host, $port, $timeout_at) = @_; _requires('IO/Socket/SSL.pm', 'SSL'); my ($sock, $err_reason) = $self->connect($host, $port, $timeout_at); return (undef, $err_reason) unless $sock; my $timeout = $timeout_at - time; return (undef, "Cannot create SSL connection: timeout") if $timeout <= 0; my $ssl_opts = $self->_ssl_opts; IO::Socket::SSL->start_SSL( $sock, PeerHost => $host, PeerPort => $port, Timeout => $timeout, %$ssl_opts, ) or return (undef, "Cannot create SSL connection: " . IO::Socket::SSL::errstr()); _set_sockopts($sock); $sock; } sub connect_ssl_over_proxy { my ($self, $proxy_host, $proxy_port, $host, $port, $timeout_at, $proxy_authorization) = @_; _requires('IO/Socket/SSL.pm', 'SSL'); my $sock = $self->connect($proxy_host, $proxy_port, $timeout_at); my $p = "CONNECT $host:$port HTTP/1.0\015\012Server: $host\015\012"; if (defined $proxy_authorization) { $p .= "Proxy-Authorization: $proxy_authorization\015\012"; } $p .= "\015\012"; $self->write_all($sock, $p, $timeout_at) or return $self->_r500( "Failed to send HTTP request to proxy: " . _strerror_or_timeout()); my $buf = ''; my $read = $self->read_timeout($sock, \$buf, $self->{bufsize}, length($buf), $timeout_at); if (not defined $read) { return (undef, "Cannot read proxy response: " . _strerror_or_timeout()); } elsif ( $read == 0 ) { # eof return (undef, "Unexpected EOF while reading proxy response"); } elsif ( $buf !~ /^HTTP\/1\.[0-9] 200 .+\015\012/ ) { return (undef, "Invalid HTTP Response via proxy"); } my $timeout = $timeout_at - time; return (undef, "Cannot start SSL connection: timeout") if $timeout_at <= 0; my $ssl_opts = $self->_ssl_opts; unless (exists $ssl_opts->{SSL_verifycn_name}) { $ssl_opts->{SSL_verifycn_name} = $host; } IO::Socket::SSL->start_SSL( $sock, PeerHost => $host, PeerPort => $port, Timeout => $timeout, %$ssl_opts ) or return (undef, "Cannot start SSL connection: " . IO::Socket::SSL::errstr()); _set_sockopts($sock); # just in case (20101118 kazuho) $sock; } sub _read_body_chunked { my ($self, $sock, $res_content, $rest_header, $timeout_at) = @_; my $buf = $rest_header; READ_LOOP: while (1) { if ( my ( $header, $next_len ) = ( $buf =~ m{\A ( # header ( [0-9a-fA-F]+ ) # next_len (hex number) (?:; $HTTP_TOKEN = (?: $HTTP_TOKEN | $HTTP_QUOTED_STRING ) )* # optional chunk-extensions [ ]* # www.yahoo.com adds spaces here. # Is this valid? \015\012 # CR+LF ) }xmso ) ) { $buf = substr($buf, length($header)); # remove header from buf $next_len = hex($next_len); if ($next_len == 0) { last READ_LOOP; } # +2 means trailing CRLF READ_CHUNK: while ( $next_len+2 > length($buf) ) { my $n = $self->read_timeout( $sock, \$buf, $self->{bufsize}, length($buf), $timeout_at ); if (!$n) { return $self->_r500( !defined($n) ? "Cannot read chunk: " . _strerror_or_timeout() : "Unexpected EOF while reading packets" ); } } $$res_content .= substr($buf, 0, $next_len); $buf = substr($buf, $next_len+2); if (length($buf) > 0) { next; # re-parse header } } my $n = $self->read_timeout( $sock, \$buf, $self->{bufsize}, length($buf), $timeout_at ); if (!$n) { return $self->_r500( !defined($n) ? "Cannot read chunk: " . _strerror_or_timeout() : "Unexpected EOF while reading packets" ); } } # read last CRLF return $self->_read_body_normal( $sock, \$buf, length($buf), 2, $timeout_at); } sub _read_body_normal { my ($self, $sock, $res_content, $nread, $res_content_length, $timeout_at) = @_; while (!defined($res_content_length) || $res_content_length != $nread) { my $n = $self->read_timeout( $sock, \my $buf, $self->{bufsize}, 0, $timeout_at ); if (!$n) { last if ! defined($res_content_length); return $self->_r500( !defined($n) ? "Cannot read content body: " . _strerror_or_timeout() : "Unexpected EOF while reading content body" ); } $$res_content .= $buf; $nread += $n; } return; } # This function loads all content at once if it's possible. Since $res_content is just a plain scalar. # Buffering is not needed. sub _read_body_normal_to_string_buffer { my ($self, $sock, $res_content, $nread, $res_content_length, $timeout_at) = @_; while ($res_content_length != $nread) { my $n = $self->read_timeout( $sock, $res_content, $res_content_length, $nread, $timeout_at ); if (!$n) { return $self->_r500( !defined($n) ? "Cannot read content body: " . _strerror_or_timeout() : "Unexpected EOF while reading content body" ); } $nread += $n; } return; } # returns true if the socket is ready to read, false if timeout has occurred ($! will be cleared upon timeout) sub do_select { my($self, $is_write, $sock, $timeout_at) = @_; my $now = time; my $inactivity_timeout_at = $now + $self->{inactivity_timeout}; $timeout_at = $inactivity_timeout_at if $timeout_at > $inactivity_timeout_at; # wait for data while (1) { my $timeout = $timeout_at - $now; if ($timeout <= 0) { $! = 0; return 0; } my $nfound = $self->_do_select($is_write, $sock, $timeout); return 1 if $nfound > 0; return 0 if $nfound == -1 && $! == EINTR && $self->{stop_if}->(); $now = time; } die 'not reached'; } sub _do_select { my($self, $is_write, $sock, $timeout) = @_; my($rfd, $wfd); my $efd = ''; vec($efd, fileno($sock), 1) = 1; if ($is_write) { $wfd = $efd; } else { $rfd = $efd; } my $nfound = select($rfd, $wfd, $efd, $timeout); return $nfound; } # returns (positive) number of bytes read, or undef if the socket is to be closed sub read_timeout { my ($self, $sock, $buf, $len, $off, $timeout_at) = @_; my $ret; # NOTE: select-read-select may get stuck in SSL, # so we use read-select-read instead. while(1) { # try to do the IO defined($ret = sysread($sock, $$buf, $len, $off)) and return $ret; if ($! == EAGAIN || $! == EWOULDBLOCK || (WIN32 && $! == EISCONN)) { # passthru } elsif ($! == EINTR) { return undef if $self->{stop_if}->(); # otherwise passthru } else { return undef; } # on EINTER/EAGAIN/EWOULDBLOCK $self->do_select(0, $sock, $timeout_at) or return undef; } } # returns (positive) number of bytes written, or undef if the socket is to be closed sub write_timeout { my ($self, $sock, $buf, $len, $off, $timeout_at) = @_; my $ret; while(1) { # try to do the IO defined($ret = syswrite($sock, $buf, $len, $off)) and return $ret; if ($! == EAGAIN || $! == EWOULDBLOCK || (WIN32 && $! == EISCONN)) { # passthru } elsif ($! == EINTR) { return undef if $self->{stop_if}->(); # otherwise passthru } else { return undef; } $self->do_select(1, $sock, $timeout_at) or return undef; } } # writes all data in buf and returns number of bytes written or undef if failed sub write_all { my ($self, $sock, $buf, $timeout_at) = @_; my $off = 0; while (my $len = length($buf) - $off) { my $ret = $self->write_timeout($sock, $buf, $len, $off, $timeout_at) or return undef; $off += $ret; } return $off; } sub _r500 { my($self, $message) = @_; $message = Carp::shortmess($message); # add lineno and filename return(0, 500, "Internal Response: $message", [ 'Content-Length' => length($message), 'X-Internal-Response' => 1, # XXX ^^ EXPERIMENTAL header. Do not depend to this. ], $message ); } sub _strerror_or_timeout { $! != 0 ? "$!" : 'timeout'; } sub _set_sockopts { my $sock = shift; setsockopt( $sock, IPPROTO_TCP, TCP_NODELAY, 1 ) or Carp::croak("Failed to setsockopt(TCP_NODELAY): $!"); if (WIN32) { if (ref($sock) ne 'IO::Socket::SSL') { my $tmp = 1; ioctl( $sock, 0x8004667E, \$tmp ) or Carp::croak("Cannot set flags for the socket: $!"); } } else { my $flags = fcntl( $sock, F_GETFL, 0 ) or Carp::croak("Cannot get flags for the socket: $!"); $flags = fcntl( $sock, F_SETFL, $flags | O_NONBLOCK ) or Carp::croak("Cannot set flags for the socket: $!"); } { # no buffering my $orig = select(); select($sock); $|=1; select($orig); } binmode $sock; } # You can override this method if you want to use more powerful matcher. sub match_no_proxy { my ( $self, $no_proxy, $host ) = @_; # ref. curl.1. # list of host names that shouldn't go through any proxy. # If set to a asterisk '*' only, it matches all hosts. if ( $no_proxy eq '*' ) { return 1; } else { for my $pat ( split /\s*,\s*/, lc $no_proxy ) { if ( $host =~ /\Q$pat\E$/ ) { # suffix match(same behavior with LWP) return 1; } } } return 0; } # utility class { package # hide from pause Furl::FileStream; use overload '.=' => 'append', fallback => 1; sub new { my ($class, $fh) = @_; bless {fh => $fh}, $class; } sub append { my($self, $partial) = @_; print {$self->{fh}} $partial; return $self; } sub get_response_string { undef } } { package # hide from pause Furl::CallbackStream; use overload '.=' => 'append', fallback => 1; sub new { my ($class, $cb) = @_; bless {cb => $cb}, $class; } sub append { my($self, $partial) = @_; $self->{cb}->($partial); return $self; } sub get_response_string { undef } } 1; __END__ =for stopwords sockaddr =encoding utf8 =head1 NAME Furl::HTTP - Low level interface to Furl =head1 SYNOPSIS use Furl; my $furl = Furl::HTTP->new( agent => 'MyGreatUA/2.0', timeout => 10, ); my ($minor_version, $code, $msg, $headers, $body) = $furl->request( method => 'GET', host => 'example.com', port => 80, path_query => '/' ); # or # Accept-Encoding is supported but optional $furl = Furl->new( headers => [ 'Accept-Encoding' => 'gzip' ], ); my $body = $furl->get('http://example.com/some/compressed'); =head1 DESCRIPTION Furl is yet another HTTP client library. LWP is the de facto standard HTTP client for Perl 5, but it is too slow for some critical jobs, and too complex for weekend hacking. Furl resolves these issues. Enjoy it! =head1 INTERFACE =head2 Class Methods =head3 C<< Furl::HTTP->new(%args | \%args) :Furl >> Creates and returns a new Furl client with I<%args>. Dies on errors. I<%args> might be: =over =item agent :Str = "Furl/$VERSION" =item timeout :Int = 10 Seconds until the call to $furl->request returns a timeout error (as an internally generated 500 error). The timeout might not be accurate since some underlying modules / built-ins function may block longer than the specified timeout. See the L for how to support timeout during name resolution. =item inactivity_timeout :Int = 600 An inactivity timer for TCP read/write (in seconds). $furl->request returns a timeout error if no additional data arrives (or is sent) within the specified threshold. =item max_redirects :Int = 7 =item proxy :Str =item no_proxy :Str =item headers :ArrayRef =item header_format :Int = HEADERS_AS_ARRAYREF This option choose return value format of C<< $furl->request >>. This option allows HEADERS_NONE or HEADERS_AS_ARRAYREF. B is a default value. This makes B<$headers> as ArrayRef. B makes B<$headers> as undef. Furl does not return parsing result of headers. You should take needed headers from B. =item connection_pool :Object This is the connection pool object for keep-alive requests. By default, it is a instance of L. You may not customize this variable otherwise to use L. This attribute requires a duck type object. It has two methods, C<< $obj->steal($host, $port >> and C<< $obj->push($host, $port, $sock) >>. =item stop_if :CodeRef A callback function that is called by Furl after when a blocking function call returns EINTR. Furl will abort the HTTP request and return immediately if the callback returns true. Otherwise the operation is continued (the default behaviour). =item get_address :CodeRef A callback function to override the default address resolution logic. Takes three arguments: ($hostname, $port, $timeout_in_seconds) and returns: ($sockaddr, $errReason). If the returned $sockaddr is undef, then the resolution is considered as a failure and $errReason is propagated to the caller. =item inet_aton :CodeRef Deprecated. New applications should use B instead. A callback function to customize name resolution. Takes two arguments: ($hostname, $timeout_in_seconds). If omitted, Furl calls L. =item ssl_opts :HashRef SSL configuration used on https requests, passed directly to C<< IO::Socket::SSL->new() >>, for example: use IO::Socket::SSL; my $ua = Furl::HTTP->new( ssl_opts => { SSL_verify_mode => SSL_VERIFY_PEER(), }, }); See L for details. =back =head2 Instance Methods =head3 C<< $furl->request(%args) :($protocol_minor_version, $code, $msg, \@headers, $body) >> Sends an HTTP request to a specified URL and returns a protocol minor version, status code, status message, response headers, response body respectively. I<%args> might be: =over =item scheme :Str = "http" Protocol scheme. May be C or C. =item host :Str Server host to connect. You must specify at least C or C. =item port :Int = 80 Server port to connect. The default is 80 on C<< scheme => 'http' >>, or 443 on C<< scheme => 'https' >>. =item path_query :Str = "/" Path and query to request. =item url :Str URL to request. You can use C instead of C, C, C and C. =item headers :ArrayRef HTTP request headers. e.g. C<< headers => [ 'Accept-Encoding' => 'gzip' ] >>. =item content : Str | ArrayRef[Str] | HashRef[Str] | FileHandle Content to request. =item write_file : FileHandle If this parameter is set, the response content will be saved here instead of in the response object. It's like a C<:content_file> in L. =item write_code : CodeRef If a callback is provided with the "write_code" option then this function will be called for each chunk of the response content as it is received from the server. It's like a C<:content_cb> in L. =back The C method assumes the first argument to be an instance of C if the arguments are an odd number: my $req = HTTP::Request->new(...); my @res = $furl->request($req); # allowed You must encode all the queries or this method will die, saying C. =head3 C<< $furl->get($url :Str, $headers :ArrayRef[Str] ) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->head($url :Str, $headers :ArrayRef[Str] ) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->post($url :Str, $headers :ArrayRef[Str], $content :Any) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->put($url :Str, $headers :ArrayRef[Str], $content :Any) >> This is an easy-to-use alias to C, sending the C method. =head3 C<< $furl->delete($url :Str, $headers :ArrayRef[Str] ) >> This is an easy-to-use alias to C, sending the C method. =head1 FAQ =over 4 =item Why IO::Socket::SSL? Net::SSL is not well documented. =item Why is env_proxy optional? Environment variables are highly dependent on each users' environment, and we think it may confuse users when something doesn't go right. =item What operating systems are supported? Linux 2.6 or higher, OSX Tiger or higher, Windows XP or higher. And other operating systems will be supported if you send a patch. =item Why doesn't Furl support chunked upload? There are reasons why chunked POST/PUTs should not be used in general. First, you cannot send chunked requests unless the peer server at the other end of the established TCP connection is known to be a HTTP/1.1 server. Second, HTTP/1.1 servers disconnect their persistent connection quite quickly (compared to the time they wait for the first request), so it is not a good idea to post non-idempotent requests (e.g. POST, PUT, etc.) as a succeeding request over persistent connections. These facts together makes using chunked requests virtually impossible (unless you _know_ that the server supports HTTP/1.1), and this is why we decided that supporting the feature is NOT of high priority. =item How do you build the response content as it arrives? You can use L for this purpose. my $fh = IO::Callback->new( '<', sub { my $x = shift @data; $x ? "-$x" : undef; } ); my ( $code, $msg, $headers, $content ) = $furl->put( "http://127.0.0.1:$port/", [ 'Content-Length' => $len ], $fh, ); =item How do you use gzip/deflate compressed communication? Add an B header to your request. Furl inflates response bodies transparently according to the B response header. =item How do you use multipart/form-data? You can use multipart/form-data with L. use HTTP::Request::Common; my $furl = Furl->new(); $req = POST 'http://www.perl.org/survey.cgi', Content_Type => 'form-data', Content => [ name => 'Hiromu Tokunaga', email => 'tokuhirom@example.com', gender => 'F', born => '1978', init => ["$ENV{HOME}/.profile"], ]; $furl->request($req); Native multipart/form-data support for L is available if you can send a patch for me. =item How do you use Keep-Alive and what happens on the HEAD method? Furl supports HTTP/1.1, hence C. However, if you use the HEAD method, the connection is closed immediately. RFC 2616 section 9.4 says: The HEAD method is identical to GET except that the server MUST NOT return a message-body in the response. Some web applications, however, returns message bodies on the HEAD method, which might confuse C processes, so Furl closes connection in such cases. Anyway, the HEAD method is not so useful nowadays. The GET method and C are more suitable to cache HTTP contents. =item Why does Furl take longer than specified until it returns a timeout error? Although Furl itself supports timeout, some underlying modules / functions do not. And the most noticeable one is L, the function used for name resolution (a function that converts host names to IP addresses). If you need accurate and short timeout for name resolution, the use of L is recommended. The following code snippet describes how to use the module in conjunction with Furl. use Net::DNS::Lite qw(); my $furl = Furl->new( timeout => $my_timeout_in_seconds, inet_aton => sub { Net::DNS::Lite::inet_aton(@_) }, ); =item How can I replace Host header instead of hostname? Furl::HTTP does not provide a way to replace the Host header because such a design leads to security issues. If you want to send HTTP requests to a dedicated server (or a UNIX socket), you should use the B callback to designate the peer to which L should connect as B. The example below sends all requests to 127.0.0.1:8080. my $ua = Furl::HTTP->new( get_address => sub { my ($host, $port, $timeout) = @_; pack_sockaddr_in(8080, inet_aton("127.0.0.1")); }, ); my ($minor_version, $code, $msg, $headers, $body) = $furl->request( url => 'http://example.com/foo', method => 'GET' ); =back =head1 TODO - AnyEvent::Furl? - ipv6 support - better docs for NO_PROXY =head1 OPTIONAL FEATURES =head2 Internationalized Domain Name (IDN) This feature requires Net::IDN::Encode. =head2 SSL This feature requires IO::Socket::SSL. =head2 Content-Encoding (deflate, gzip) This feature requires Compress::Raw::Zlib. =head1 DEVELOPMENT To setup your environment: $ git clone http://github.com/tokuhirom/Furl.git $ cd Furl To get picohttpparser: $ git submodule init $ git submodule update $ perl Makefile.PL $ make $ sudo make install =head2 HOW TO CONTRIBUTE Please send the pull request via L. =head1 SEE ALSO L HTTP specs: L L =head1 LICENSE Copyright (C) Tokuhiro Matsuno. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Headers.pm100664001751001751 1022413160135067 17272 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/lib/Furlpackage Furl::Headers; use strict; use warnings; use utf8; use Carp (); sub new { my ($class, $headers) = @_; # $headers is HashRef or ArrayRef my $self = {}; if (ref $headers eq 'ARRAY') { my @h = @$headers; # copy while (my ($k, $v) = splice @h, 0, 2) { push @{$self->{lc $k}}, $v; } } elsif(ref $headers eq 'HASH') { while (my ($k, $v) = each %$headers) { push @{$self->{$k}}, ref($v) eq 'ARRAY' ? @$v : $v; } } else { Carp::confess($class . ': $headers must be an ARRAY or HASH reference'); } bless $self, $class; } sub header { my ($self, $key, $new) = @_; if ($new) { # setter $new = [$new] unless ref $new; $self->{lc $key} = $new; return; } else { my $val = $self->{lc $key}; return unless $val; return wantarray ? @$val : join(", ", @$val); } } sub remove_header { my ($self, $key) = @_; delete $self->{lc $key}; } sub flatten { my $self = shift; my @ret; while (my ($k, $v) = each %$self) { for my $e (@$v) { push @ret, $k, $e; } } return @ret; } sub keys :method { my $self = shift; keys %$self; } sub header_field_names { shift->keys } sub as_string { my $self = shift; my $ret = ''; for my $k (sort keys %$self) { for my $e (@{$self->{$k}}) { $ret .= "$k: $e\015\012"; } } return $ret; } sub as_http_headers { my ($self, $key) = @_; require HTTP::Headers; return HTTP::Headers->new($self->flatten); } # shortcut for popular headers. sub referer { [ shift->header( 'Referer' => @_ ) ]->[0] } sub expires { [ shift->header( 'Expires' => @_ ) ]->[0] } sub last_modified { [ shift->header( 'Last-Modified' => @_ ) ]->[0] } sub if_modified_since { [ shift->header( 'If-Modified-Since' => @_ ) ]->[0] } sub content_type { [ shift->header( 'Content-Type' => @_ ) ]->[0] } sub content_length { [ shift->header( 'Content-Length' => @_ ) ]->[0] } sub content_encoding { [ shift->header( 'Content-Encoding' => @_ ) ]->[0] } sub clone { require Storable; Storable::dclone($_[0]); } 1; __END__ =head1 NAME Furl::Headers - HTTP Headers object =head1 SYNOPSIS =head1 CONSTRUCTOR =over 4 =item my $headers = Furl::Headers->new(\%headers); The constructor takes one argument. It is a hashref. Every key of hashref must be lower-cased. The format of the argument is like following: +{ 'content-length' => [30], 'set-cookies' => ['auth_token=; path=/; expires=Thu, 01 Jan 1970 00:00:00 GMT', '_twitter_sess=JKLJBNBLKSFJBLKSJBLKSJLKJFLSDJFjkDKFUFIOSDUFSDVjOTUzNzUwNTE2%250AZWFiMWRiNDZhMDcwOWEwMWQ5IgpmbGFzaElDOidBY3Rpb25Db250cm9sbGVy%250AOjpGbGFzaDo6Rmxhc2hIYXNoewAGOgpAdXNlZHsA--d9ce07496a22525bc178jlkhafklsdjflajfl411; domain=.twitter.com; path=/'], } =back =head1 INSTANCE METHODS =over 4 =item my @values = $headers->header($key); Get the header value in array. =item my $values_joined = $headers->header($key); Get the header value in scalar. This is not a first value of header. This is same as: my $values = join(", ", $headers->header($key)) =item $headers->header($key, $val); =item $headers->header($key, \@val); Set the new value of headers. =item $headers->remove_header($key); Delete key from headers. =item my @h = $headers->flatten(); Gets pairs of keys and values. =item my @keys = $headers->keys(); =item my @keys = $headers->header_field_names(); Returns keys of headers in array. The return value do not contains duplicated value. =item my $str = $headers->as_string(); Return the header fields as a formatted MIME header. =item my $val = $headers->referer() =item my $val = $headers->expires() =item my $val = $headers->last_modified() =item my $val = $headers->if_modified_since() =item my $val = $headers->content_type() =item my $val = $headers->content_length() =item my $val = $headers->content_encoding() These methods are shortcut for popular headers. =item $headers->clone(); Returns a copy of this "Furl::Headers" object. =back =head1 SEE ALSO L =cut Request.pm100664001751001751 1055413160135067 17355 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/lib/Furlpackage Furl::Request; use strict; use warnings; use utf8; use Class::Accessor::Lite; use Furl::Headers; use Furl::HTTP; Class::Accessor::Lite->mk_accessors(qw/ method uri protocol headers content /); sub new { my $class = shift; my ($method, $uri, $headers, $content) = @_; unless (defined $headers) { $headers = +{}; } unless (defined $content) { $content = ''; } bless +{ method => $method, uri => $uri, headers => Furl::Headers->new($headers), content => $content, }, $class; } sub parse { my $class = shift; my $raw_request = shift; # I didn't use HTTP::Parser::XS for following reasons: # 1. parse_http_request() function omits request content, but need to deal it. # 2. this function parses header to PSGI env, but env/header mapping is troublesome. return unless $raw_request =~ s!^(.+) (.+) (HTTP/1.\d+)\s*!!; my ($method, $uri, $protocol) = ($1, $2, $3); my ($header_str, $content) = split /\015?\012\015?\012/, $raw_request, 2; my $headers = +{}; for (split /\015?\012/, $header_str) { tr/\015\012//d; my ($k, $v) = split /\s*:\s*/, $_, 2; $headers->{lc $k} = $v; # complete host_port if (lc $k eq 'host') { $uri = $v . $uri; } } unless ($uri =~ /^http/) { $uri = "http://$uri"; } my $req = $class->new($method, $uri, $headers, $content); $req->protocol($protocol); return $req; } # alias *body = \&content; # shorthand sub content_length { shift->headers->content_length } sub content_type { shift->headers->content_type } sub header { shift->headers->header(@_) } sub request_line { my $self = shift; my $path_query = $self->uri . ''; # for URI.pm $path_query =~ s!^https?://[^/]+!!; my $method = $self->method || ''; my $protocol = $self->protocol || ''; return "$method $path_query $protocol"; } sub as_http_request { my $self = shift; require HTTP::Request; my $req = HTTP::Request->new( $self->method, $self->uri, [ $self->headers->flatten ], $self->content, ); $req->protocol($self->protocol); return $req; } sub as_hashref { my $self = shift; return +{ method => $self->method, uri => $self->uri, protocol => $self->protocol, headers => [ $self->headers->flatten ], content => $self->content, }; } sub as_string { my $self = shift; join("\015\012", $self->method . ' ' . $self->uri . (defined($self->protocol) ? ' ' . $self->protocol : ''), $self->headers->as_string, ref($self->content) =~ qr{\A(?:ARRAY|HASH)\z} ? Furl::HTTP->make_x_www_form_urlencoded($self->content) : $self->content, ); } 1; __END__ =head1 NAME Furl::Request - Request object for Furl =head1 SYNOPSIS my $f = Furl->new; my $req = Furl::Request->new($method, $uri, $headers, $content); my $res = $f->request($req); print $req->request_line, "\n"; my $http_req = $req->as_http_request; my $req_hash = $req->as_hashref; =head1 DESCRIPTION This is a HTTP request object in Furl. =head1 CONSTRUCTOR my $req = Furl::Request->new($method, $uri); # or my $req = Furl::Request->new($method, $uri, \%headers); # or my $req = Furl::Request->new($method, $uri, \%headers, $content); # and my $req = Furl::Request->parse($http_request_raw_string); =head1 INSTANCE METHODS =over 4 =item $req->method($method) Gets/Sets HTTP request method =item $req->uri($uri) Gets/Sets request URI =item $req->headers($headers) Gets/Sets instance of L =item $req->content($content) =item $req->body($content) Gets/Sets request body in scalar. =item $req->protocol($protocol) $req->protocol('HTTP/1.1'); print $req->protocol; #=> "HTTP/1.1" Gets/Sets HTTP protocol in string. =item $req->content_length =item $req->content_type =item $req->header Shorthand to access L. =item $req->as_http_request Make instance of L from L. =item $req->as_hashref Convert request object to HashRef. Format is following: method: Str uri: Str protocol: Str headers: ArrayRef[Str] content: Str =item $req->request_line print $req->request_line; #=> "GET / HTTP/1.1" Returns HTTP request line. =back Response.pm100664001751001751 1712313160135067 17522 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/lib/Furlpackage Furl::Response; use strict; use warnings; use utf8; use Furl::Headers; sub new { my ($class, $minor_version, $code, $message, $headers, $content) = @_; bless { minor_version => $minor_version, code => $code, message => $message, headers => Furl::Headers->new($headers), content => $content, }, $class; } # DO NOT CALL this method DIRECTLY. sub set_request_info { my ($self, $request_src, $captured_req_headers, $captured_req_content) = @_; $self->{request_src} = $request_src; if (defined $captured_req_headers) { $self->{captured_req_headers} = $captured_req_headers; $self->{captured_req_content} = $captured_req_content; } else { $self->{captured_req_headers} = undef; $self->{captured_req_content} = undef; } return; } sub captured_req_headers { my $self = shift; unless (exists $self->{captured_req_headers}) { Carp::croak("You can't call cpatured_req_headers method without 'capture_request' options for Furl#new"); } return $self->{captured_req_headers}; } sub captured_req_content { my $self = shift; unless (exists $self->{captured_req_content}) { Carp::croak("You can't call cpatured_req_content method without 'capture_request' options for Furl#new"); } return $self->{captured_req_content}; } # accessors sub code { shift->{code} } sub message { shift->{message} } sub headers { shift->{headers} } sub content { shift->{content} } sub request { my $self = shift; if (!exists $self->{request}) { if (!exists $self->{request_src}) { Carp::croak("This request object does not have a request information"); } # my ($method, $uri, $headers, $content) = @_; $self->{request} = Furl::Request->new( $self->{request_src}->{method}, $self->{request_src}->{url}, $self->{request_src}->{headers}, $self->{request_src}->{content}, ); } return $self->{request}; } # alias sub status { shift->code() } sub body { shift->content() } # shorthand sub content_length { shift->headers->content_length() } sub content_type { shift->headers->content_type() } sub content_encoding { shift->headers->content_encoding() } sub header { shift->headers->header(@_) } sub protocol { "HTTP/1." . $_[0]->{minor_version} } sub decoded_content { my $self = shift; my $cloned = $self->headers->clone; # 'HTTP::Message::decoded_content' tries to decompress content # if response header contains 'Content-Encoding' field. # However 'Furl' decompresses content by itself, 'Content-Encoding' field # whose value is supported encoding type should be removed from response header. my @removed = grep { ! m{\b(?:gzip|x-gzip|deflate)\b} } $cloned->header('content-encoding'); $cloned->header('content-encoding', \@removed); $self->_as_http_response_internal([ $cloned->flatten ])->decoded_content(@_); } sub as_http_response { my ($self) = @_; return $self->_as_http_response_internal([ $self->headers->flatten ]) } sub _as_http_response_internal { my ($self, $flatten_headers) = @_; require HTTP::Response; my $res = HTTP::Response->new( $self->code, $self->message, $flatten_headers, $self->content ); $res->protocol($self->protocol); if ($self->{request_src} || $self->{request}) { if (my $req = $self->request) { $res->request($req->as_http_request); } } return $res; } sub to_psgi { my ($self) = @_; return [ $self->code, [$self->headers->flatten], [$self->content] ]; } sub as_string { my ($self) = @_; return join("", $self->status_line . "\015\012", $self->headers->as_string, "\015\012", $self->content, ); } sub as_hashref { my $self = shift; return +{ code => $self->code, message => $self->message, protocol => $self->protocol, headers => [$self->headers->flatten], content => $self->content, }; } sub is_success { substr( $_[0]->code, 0, 1 ) eq '2' } sub status_line { $_[0]->code . ' ' . $_[0]->message } sub charset { my $self = shift; return $self->{__charset} if exists $self->{__charset}; if ($self->can('content_charset')){ # To suppress: # Parsing of undecoded UTF-8 will give garbage when decoding entities local $SIG{__WARN__} = sub {}; my $charset = $self->content_charset; $self->{__charset} = $charset; return $charset; } my $content_type = $self->headers->header('Content-Type'); return unless $content_type; $content_type =~ /charset=([A-Za-z0-9_\-]+)/io; $self->{__charset} = $1 || undef; # Detect charset from HTML unless (defined($self->{__charset}) && $self->content_type =~ m{text/html}) { # I guess, this is not so perfect regexp. patches welcome. # # $self->content =~ m!/]+)['"]\s*/?>!smi; $self->{__charset} = $1; } $self->{__charset}; } sub encoder { require Encode; my $self = shift; return $self->{__encoder} if exists $self->{__encoder}; my $charset = $self->charset or return; my $enc = Encode::find_encoding($charset); $self->{__encoder} = $enc; } sub encoding { my $enc = shift->encoder or return; $enc->name; } 1; __END__ =encoding utf-8 =for stopwords charsets =head1 NAME Furl::Response - Response object for Furl =head1 SYNOPSIS my $res = Furl::Response->new($minor_version, $code, $message, $headers, $content); print $res->status, "\n"; =head1 DESCRIPTION This is a HTTP response object in Furl. =head1 CONSTRUCTOR my $res = Furl::Response->new($minor_version, $code, $msg, \%headers, $content); =head1 INSTANCE METHODS =over 4 =item $res->code =item $res->status Returns HTTP status code. =item $res->message Returns HTTP status message. =item $res->headers Returns instance of L =item $res->content =item $res->body Returns response body in scalar. =item $res->decoded_content This will return the content after any C<< Content-Encoding >> and charsets have been decoded. See L<< HTTP::Message >> for details =item $res->request Returns instance of L related this response. =item $res->content_length =item $res->content_type =item $res->content_encoding =item $res->header Shorthand to access L. =item $res->protocol $res->protocol(); # => "HTTP/1.1" Returns HTTP protocol in string. =item $res->as_http_response Make instance of L from L. =item $res->to_psgi() Convert object to L response. It's very useful to make proxy. =item $res->as_hashref() Convert response object to HashRef. Format is following: code: Int message: Str protocol: Str headers: ArrayRef[Str] content: Str =item $res->is_success Returns true if status code is 2xx. =item $res->status_line $res->status_line() # => "200 OK" Returns status line. =item my $headers = $res->captured_req_headers() : Str Captured request headers in raw string. This method is only for debugging. You can use this method if you are using C<< capture_request >> parameter is true. =item my $content = $res->captured_req_content() : Str Captured request content in raw string. This method is only for debugging. You can use this method if you are using C<< capture_request >> parameter is true. =back ZlibStream.pm100664001751001751 151213160135067 17753 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/lib/Furlpackage Furl::ZlibStream; # internal class. use strict; use warnings; use overload '.=' => 'append', fallback => 1; use Carp (); use Compress::Raw::Zlib qw(Z_OK Z_STREAM_END); sub new { my ( $class, $buffer ) = @_; my ( $zlib, $status ) = Compress::Raw::Zlib::Inflate->new( -WindowBits => Compress::Raw::Zlib::WANT_GZIP_OR_ZLIB(), ); $status == Z_OK or Carp::croak("Cannot initialize zlib: $status"); bless { buffer => $buffer, zlib => $zlib }, $class; } sub append { my ( $self, $partial ) = @_; my $status = $self->{zlib}->inflate( $partial, \my $deflated ); ($status == Z_OK or $status == Z_STREAM_END) or Carp::croak("Uncompress error: $status"); $self->{buffer} .= $deflated; return $self; } sub get_response_string { ref $_[0]->{buffer} ? undef : $_[0]->{buffer} } 1; 00_compile.t100664001751001751 44713160135067 16230 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/tuse strict; use Test::More tests => 1; BEGIN { use_ok 'Furl' } diag "Perl/$^V"; diag "Furl/$Furl::VERSION"; for my $optional(qw( Net::IDN::Encode IO::Socket::SSL Compress::Raw::Zlib )) { eval qq{ require $optional }; diag $optional . '/' . ($optional->VERSION || '(not installed)'); } 01_version.t100664001751001751 21113160135067 16253 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/tuse strict; use warnings; use utf8; use Test::More; use Furl::HTTP; use Furl; is($Furl::VERSION, $Furl::HTTP::VERSION); done_testing; 01_simple.t100664001751001751 346313160135067 17274 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); for (1 .. $n) { my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', headers => [ "X-Foo" => "ppp" ] ); is $code, 200, "request()/$_"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 4, 'header' or diag(explain($headers)); is $content, '/foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } for (1..3) { my $path_query = '/foo/bar?a=b;c=d&e=f'; my ( undef, $code, $msg, $headers, $content ) = $furl->request(url => "http://127.0.0.1:$port$path_query", method => 'GET'); is $code, 200, "get()/$_"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), length($path_query), 'header'; is $content, $path_query; } done_testing; }, server => sub { my $port = shift; t::HTTPServer->new(port => $port)->run(sub {; my $env = shift; is $env->{HTTP_X_FOO}, "ppp" if $env->{REQUEST_URI} eq '/foo'; like $env->{'HTTP_USER_AGENT'}, qr/\A Furl::HTTP /xms; return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}) ], [$env->{REQUEST_URI}] ]; }); } ); 03_redirect.t100664001751001751 713213160135067 17603 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack::Loader', 'Plack::Request'; use Plack::Loader; use Plack::Request; $ENV{LANG} = 'C'; test_tcp( client => sub { my $port = shift; subtest 'redirect' => sub { my $furl = Furl::HTTP->new(); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/1", ); is $code, 200; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 2; is $content, 'OK'; }; subtest 'not enough redirect' => sub { my $furl = Furl::HTTP->new(max_redirects => 0); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/1", ); is $code, 302; is $msg, 'Found'; is Furl::HTTP::_header_get($headers, 'Content-Length'), 0; is Furl::HTTP::_header_get($headers, 'Location'), "http://127.0.0.1:$port/2"; is $content, ''; }; subtest 'over max redirect' => sub { my $max_redirects = 7; my $furl = Furl::HTTP->new(max_redirects => $max_redirects); my $start_num = 4; my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/$start_num"); is $code, 302, 'code ok'; is $msg, 'Found', 'msg ok'; is Furl::HTTP::_header_get($headers, 'Content-Length'), 0, 'content length ok'; is Furl::HTTP::_header_get($headers, 'Location'), "http://127.0.0.1:$port/" . ( $max_redirects + $start_num + 1 ), 'url ok'; is $content, '', 'content ok'; }; subtest 'POST redirects' => sub { my $furl = Furl::HTTP->new(); my ( undef, undef, undef, undef, $content ) = $furl->post("http://127.0.0.1:$port/301", [], ""); is $content, 'POST', 'POST into 301 results in a POST'; ( undef, undef, undef, undef, $content ) = $furl->post("http://127.0.0.1:$port/302", [], ""); is $content, 'GET', 'POST into 302 is implemented as 303'; ( undef, undef, undef, undef, $content ) = $furl->post("http://127.0.0.1:$port/303", [], ""); is $content, 'GET', 'POST into 303 results in a GET'; ( undef, undef, undef, undef, $content ) = $furl->post("http://127.0.0.1:$port/307", [], ""); is $content, 'POST', 'POST into 307 results in a POST'; }; done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; my $req = Plack::Request->new($env); $req->path_info =~ m{/(\d+)$} or die; my $id = $1; if ($id == 3) { return [ 200, [ 'Content-Length' => 2 ], ['OK'] ]; } elsif ($id =~ /^3\d\d$/) { my $base = $req->base; $base->path("/200"); # redirect target, see below return [ $id, [ 'Location' => $base->as_string ] ]; } elsif ($id == 200) { # redirect target, see above my $method = $req->method; return [ 200, [ 'Content-Length' => length $method ], [$method] ]; } else { my $base = $req->base; $base->path('/' . ($id + 1)); return [ 302, ['Location' => $base->as_string], []]; } }); } ); 04_chunked.t100664001751001751 300613160135067 17420 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Test::TCP; use Test::More; use Furl::HTTP; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; my $s = q{The quick brown fox jumps over the lazy dog.\n}; my $chunk = sprintf qq{%x;foo=bar;baz="qux"\015\012%s\015\012}, length($s), $s; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 80); # some httpd(e.g. ASP.NET) returns 00000000 as chunked end. for my $chunk_end (qw(0 00000000)) { for my $i(1, 3, 1024) { note "-- TEST (packets: $i)"; my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path => '/', host => '127.0.0.1', headers => ['X-Packet-Size', $i, 'X-Chunck-End' => $chunk_end], ); is $code, 200, 'status'; is $content, $s x $i, 'content'; } } done_testing; }, server => sub { my $port = shift; t::HTTPServer->new( port => $port, enable_chunked => 0 )->run( sub { my $env = shift; my $size = $env->{HTTP_X_PACKET_SIZE} or die '???'; my $end_mark = $env->{HTTP_X_CHUNCK_END}; return [ 200, [ 'Transfer-Encoding' => 'chunked' ], [ $chunk x $size, $end_mark, "\015\012" x 2 ] ]; } ); } ); 05_slowloris.t100664001751001751 323313160135067 20037 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Request; use FindBin; use lib "$FindBin::Bin/../.."; use t::Slowloris; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(); for (1..$n) { my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', headers => [ "X-Foo" => "ppp" ] ); is $code, 200, "request()/$_"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 4; is $content, '/foo'; } for (1..3) { my $path_query = '/bar?a=b;c=d&e=f'; my ( undef, $code, $msg, $headers, $content ) = $furl->request(url => "http://127.0.0.1:$port$path_query", method => 'GET'); is $code, 200, "get()/$_"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), length($path_query); is $content, $path_query; } done_testing; }, server => sub { my $port = shift; Slowloris::Server->new(port => $port)->run(sub { my $env = shift; is $env->{'HTTP_X_FOO'}, "ppp" if $env->{REQUEST_URI} eq '/foo'; return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}) ], [$env->{REQUEST_URI}] ]; }); } ); 06_errors.t100664001751001751 500513160135067 17316 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Request; use Errno (); { my $furl = Furl::HTTP->new(); eval { $furl->request(); }; like $@, qr/missing host name/i, 'missuse'; eval { $furl->request(url => 'ftp://ftp.example.com/', method => 'GET'); }; like $@, qr/unsupported scheme/i, 'missuse'; foreach my $bad_url(qw( hogehoge http://example.com:80foobar http://example.com: )) { eval { $furl->request(url => $bad_url, method => 'GET'); }; like $@, qr/malformed URL/, "malformed URL: $bad_url"; } } my $n = shift(@ARGV) || 3; my $fail_on_syswrite = 1; { package Errorneous::Socket; use parent qw(IO::Socket::INET); sub syswrite { my($sock, $buff, $len, $off) = @_; if($fail_on_syswrite) { $sock->SUPER::syswrite($buff, $len - 1, $off); close $sock; $! = Errno::EPIPE; return undef; } return $sock->SUPER::syswrite($buff, $len, $off); } package Errorneous::Server; use parent qw(HTTP::Server::PSGI); sub setup_listener { my $self = shift; $self->SUPER::setup_listener(@_); bless $self->{listen_sock}, 'Errorneous::Socket'; ::note 'Errorneous::Server listening'; } } test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(); for (1..$n) { my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', headers => [ "X-Foo" => "ppp" ] ); is $code, 500, "request()/$_"; like $msg, qr/Internal Response: Unexpected EOF while reading response header/; is ref($headers), "ARRAY"; ok $content, 'content: ' . $content; } done_testing; }, server => sub { my $port = shift; Errorneous::Server->new(port => $port)->run(sub { my $env = shift; #note explain $env; my $req = Plack::Request->new($env); is $req->header('X-Foo'), "ppp" if $env->{REQUEST_URI} eq '/foo'; return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}) ], [$env->{REQUEST_URI}] ]; }); } ); 07_timeout.t100664001751001751 637413160135067 17503 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use Time::HiRes qw(time); use Test::Requires qw(Plack::Util Plack::Request HTTP::Body), 'Plack::Request', 'Plack::Loader'; use FindBin; use lib "$FindBin::Bin/../.."; use t::Slowloris; my $n = shift(@ARGV) || 2; $Slowloris::SleepBeforeRead = 1; $Slowloris::SleepBeforeWrite = 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(timeout => 1.5); note 'read_timeout'; for (1 .. $n) { my $start_at = time; my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', ); my $elapsed = time - $start_at; is $code, 500, "request()/$_"; like $msg, qr/Internal Response: Cannot read response header: timeout/; is ref($headers), "ARRAY"; ok $content, 'content: ' . $content; ok 1.3 <= $elapsed && $elapsed <= 2; } $furl = Furl::HTTP->new(timeout => 0.5); note 'write_timeout'; my $CONTENT_SIZE_MB_MAX = 256; WRITE_TIMEOUT_TEST: for (1 .. $n) { my $content_size_mb = 1; my ($elapsed, $code, $msg, $headers, $content); while(1) { note "Try sending $content_size_mb MiB content."; my $start_at = time; ( undef, $code, $msg, $headers, $content ) = $furl->request( host => '127.0.0.1', port => $port, method => 'POST', path_query => '/foo', content => do { # should be larger than SO_SNDBUF + SO_RCVBUF + TCP_window_size my $content = "0123456789abcdef" x 64 x 1024 x $content_size_mb; open my $fh, '<', \$content or die "oops"; $fh; }, ); $elapsed = time - $start_at; if($msg !~ qr/Internal Response: Cannot read response header: timeout/) { ## It's not read timeout. It seems OK. last; } if($content_size_mb >= $CONTENT_SIZE_MB_MAX) { fail "send $content_size_mb MiB but still write timeout did not occur."; next WRITE_TIMEOUT_TEST; } note "Read timeout. Retry with more POST content"; $content_size_mb *= 2; } is $code, 500, "request()/$_"; like $msg, qr/Internal Response: Failed to send content: timeout/; is ref($headers), "ARRAY"; is Plack::Util::header_get($headers, 'X-Internal-Response'), 1; ok $content, 'content: ' . $content; ok 0.4 <= $elapsed && $elapsed <= 1; } done_testing; }, server => sub { my $port = shift; Slowloris::Server->new(port => $port)->run(sub { my $env = shift; return [ 200, [], [$env->{REQUEST_URI}] ]; }); } ); 08_proxy.t100664001751001751 1261413160135067 17211 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; use Test::Requires qw(Plack::Request HTTP::Body), 'HTTP::Proxy'; plan tests => (10*2 + 8)*3; my $verbose = 1; { package Test::HTTP::Proxy; use parent qw(HTTP::Proxy); sub log { my($self, $level, $prefix, $msg) = @_; ::note "$prefix: $msg" if $verbose; } } { package Test::UserAgent; use parent qw(LWP::UserAgent); use Test::More; sub real_httpd_port { my ($self, $port) = @_; $self->{httpd_port} = $port if defined $port; return $self->{httpd_port}; } sub simple_request { my ($self, $req, @args) = @_; my $uri = $req->uri; my $host = $req->header('Host'); if ($self->real_httpd_port) { # test for URL with a default port like $uri.q(), qr!^http://[^:]+/!, 'No port number in the request line'; unlike $host, qr!:!, 'No port number in Host header'; # replace the port number to correctly connect to the test server $uri->port($self->real_httpd_port); } else { # test for URL with non-default port like $uri.q(), qr!^http://[^/]+:[0-9]+/!, 'A port number in the request line'; like $host, qr/:[0-9]+$/, 'A port number in Host header'; } return $self->SUPER::simple_request($req, @args); } } my $via = "VIA!VIA!VIA!"; my $httpd = Test::TCP->new(code => sub { my $httpd_port = shift; Plack::Loader->auto(port => $httpd_port)->run(sub { my $env = shift; my $req = Plack::Request->new($env); is $req->path, '/foo'; is $req->header('X-Foo'), "ppp"; like $req->header('User-Agent'), qr/\A Furl::HTTP /xms; my $content = "Hello, foo"; return [ 200, [ 'Content-Length' => length($content) ], [ $content ] ]; }); }); sub client (%) { my (%args) = @_; for (1..3) { # run some times for testing keep-alive. my $furl = Furl::HTTP->new(proxy => $args{proxy}); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => $args{request}, headers => [ "X-Foo" => "ppp" ] ); is $code, 200, "request()"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 10; is Furl::HTTP::_header_get($headers, 'Via'), $args{via}; is $content, 'Hello, foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } } sub test_agent () { return Test::UserAgent->new( env_proxy => 1, keep_alive => 2, parse_head => 0, ); } local $ENV{'HTTP_PROXY'} = ''; # Request target with non-default port test_tcp( client => sub { my $proxy_port = shift; my $httpd_port = $httpd->port; client( proxy => "http://127.0.0.1:$proxy_port", request => "http://127.0.0.1:$httpd_port/foo", via => '1.0 VIA!VIA!VIA!', ); }, server => sub { # proxy server my $proxy_port = shift; my $proxy = Test::HTTP::Proxy->new(port => $proxy_port, via => $via); $proxy->agent(test_agent); $proxy->start(); }, ); # Request target with default port test_tcp( client => sub { my $proxy_port = shift; my $httpd_port = $httpd->port; client( proxy => "http://127.0.0.1:$proxy_port", request => "http://127.0.0.1/foo", # default port via => '1.0 VIA!VIA!VIA!', ); }, server => sub { # proxy server my $proxy_port = shift; my $proxy = Test::HTTP::Proxy->new(port => $proxy_port, via => $via); $proxy->agent(test_agent); $proxy->agent->real_httpd_port($httpd->port); $proxy->start(); }, ); # SSL over proxy test_tcp( client => sub { # emulate CONNECT for SSL proxying without a real SSL connection no warnings 'redefine'; local *Furl::HTTP::connect_ssl_over_proxy = sub { my ($self, $proxy_host, $proxy_port, $host, $port, $timeout_at, $proxy_authorization) = @_; my $sock = $self->connect($proxy_host, $proxy_port, $timeout_at); my $p = "CONNECT $host:$port HTTP/1.0\015\012Server: $host\015\012"; $p .= "\015\012"; $self->write_all($sock, $p, $timeout_at) or fail; # read the entire response of CONNECT method my $buf = ''; while ($buf !~ qr!(?:\015\012){2}!) { my $read = $self->read_timeout( $sock, \$buf, $self->{bufsize}, length($buf), $timeout_at ); defined $read or fail; $read != 0 or fail; } $sock; }; my $proxy_port = shift; my $httpd_port = $httpd->port; client( proxy => "http://127.0.0.1:$proxy_port", request => "https://127.0.0.1:$httpd_port/foo", # no via since the request goes directly to the origin server ); }, server => sub { # proxy server my $proxy_port = shift; my $proxy = Test::HTTP::Proxy->new(port => $proxy_port, via => $via); $proxy->start(); }, ); 09_body.t100664001751001751 515413160135067 16747 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Fcntl qw(SEEK_SET); use Plack::Request; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 80); for my $x(1, 1000) { my $req_content = "WOWOW!" x $x; note 'request content length: ', length $req_content; open my $req_content_fh, '<', \$req_content or die "oops"; my ( undef, $code, $msg, $headers, $content ) = $furl->request( method => 'POST', port => $port, path_query => '/foo', host => '127.0.0.1', headers => [ "X-Foo" => "ppp" ], content => $req_content_fh, ); is $code, 200, "request()"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), length($req_content); is $content, $req_content or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } { open my $req_content_fh, '<', $0 or die "oops"; note 'request $0: ', -s $req_content_fh; my $req_content = do{ local $/; <$req_content_fh> }; seek $req_content_fh, 0, SEEK_SET; my ( undef, $code, $msg, $headers, $content ) = $furl->request( method => 'POST', port => $port, path_query => '/foo', host => '127.0.0.1', headers => [ "X-Foo" => "ppp" ], content => $req_content_fh, ); is $code, 200, "request()"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), length($req_content); is $content, $req_content or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; #note explain $env; my $req = Plack::Request->new($env); is $req->header('X-Foo'), "ppp" if $env->{REQUEST_URI} eq '/foo'; like $req->header('User-Agent'), qr/\A Furl::HTTP /xms; return [ 200, [ 'Content-Length' => length($req->content) ], [$req->content] ]; }); } ); 11_write_file.t100664001751001751 210113160135067 20121 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; use File::Temp; use Fcntl qw/:seek/; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(); my $tmp = File::Temp->new(UNLINK => 1); my ( undef, $code, $msg, $headers, ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', write_file => $tmp, ); is $code, 200, "request()"; seek $tmp, 0, SEEK_SET; my $content = do { local $/; <$tmp> }; is $content, "OK!YAY!"; done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; my $content = "OK!YAY!"; return [ 200, [ 'Content-Length' => length($content) ], [$content] ]; }); } ); 12_write_code.t100664001751001751 175313160135067 20131 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; use File::Temp; use Fcntl qw/:seek/; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(); my $content; my ( undef, $code, $msg, $headers, ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', write_code => sub { $content .= $_[3] }, ); is $code, 200, "request()"; is $content, "OK!YAY!"; done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; my $content = "OK!YAY!"; return [ 200, [ 'Content-Length' => length($content) ], [$content] ]; }); } ); 13_deflate.t100664001751001751 607713160135067 17416 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack::Middleware::Deflater', 'Compress::Raw::Zlib'; use Furl; use Furl::HTTP; use Test::TCP; use Test::More; use Plack::Request; use File::Temp; use FindBin; use lib "$FindBin::Bin/../.."; use t::Slowloris; my $n = 10; my $CONTENT = 'OK! YAY!' x 100; test_tcp( client => sub { my $port = shift; for my $encoding (qw/gzip deflate/) { my $furl = Furl::HTTP->new( headers => ['Accept-Encoding' => $encoding], ); for(1 .. $n) { note "normal $_ $encoding"; my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/", ); is $code, 200, "request()"; is Furl::HTTP::_header_get($headers, 'content-encoding'), $encoding; is($content, $CONTENT) or do { require Devel::Peek; Devel::Peek::Dump($content) }; } for(1 .. $n) { note "to filehandle $_ $encoding"; open my $fh, '>', \my $content; my ( undef, $code, $msg, $headers ) = $furl->request( url => "http://127.0.0.1:$port/", write_file => $fh, ); is $code, 200, "request()"; is Furl::HTTP::_header_get($headers, 'content-encoding'), $encoding; is($content, $CONTENT) or do { require Devel::Peek; Devel::Peek::Dump($content) }; } for(1 .. $n){ note "to callback $_ $encoding"; my $content = ''; my ( undef, $code, $msg, $headers ) = $furl->request( url => "http://127.0.0.1:$port/", write_code => sub { $content .= $_[3] }, ); is $code, 200, "request()"; is Furl::HTTP::_header_get($headers, 'content-encoding'), $encoding; is($content, $CONTENT) or do { require Devel::Peek; Devel::Peek::Dump($content) }; } for(1 .. $n){ note "decoded_content $_"; my $res = Furl->new( headers => ['Accept-Encoding' => $encoding] )->get("http://127.0.0.1:$port/"); ok defined($res->decoded_content); } } done_testing; }, server => sub { my $port = shift; Slowloris::Server->new( port => $port )->run( Plack::Middleware::Deflater->wrap( sub { my $env = shift; like $env->{HTTP_USER_AGENT}, qr/\A Furl::HTTP/xms; return [ 200, [ 'Content-Length' => length($CONTENT) ], [$CONTENT] ]; } ) ); } ); 15_multiline_header.t100664001751001751 153613160135067 21321 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; use File::Temp; use Fcntl qw/:seek/; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(); my ( undef, $status, $msg, $headers, $body ) = $furl->request( url => "http://127.0.0.1:$port/", headers => [ 'X-Foo' => "bar\015\012baz" ], method => 'GET' ); is $status, 200; done_testing; }, server => sub { my $port = shift; Plack::Loader->auto( port => $port )->run( sub { my $req = Plack::Request->new(shift); is $req->header('X-Foo'), "bar baz"; return [ 200, [ 'Content-Length' => 2 ], ['OK'] ]; } ); } ); 16_read_callback.t100664001751001751 232013160135067 20527 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; use Test::Requires qw(Plack::Request HTTP::Body), 'IO::Callback'; my @data = qw/foo bar baz/; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(); my $fh = IO::Callback->new( '<', sub { my $x = shift @data; $x ? "-$x" : undef } ); my ( undef, $code, $msg, $headers, $content ) = $furl->request( method => 'PUT', url => "http://127.0.0.1:$port/", headers => ['Content-Length' => length(join('', map { "-$_" } @data)) ], content => $fh, ); is $code, 200, "request()"; done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; my $req = Plack::Request->new($env); is $req->content, "-foo-bar-baz"; return [ 200, [ 'Content-Length' => length($req->content) ], [$req->content] ]; }); } ); 17_keep_alive.t100664001751001751 264013160135067 20112 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; my ($stealed, $pushed) = (0, 0); { package MyConnPool; sub new { bless [], shift } sub steal { $stealed++; undef } sub push { $pushed++; undef } } test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(connection_pool => MyConnPool->new()); for (1 .. 3) { note "-- TEST $_"; my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path => '/', host => '127.0.0.1', ); is $code, 200; is $content, 'OK' x 100; } is $stealed, 3, 'stealed'; is $pushed, 3; $pushed = 0; $stealed = 0; $furl->request( method => 'HEAD', port => $port, path => '/', host => '127.0.0.1', ); is $pushed, 0, 'HEAD forces to close connections'; is $stealed, 1; done_testing; }, server => sub { my $port = shift; t::HTTPServer->new( port => $port )->run( sub { my $env = shift; return [ 200, [ ], [ 'OK' x 100 ] ]; } ); } ); 18_no_proxy.t100664001751001751 532413160135067 17666 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; use Test::Requires qw(Plack::Request HTTP::Body), 'HTTP::Proxy'; plan tests => 4 + 7*3; my $verbose = 1; { package Test::HTTP::Proxy; use parent qw(HTTP::Proxy); sub log { my($self, $level, $prefix, $msg) = @_; ::note "$prefix: $msg" if $verbose; } } { my $furl = Furl::HTTP->new; ok $furl->match_no_proxy(".google.com", "www.google.com"); ok $furl->match_no_proxy("google.com", "www.google.com"); ok $furl->match_no_proxy("google.com,.yahoo.com", "mail.yahoo.com"); ok $furl->match_no_proxy(",twitter.com , facebook.com", "www.twitter.com"); } my $via = "VIA!VIA!VIA!"; test_tcp( client => sub { my $proxy_port = shift; test_tcp( client => sub { # http client my $httpd_port = shift; for (1..3) { # run some times for testing keep-alive. my $furl = Furl::HTTP->new(proxy => "http://127.0.0.1:$proxy_port", no_proxy => "127.0.0.1"); my ( undef,$code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$httpd_port/foo", headers => [ "X-Foo" => "ppp" ] ); is $code, 200, "request()"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 10; isnt Furl::HTTP::_header_get($headers, 'Via'), "1.0 $via", "passing through the proxy"; is $content, 'Hello, foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } }, server => sub { # http server my $httpd_port = shift; Plack::Loader->auto(port => $httpd_port)->run(sub { my $env = shift; my $req = Plack::Request->new($env); is $req->header('X-Foo'), "ppp" if $env->{REQUEST_URI} eq '/foo'; like $req->header('User-Agent'), qr/\A Furl::HTTP /xms; my $content = "Hello, foo"; return [ 200, [ 'Content-Length' => length($content) ], [ $content ] ]; }); }, ); }, server => sub { # proxy server my $proxy_port = shift; my $proxy = Test::HTTP::Proxy->new(port => $proxy_port, via => $via); $proxy->start(); }, ); 19_special_headers.t100664001751001751 322713160135067 21125 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10); for (1 .. $n) { my %special_headers = ( 'x-bar' => '', ); my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', headers => [ "X-Foo" => "ppp" ], special_headers => \%special_headers, ); is $code, 200, "request()/$_"; is $msg, "OK"; is $special_headers{'content-length'}, 4, 'header' or diag(explain(\%special_headers)); is $special_headers{'x-bar'}, 10; is $content, '/foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; #note explain $env; my $req = Plack::Request->new($env); is $req->header('X-Foo'), "ppp" if $env->{REQUEST_URI} eq '/foo'; like $req->header('User-Agent'), qr/\A Furl::HTTP /xms; return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}), 'X-Bar' => 10 ], [$env->{REQUEST_URI}] ]; }); } ); 20_header_format_none.t100664001751001751 342013160135067 21614 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP qw/HEADERS_NONE/; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new( bufsize => 10, header_format => HEADERS_NONE, ); for (1 .. $n) { my %special_headers = ( 'x-bar' => '', ); my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', headers => [ "X-Foo" => "ppp" ], special_headers => \%special_headers, ); is $code, 200, "request()/$_"; is $msg, "OK"; is $special_headers{'content-length'}, 4, 'header' or diag(explain(\%special_headers)); is $special_headers{'x-bar'}, 10; is $content, '/foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; is $headers, undef; } done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; #note explain $env; my $req = Plack::Request->new($env); is $req->header('X-Foo'), "ppp" if $env->{REQUEST_URI} eq '/foo'; like $req->header('User-Agent'), qr/\A Furl::HTTP /xms; return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}), 'X-Bar' => 10 ], [$env->{REQUEST_URI}] ]; }); } ); 21_keep_alive_timedout.t100664001751001751 267413160135067 22026 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_low#!perl -w use strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(timeout => 1); for (1 .. $n) { note "request/$_"; my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', ); is $code, 200, "request()/$_"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 2, 'header' or diag(explain($headers)); is Furl::HTTP::_header_get($headers, 'Connection'), 'keep-alive'; is $content, 'OK' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } done_testing; }, server => sub { my $port = shift; t::HTTPServer->new( port => $port )->add_trigger( "AFTER_HANDLE_REQUEST" => sub { my ( $s, $csock ) = @_; $csock->close(); } )->run( sub { +[ 200, [ 'Content-Length' => 2, 'Connection' => 'keep-alive' ], ['OK'] ]; } ); } ); 22_keep_alive.t100664001751001751 276213160135067 20113 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Socket (); use Test::More; use Test::Requires 'Starlet::Server', 'Plack::Loader'; use Test::TCP; { no warnings 'redefine'; my $orig = *Starlet::Server::_get_acceptor{CODE}; *Starlet::Server::_get_acceptor = sub { my $acceptor = shift->$orig(@_); return sub { my ($conn, $peer, $listen) = $acceptor->(); if ($conn) { setsockopt($conn, Socket::SOL_SOCKET, Socket::SO_LINGER, pack('ii', 1, 0)) or warn "failed to set SO_LINGER: $!"; return ($conn, $peer, $listen); } else { return (); } } }; } test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(timeout => 1); my ($code, $msg); (undef, $code, $msg) = $furl->request(port => $port, host => '127.0.0.1'); is $code, 200; is $msg, 'OK'; sleep 2; (undef, $code, $msg) = $furl->request(port => $port, host => '127.0.0.1'); is $code, 200; is $msg, 'OK'; }, server => sub { my $port = shift; my %args = ( port => $port, keepalive_timeout => 1, max_keepalive_reqs => 100, max_reqs_per_child => 100, max_workers => 1, ); my $app = sub { [200, ['Content-Length' => 2], ['ok']] }; Plack::Loader->load('Starlet', %args)->run($app); exit; }, ); done_testing; 22_keep_alive_http10.t100664001751001751 323513160135067 21307 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_low#!perl -w use strict; use warnings; use Test::Requires { 'Plack::Request' => 0, 'HTTP::Body' => 0, Starlet => 0.11 }; use Furl::HTTP; use Test::TCP; use Test::More; use Starlet::Server; my $n = shift(@ARGV) || 3; my $host = '127.0.0.1'; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(); for (1 .. $n) { note "request/$_"; my ( undef, $code, $msg, $headers, $content ) = $furl->request( host => $host, port => $port, path_query => '/foo', ); is $code, 200, "request()/$_"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 4, 'header' or diag(explain($headers)); is Furl::HTTP::_header_get($headers, 'Connection'), 'keep-alive' or diag(explain($headers)); is $content, '/foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; ok defined( $furl->{connection_pool}->steal($host, $port) ), 'in keep-alive'; } done_testing; }, server => sub { my $port = shift; Starlet::Server->new( host => $host, port => $port, max_keepalive_reqs => 10, )->run(sub { my $env = shift; $env->{SERVER_PROTOCOL} = 'HTTP/1.0'; #force response HTTP/1.0 return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}) ], [$env->{REQUEST_URI}] ]; }); } ); 23_redirect_relative.t100664001751001751 317013160135067 21476 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), 'URI'; use Plack::Request; test_tcp( client => sub { my $port = shift; subtest 'redirect' => sub { my $furl = Furl::HTTP->new(); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/foo/" ); is $code, 200; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 2; is $content, 'OK'; }; subtest 'redirect to root' => sub { my $furl = Furl::HTTP->new(max_redirects => 0); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/baz/" ); is $code, 302; is $msg, "Found"; is Furl::HTTP::_header_get($headers, 'location'), "/foo/"; }; done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; my $req = Plack::Request->new($env); if ($env->{PATH_INFO} eq '/foo/bar') { return [ 200, [ 'Content-Length' => 2 ], ['OK'] ]; } elsif ($env->{PATH_INFO} eq '/baz/') { return [ 302, [ 'Location' => '/foo/', 'Content-Length' => 0 ], [] ]; } else { return [ 302, [ 'Location' => './bar', 'Content-Length' => 0 ], [] ]; } }); } ); 24_no_content.t100664001751001751 174613160135067 20160 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Test::More; use Furl::HTTP; use Test::TCP; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); for (1 .. $n) { my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', content => '', ); is $code, 200, "request()/$_"; is $msg, "OK"; } done_testing; }, server => sub { my $port = shift; t::HTTPServer->new(port => $port)->run(sub {; my $env = shift; return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}) ], [$env->{REQUEST_URI}] ]; }); } ); 25_signal.t100664001751001751 370413160135067 17264 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_low# to test "stop_if" use strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; plan skip_all => "Win32 is not supported" if Furl::HTTP::WIN32; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $stop_if = 0; my $furl = Furl::HTTP->new( bufsize => 10, stop_if => sub { $stop_if }, ); local $SIG{ALRM} = sub { note "caught ALRM"; }; for (1 .. $n) { note "try it $_ with stop_if=false"; # ignore signal $stop_if = undef; alarm(2); my ($undef, $code, $msg, $headers, $content) = $furl->request( port => $port, path_query => '/', host => '127.0.0.1', ); is $code, 200, "ignore signal ($_)"; alarm(0); sleep(4); # wait until the server stops handling the request # cancel on signal note "try it $_ with stop_if=true"; $stop_if = 1; alarm(2); ($undef, $code, $msg, $headers, $content) = $furl->request( port => $port, path_query => '/5', host => '127.0.0.1', ); is $code, 500, "cancelled ($_)"; alarm(0); sleep(4); # wait until the server stops handling the request } done_testing; }, server => sub { my $port = shift; t::HTTPServer->new(port => $port)->run(sub { my $env = shift; sleep(4); return [ 200, [ 'Content-Type' => 'text/plain', 'Content-Length' => 5, ], [ 'hello' ], ]; }); }, ); 26_headers_only.t100664001751001751 532713160135067 20467 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use HTTP::Parser::XS qw(parse_http_request); use IO::Socket::INET; use Test::More; use Furl::HTTP; use Test::TCP; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new( bufsize => 10, timeout => 3, ); for my $req_code (qw(199 204 304)) { for (1 .. $n) { my (undef, $code, $msg, $headers, $content) = $furl->request( port => $port, path_query => "/$req_code", host => '127.0.0.1', ); if ($req_code ne 199) { is $code, $req_code, "$msg"; is $content, ''; } else { is $code, 200, "$msg"; is $content, 'you will see this message!'; } } } }, server => sub { my $port = shift; my $listen_sock = IO::Socket::INET->new( Listen => 5, LocalHost => '127.0.0.1', LocalPort => $port, ReuseAddr => 1, ) or die $!; MAIN_LOOP: while (1) { my $sock = $listen_sock->accept or next; my $buf = ''; my %env; PARSE_HTTP_REQUEST: while (1) { my $nread = sysread( $sock, $buf, 1048576, length($buf)); $buf =~ s!^(\015\012)*!!; if (! defined $nread) { die "cannot read HTTP request header: $!"; } if ($nread == 0) { # unexpected EOF while reading HTTP request header warn "received a broken HTTP request"; next MAIN_LOOP; } my $ret = parse_http_request($buf, \%env); if ($ret == -2) { # incomplete. next; } elsif ($ret == -1) { # request is broken die "broken HTTP header"; } else { $buf = substr($buf, $ret); last PARSE_HTTP_REQUEST; } } my $code = $env{PATH_INFO} =~ m{^/([0-9]+)$} ? $1 : 200; if ((int $code / 100) ne 1) { print $sock '', << "EOT"; HTTP/1.0 $code love\r Connection: close\r Content-Length: 100\r \r you shall never see this message! EOT } else { print $sock '', << "EOT"; HTTP/1.0 $code love\r \r HTTP/1.0 200 OK\r Content-Length: 26\r \r you will see this message! EOT } close $sock; } }, ); done_testing; 27_close_on_eof.t100664001751001751 214113160135067 20435 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use IO::Socket::INET; use Test::More; use Test::TCP; test_tcp( client => sub { my $port = shift; my (undef, $code, undef, undef, $body) = Furl::HTTP->new->request( method => 'GET', host => '127.0.0.1', port => $port, path => '/', ); is $code, 200, 'code'; is $body, 'abcde', 'body'; }, server => sub { my $port = shift; my $listen_sock = IO::Socket::INET->new( Listen => 5, LocalHost => '127.0.0.1', LocalPort => $port, ReuseAddr => 1, ) or die $!; local $SIG{PIPE} = 'IGNORE'; while (1) { my $sock = $listen_sock->accept or next; sysread($sock, my $buf, 1048576, 0); # read request syswrite $sock, join( "\r\n", "HTTP/1.0 200 OK", "Content-Type: text/plain", "", "abcde", ); close $sock; } }, ); done_testing; 28_idn.t100664001751001751 301713160135067 16561 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; use Test::TCP; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), 'Net::IDN::Encode'; sub test_uses_idn { my %specs = @_; my ($host, $expects, $desc) = @specs{qw/host expects desc/}; subtest $desc => sub { test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(timeout => 0.3); my $used = 0; no warnings 'redefine'; local *Net::IDN::Encode::domain_to_ascii = sub { $used = 1; return '127.0.0.1', }; my (undef, $code, $msg, $headers, $content) = $furl->request( port => $port, path_query => '/', host => $host, ); is $used, $expects, 'result'; }, server => sub { my $port = shift; t::HTTPServer->new(port => $port)->run(sub { my $env = shift; return [200, [], ['OK']]; }); }, ); }; } test_uses_idn( host => '127.0.0.1', expects => 0, desc => 'local host', ); test_uses_idn( host => '例え.テスト', expects => 1, desc => 'uses idn', ); test_uses_idn( host => '127.0.0._', expects => 0, desc => 'in underscore', ); done_testing; 29_completion_slash.t100664001751001751 711513160135067 21356 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; my $server = sub { my $port = shift; t::HTTPServer->new(port => $port)->run(sub { my $env = shift; return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}) ], [ $env->{REQUEST_URI} ], ]; }); }; note '/foo => /foo'; test_tcp( server => $server, client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); do { my (undef, $code, $msg, $headers, $content) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', ); is $code, 200, "code"; is $msg, "OK" , "msg"; is $content, "/foo", "return path query"; }; do { my $path_query = '/foo'; my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port$path_query", method => 'GET', ); is $code, 200, 'code'; is $msg, 'OK', 'msg'; is $content, '/foo'; }; }, ); note 'foo => /foo'; test_tcp( server => $server, client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); do { my (undef, $code, $msg, $headers, $content) = $furl->request( port => $port, path_query => 'foo', host => '127.0.0.1', ); is $code, 200, 'code'; is $msg, 'OK' , 'msg'; is $content, '/foo', 'return path query'; }; }, ); note '/?foo=bar => /?foo=bar'; test_tcp( server => $server, client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); do { my (undef, $code, $msg, $headers, $content) = $furl->request( port => $port, path_query => '/?foo=bar', host => '127.0.0.1', ); is $code, 200, 'code'; is $msg, 'OK' , 'msg'; is $content, '/?foo=bar', 'return path query'; }; do { my $path_query = '/?foo=bar'; my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port$path_query", method => 'GET', ); is $code, 200, 'code'; is $msg, 'OK', 'msg'; is $content, '/?foo=bar'; }; }, ); note '?foo=bar => /?foo=bar'; test_tcp( server => $server, client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); do { my (undef, $code, $msg, $headers, $content) = $furl->request( port => $port, path_query => '?foo=bar', host => '127.0.0.1', ); is $code, 200, "code"; is $msg, "OK" , "msg"; is $content, "/?foo=bar", "return path query"; }; do { my $path_query = '?foo=bar'; my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port$path_query", method => 'GET', ); is $code, 200, 'code'; is $msg, 'OK', 'msg'; is $content, '/?foo=bar'; }; }, ); done_testing; 30_user_agent.t100664001751001751 326713160135067 20143 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; test_tcp( client => sub { my $port = shift; subtest 'set agent' => sub { my $furl = Furl::HTTP->new(); $furl->agent('foobot'); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/1", ); is $code, 200; is $content, 'foobot'; }; subtest 'set agent at request' => sub { my $furl = Furl::HTTP->new(); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/2", headers => [ "User-Agent" => "foobot" ] ); is $code, 200; like $content, qr/\A Furl::HTTP\/[^,]+,\sfoobot /xms; }; subtest 'set agent and request with agent' => sub { my $furl = Furl::HTTP->new(); $furl->agent('foobot'); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$port/3", headers => [ "User-Agent" => "barbot" ] ); is $code, 200; is $content, 'foobot, barbot'; }; }, server => sub { my $port = shift; t::HTTPServer->new(port => $port)->run(sub { my $env = shift; return [ 200, [ 'Content-Length' => length($env->{'HTTP_USER_AGENT'}) ], [$env->{'HTTP_USER_AGENT'}] ]; }); } ); done_testing; 31_chunked_unexpected_eof.t100664001751001751 245413160135067 22503 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use IO::Socket::INET; use Test::More; use Test::TCP; my $chunk = "x"x1024; my @res; for ( 1..20) { push @res, '400', $chunk; } test_tcp( client => sub { my $port = shift; my (undef, $code, undef, undef, $body) = Furl::HTTP->new->request( method => 'GET', host => '127.0.0.1', port => $port, path => '/', ); is $code, 500, 'code'; like $body, qr/Unexpected EOF/, 'body'; }, server => sub { my $port = shift; my $listen_sock = IO::Socket::INET->new( Listen => 5, LocalHost => '127.0.0.1', LocalPort => $port, ReuseAddr => 1, ) or die $!; local $SIG{PIPE} = 'IGNORE'; while (1) { my $sock = $listen_sock->accept or next; sysread($sock, my $buf, 1048576, 0); # read request my $n = syswrite $sock, join( "\r\n", "HTTP/1.1 200 OK", "Content-Type: text/plain", "Transfer-Encoding: chunked", "Connection: close", "", @res, "5", ); close $sock; } }, ); done_testing; 32_proxy_auth.t100664001751001751 1032513160135067 20224 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body MIME::Base64 HTTP::Proxy::HeaderFilter::simple HTTP::Proxy URI::Escape); use Plack::Loader; use Test::More; use Plack::Request; use MIME::Base64 qw/encode_base64/; plan tests => 7*6; my $verbose = 1; { package Test::HTTP::Proxy; use parent qw(HTTP::Proxy); sub log { my($self, $level, $prefix, $msg) = @_; ::note "$prefix: $msg" if $verbose; } } my $via = "VIA!VIA!VIA!"; local $ENV{'HTTP_PROXY'} = ''; test_tcp( client => sub { my $proxy_port = shift; test_tcp( client => sub { # http client my $httpd_port = shift; for (1..3) { # run some times for testing keep-alive. my $furl = Furl::HTTP->new(proxy => "http://dankogai:kogaidan\@127.0.0.1:$proxy_port"); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$httpd_port/foo", headers => [ "X-Foo" => "ppp" ] ); is $code, 200, "request()"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 10; is Furl::HTTP::_header_get($headers, 'Via'), "1.0 $via"; is $content, 'Hello, foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } for (4..6) { # run some times for testing keep-alive. my $furl = Furl::HTTP->new(proxy => "http://dan%40kogai:kogai%2Fdan\@127.0.0.1:$proxy_port"); my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://127.0.0.1:$httpd_port/escape", headers => [ "X-Foo" => "qqq" ] ); is $code, 200, "request()"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 10; is Furl::HTTP::_header_get($headers, 'Via'), "1.0 $via"; is $content, 'Hello, foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } }, server => sub { # http server my $httpd_port = shift; Plack::Loader->auto(port => $httpd_port)->run(sub { my $env = shift; my $req = Plack::Request->new($env); is $req->header('X-Foo'), "ppp" if $env->{REQUEST_URI} eq '/foo'; is $req->header('X-Foo'), "qqq" if $env->{REQUEST_URI} eq '/escape'; like $req->header('User-Agent'), qr/\A Furl::HTTP /xms; my $content = "Hello, foo"; return [ 200, [ 'Content-Length' => length($content) ], [ $content ] ]; }); }, ); }, server => sub { # proxy server my $proxy_port = shift; my $proxy = Test::HTTP::Proxy->new(port => $proxy_port, via => $via); my $token_simple = "Basic " . encode_base64( "dankogai:kogaidan", "" ); my $token_escape = "Basic " . encode_base64( 'dan@kogai:kogai/dan', "" ); $proxy->push_filter( request => HTTP::Proxy::HeaderFilter::simple->new( sub { my ( $self, $headers, $request ) = @_; my $auth = $self->proxy->hop_headers->header('Proxy-Authorization') || ''; my $request_uri = $request->uri->as_string; my $token = $request_uri =~ m{/escape$} ? $token_escape : $token_simple; # check the credentials if ( $auth ne $token ) { my $response = HTTP::Response->new(407); $response->header( Proxy_Authenticate => 'Basic realm= +"HTTP::Proxy"' ); $self->proxy->response($response); } } ) ); $proxy->start(); }, ); 33_basic_auth.t100664001751001751 364013160135067 20107 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::TCP; use Test::More; use Test::Requires 'URI::Escape'; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); for (1 .. $n) { my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://dankogai:kogaidan\@127.0.0.1:${port}/foo", ); is $code, 200, "request()/$_"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 4, 'header' or diag(explain($headers)); is $content, '/foo' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } for ($n + 1 .. $n + $n) { my ( undef, $code, $msg, $headers, $content ) = $furl->request( url => "http://dan%40kogai:kogai%2Fdan\@127.0.0.1:${port}/escape", ); is $code, 200, "request()/$_"; is $msg, "OK"; is Furl::HTTP::_header_get($headers, 'Content-Length'), 7, 'header' or diag(explain($headers)); is $content, '/escape' or do{ require Devel::Peek; Devel::Peek::Dump($content) }; } done_testing; }, server => sub { my $port = shift; my $basic = 'ZGFua29nYWk6a29nYWlkYW4='; t::HTTPServer->new(port => $port)->run(sub {; my $env = shift; if ($env->{REQUEST_URI} eq '/escape') { $basic = 'ZGFuQGtvZ2FpOmtvZ2FpL2Rhbg=='; } is($env->{HTTP_AUTHORIZATION}, 'Basic ' . $basic); return [ 200, [ 'Content-Length' => length($env->{REQUEST_URI}) ], [$env->{REQUEST_URI}] ]; }); } ); 34_keep_request.t100664001751001751 240113160135067 20474 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Furl::Request; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; test_tcp( client => sub { my $port = shift; subtest 'return request info' => sub { my $furl = Furl::HTTP->new(capture_request => 1); my @res = $furl->request( url => "http://127.0.0.1:$port/1", ); my ( $res_minor_version, $res_status, $res_msg, $res_headers, $res_content, $captured_req_headers, $captured_req_content, $captured_res_headers, $captured_res_content, $request_info, ) = @res; my $req = Furl::Request->parse($captured_req_headers . $captured_req_content); is $req->method, 'GET'; is $req->uri, "http://127.0.0.1:$port/1"; }; }, server => sub { my $port = shift; t::HTTPServer->new(port => $port)->run(sub { my $env = shift; return [ 200, [ 'Content-Length' => length('keep request') ], [ 'keep request' ] ]; }); } ); done_testing; 35_get_address.t100664001751001751 167313160135067 20277 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Socket qw(inet_aton pack_sockaddr_in); use Test::More; use Test::TCP; use Furl::HTTP; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; test_tcp( client => sub { my $serverPort = shift; my $furl = Furl::HTTP->new( get_address => sub { my ($host, $port, $timeout) = @_; is $host, "nowhere.example.com", "get_address:hostname"; is $port, 80, "get_address:port"; return pack_sockaddr_in($serverPort, inet_aton("127.0.0.1")); }, ); my ($minor_version, $code, $msg, $headers, $body) = $furl->request( method => "GET", host => "nowhere.example.com", port => 80, path_query => "/abc", ); is $code, 200, "status code"; is $body, "hello furl", "content"; }, server => sub { my $port = shift; ok "yes"; t::HTTPServer->new(port => $port)->run(sub { my $env = shift; return [ 200, [], [ "hello furl" ] ]; }); } ); done_testing; 36_inactivity_timeout.t100664001751001751 247513160135067 21746 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Socket qw(inet_aton pack_sockaddr_in); use Test::More; use Test::TCP; use Test::Requires qw(HTTP::Server::PSGI); use Furl::HTTP; use FindBin; use lib "$FindBin::Bin/../.."; use t::Slowloris; test_tcp( server => sub { my $port = shift; $Slowloris::SleepBeforeWrite = 1; Slowloris::Server->new(port => $port)->run(sub { my $env = shift; return [ 200, [], [ "hello" ] ]; }); }, client => sub { my $port = shift; # should not timeout my $furl = Furl::HTTP->new( timeout => 10, inactivity_timeout => 10, ); my $start = time; my ($minor_version, $code, $msg, $headers, $body) = $furl->request( method => "GET", host => "127.0.0.1", port => $port, path_query => "/", ); is $code, 200, "status code:inactivity_timeout=10"; is $body, "hello", "content:inactivity_timeout=10"; diag "took @{[time - $start]} seconds"; # should timeout $furl = Furl::HTTP->new( timeout => 10, inactivity_timeout => 0.5, ); $start = time; ($minor_version, $code, $msg, $headers, $body) = $furl->request( method => "GET", host => "127.0.0.1", port => $port, path_query => "/", ); is $code, 500, "status code:inactivity_timeout=0.5"; diag "took @{[time - $start]} seconds"; }, ); done_testing; 37_bad_content_length.t100664001751001751 266013160135067 21633 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use utf8; use Furl::HTTP; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; # Scenario: The server returns bad content-length. # RFC 2616 says Content-Length header's format is: # # Content-Length = "Content-Length" ":" 1*DIGIT # # But some server returns invalid format. # It makes mysterious error message by Perl interpreter. # # Then, Furl validates content-length header before processing. # # ref. https://www.ietf.org/rfc/rfc2616.txt my $n = shift(@ARGV) || 3; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/foo', host => '127.0.0.1', headers => [ "X-Foo" => "ppp" ] ); is $code, 500, "request()/$_"; like $msg, qr/Internal Response/; like $content, qr/Bad Content-Length: 5963,5963/ or do{ require Devel::Peek; Devel::Peek::Dump($content) }; done_testing; }, server => sub { my $port = shift; t::HTTPServer->new(port => $port)->run(sub {; my $env = shift; return [ 200, [ 'Content-Length' => '5963,5963' ], [$env->{REQUEST_URI}] ]; }); } ); 38_continue.t100664001751001751 272213160135067 17636 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use utf8; use Furl::HTTP; use Test::TCP; use Test::More; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; test_tcp( client => sub { my $port = shift; my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3); my ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/100', host => '127.0.0.1', headers => [] ); is $code, 200; is $msg, 'OK'; is $content, 'OK'; ( undef, $code, $msg, $headers, $content ) = $furl->request( port => $port, path_query => '/101', host => '127.0.0.1', headers => [] ); is $code, 200; is $msg, 'OK'; is $content, 'OK'; done_testing; }, server => sub { my $port = shift; my $server = t::HTTPServer->new(port => $port); $server->add_trigger(BEFORE_CALL_APP => sub { my ($self, $csock, $env) = @_; my $code = $env->{PATH_INFO} || '100'; $code =~ s!/!!g; my $status = $t::HTTPServer::STATUS_CODE{$code}; $self->write_all($csock, "HTTP/1.1 $code $status\015\012\015\012"); }); $server->run(sub { my $env = shift; return [ 200, [], ['OK'] ]; }); } ); 39_httpoxy.t100664001751001751 273013160135067 17531 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/100_lowuse strict; use warnings; use Furl::HTTP; use Test::More; plan tests => 8; sub test_proxy { my $expect = shift; my $client = Furl::HTTP->new->env_proxy; $client->{proxy}; } undef $ENV{REQUEST_METHOD}; undef $ENV{HTTP_PROXY}; undef $ENV{http_proxy}; is test_proxy, ''; $ENV{REQUEST_METHOD} = 'GET'; undef $ENV{HTTP_PROXY}; undef $ENV{http_proxy}; is test_proxy, ''; SKIP: { skip 'skip Windows', 1 if $^O eq 'MSWin32'; undef $ENV{REQUEST_METHOD}; $ENV{HTTP_PROXY} = 'http://proxy1.example.com'; undef $ENV{http_proxy}; is test_proxy, 'http://proxy1.example.com'; } $ENV{REQUEST_METHOD} = 'GET'; $ENV{HTTP_PROXY} = 'http://proxy1.example.com'; undef $ENV{http_proxy}; is test_proxy, ''; undef $ENV{REQUEST_METHOD}; undef $ENV{HTTP_PROXY}; $ENV{http_proxy} = 'http://proxy2.example.com'; is test_proxy, 'http://proxy2.example.com'; SKIP: { skip 'skip Windows', 1 if $^O eq 'MSWin32'; $ENV{REQUEST_METHOD} = 'GET'; undef $ENV{HTTP_PROXY}; $ENV{http_proxy} = 'http://proxy2.example.com'; is test_proxy, 'http://proxy2.example.com'; } undef $ENV{REQUEST_METHOD}; $ENV{HTTP_PROXY} = 'http://proxy1.example.com'; $ENV{http_proxy} = 'http://proxy2.example.com'; is test_proxy, 'http://proxy2.example.com'; SKIP: { skip 'skip Windows', 1 if $^O eq 'MSWin32'; $ENV{REQUEST_METHOD} = 'GET'; $ENV{HTTP_PROXY} = 'http://proxy1.example.com'; $ENV{http_proxy} = 'http://proxy2.example.com'; is test_proxy, 'http://proxy2.example.com'; } 01_simple.t100664001751001751 560113160135067 17410 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/300_highuse strict; use warnings; use Furl; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; use File::Temp; use Fcntl qw/:seek/; my @data = ( ['get', [], sub { }], ['get', [['X-Foo' => 'bar']], sub { is $_->header('X-Foo'), 'bar'; }], ['head', [], sub { }], ['head', [['X-Foo' => 'bar']], sub { is $_->header('X-Foo'), 'bar'; }], ['post', [[], 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya' }], ['post', [undef, 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya' }], ['post', [[], ['do' => 'ya']], sub { is $_->content_length, 5; is $_->content, 'do=ya' }], ['post', [[], {'do' => 'ya'}], sub { is $_->content_length, 5; is $_->content, 'do=ya' }], ['post', [[], ['do' => 'ya', '=foo=' => 'bar baz']], sub { my $c = 'do=ya&%3Dfoo%3D=bar%20baz'; is $_->content_length, length($c); is $_->content, $c; }, ], ['put', [[], 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya' }], ['put', [undef, 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya' }], ['put', [[], ['do' => 'ya']], sub { is $_->content_length, 5; is $_->content, 'do=ya' }], ['put', [[], {'do' => 'ya'}], sub { is $_->content_length, 5; is $_->content, 'do=ya' }], ['put', [[], ['do' => 'ya', '=foo=' => 'bar baz']], sub { my $c = 'do=ya&%3Dfoo%3D=bar%20baz'; is $_->content_length, length($c); is $_->content, $c; }, ], ['delete', [], sub { }], ['delete', [['X-Foo' => 'bar']], sub { is $_->header('X-Foo'), 'bar'; }], ['delete', [undef, 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya'; }], ); test_tcp( client => sub { my $port = shift; my $furl = Furl->new(); my $url = "http://127.0.0.1:$port"; my @d = @data; while (my $row = shift @d) { my ($method, $args) = @$row; note "-- $method"; my $res = $furl->$method($url, @$args); is $res->status, 200, "client: status by $method()" or die "BAD: " . join(', ', $res->status, $res->message, $res->content); } done_testing; }, server => sub { my $port = shift; my @d = @data; Plack::Loader->auto( port => $port )->run(sub { while (my $row = shift @d) { my $env = shift; my $row = shift @data; my ($method, $args, $code) = @$row; local $_ = Plack::Request->new($env); is uc($_->method), uc($method), 'server: method'; $code->(); return [ 200, [ 'Content-Length' => 2 ], ['OK'] ]; } }); } ); 02_agent.t100664001751001751 43513160135067 17176 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/300_highuse strict; use warnings; use Test::More; use Furl; subtest 'agent' => sub { my $furl = Furl->new( agent => 'Furl/test' ); is $furl->agent, "Furl/test", 'get User-Agent'; $furl->agent('Furl/new'); is $furl->agent, "Furl/new", 'set new User-Agent'; }; done_testing; 04_http_request.t100664001751001751 224513160135067 20652 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/300_highuse strict; use warnings; use Furl; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Plack::Request; use Test::Requires qw(Plack::Request HTTP::Body), 'HTTP::Request'; test_tcp( client => sub { my $port = shift; my $furl = Furl->new(); my $req = HTTP::Request->new(POST => "http://127.0.0.1:$port/foo", ['X-Foo' => 'ppp', 'Content-Length' => 3], 'yay'); my $res = $furl->request( $req ); is $res->code, 200, "request()"; done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; #note explain $env; my $req = Plack::Request->new($env); is $req->header('X-Foo'), "ppp"; is $req->header('Host'), "127.0.0.1:$port"; is $req->path_info, "/foo"; is $req->content, "yay"; is $req->content_length, 3; is $req->method, "POST"; return [ 200, [ 'Content-Length' => length($req->content) ], [$req->content] ]; }); } ); 05_suppress_dup_host_header.t100664001751001751 243113160135067 23222 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/300_highuse strict; use warnings; use Furl; use Test::TCP; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), 'HTTP::Request'; use FindBin; use lib "$FindBin::Bin/../.."; use t::HTTPServer; test_tcp( client => sub { my $port = shift; my $furl = Furl->new(); my $req = HTTP::Request->new(GET => "http://127.0.0.1:$port/foo"); $req->headers->header('Host' => '127.0.0.1'); my $res = $furl->request( $req ); is $res->code, 200, "HTTP status ok"; }, server => sub { my $port = shift; my $request; { no warnings 'redefine'; my $org = t::HTTPServer->can('parse_http_request'); *t::HTTPServer::parse_http_request = sub { $request .= $_[0]; $org->(@_); }; } t::HTTPServer->new(port => $port)->run(sub { my $env = shift; my $hash; for my $line (split /\n/, $request) { my ($k) = (split ':', $line)[0]; $hash->{$k}++; } is $hash->{Host}, 1, 'Host header is one'; is $env->{HTTP_HOST}, "127.0.0.1:$port", 'Host header is ok'; return [200, ['Content-Length' => 2], ['ok']]; }); }, ); done_testing; 06_keep_request.t100664001751001751 1516513160135067 20646 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/300_highuse strict; use warnings; use Furl; use Test::TCP; use Test::Requires qw(Plack::Request HTTP::Body), 'Plack'; use Plack::Loader; use Test::More; use Data::Dumper; use Plack::Request; use Test::Requires qw(Plack::Request HTTP::Body), 'HTTP::Request'; test_tcp( client => sub { my $port = shift; my $furl = Furl->new(capture_request => 1); # request(GET) { my $res = $furl->request(url => "http://127.0.0.1:$port/foo", method => "GET"); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'GET'; } # request(POST) { my $res = $furl->request(url => "http://127.0.0.1:$port/foo", method => "POST", content => 'GAH'); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'POST'; is $req->content => 'GAH'; } # ->get { my $res = $furl->get("http://127.0.0.1:$port/foo"); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'GET'; is $req->content => ''; } # ->get with headers { my $res = $furl->get("http://127.0.0.1:$port/foo", [ 'X-Furl-Requst' => 1, ]); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'GET'; is $req->content => ''; is($req->headers->header('X-Furl-Requst'), 1) or diag Dumper($req->headers); is($req->header('X-Furl-Requst'), 1) or diag Dumper($req->headers); is join(',', $req->headers->keys), 'x-furl-requst'; } # ->head { my $res = $furl->head("http://127.0.0.1:$port/foo"); is $res->code, 200, "request()"; is $res->body, ''; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'HEAD'; is $req->content => ''; } # ->head with headers { my $res = $furl->head("http://127.0.0.1:$port/foo", [ 'X-Furl-Requst' => 1, ]); is $res->code, 200, "request()"; is $res->body, ''; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'HEAD'; is $req->content => ''; is $req->header('X-Furl-Requst'), 1; } # ->post { my $res = $furl->post("http://127.0.0.1:$port/foo", [], 'GAH'); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'POST'; is $req->content => 'GAH'; } # ->post with headers { my $res = $furl->post("http://127.0.0.1:$port/foo", [ 'X-Furl-Requst' => 1, ], 'GAH'); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'POST'; is $req->content => 'GAH'; is $req->header('X-Furl-Requst'), 1; } # ->put { my $res = $furl->put("http://127.0.0.1:$port/foo", [], 'GAH'); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'PUT'; is $req->content => 'GAH'; } # ->put with headers { my $res = $furl->put("http://127.0.0.1:$port/foo", [ 'X-Furl-Requst' => 1, ], 'GAH'); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'PUT'; is $req->content => 'GAH'; is $req->header('X-Furl-Requst'), 1; } # ->delete { my $res = $furl->delete("http://127.0.0.1:$port/foo"); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'DELETE'; is $req->content => ''; } # ->delete with headers { my $res = $furl->delete("http://127.0.0.1:$port/foo", [ 'X-Furl-Requst' => 1, ]); is $res->code, 200, "request()"; is $res->body, 'OK'; can_ok $res => 'request'; my $req = $res->request; isa_ok $req => 'Furl::Request'; is $req->uri => "http://127.0.0.1:$port/foo"; is $req->method => 'DELETE'; is $req->content => ''; is $req->header('X-Furl-Requst'), 1; } done_testing; }, server => sub { my $port = shift; Plack::Loader->auto(port => $port)->run(sub { my $env = shift; my $req = Plack::Request->new($env); return [ 200, [ 'Content-Length' => 2 ], [ 'OK' ] ]; }); } ); 07_cookie.t100664001751001751 1272013160135067 17416 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/300_highuse strict; use warnings; use utf8; use Test::More; use Test::Requires 'HTTP::CookieJar', 'Plack::Request', 'Plack::Loader', 'Plack::Builder', 'Plack::Response'; use Test::TCP; use Furl; subtest 'Simple case', sub { test_tcp( client => sub { my $port = shift; my $furl = Furl->new( cookie_jar => HTTP::CookieJar->new() ); my $url = "http://127.0.0.1:$port"; subtest 'first time access', sub { my $res = $furl->get("${url}/"); note "Then, response should be 200 OK"; is $res->status, 200; note "And, content should be 'OK 1'"; is $res->content, 'OK 1'; }; subtest 'Second time access', sub { my $res = $furl->get("${url}/"); note "Then, response should be 200 OK"; is $res->status, 200; note "And, content should be 'OK 2'"; is $res->content, 'OK 2'; }; }, server => \&session_server, ); }; subtest '->request(host => ...) style simple interface', sub { test_tcp( client => sub { my $port = shift; my $furl = Furl->new( cookie_jar => HTTP::CookieJar->new() ); subtest 'first time access', sub { my $res = $furl->request( method => 'GET', scheme => 'http', host => '127.0.0.1', port => $port, ); note "Then, response should be 200 OK"; is $res->status, 200; note "And, content should be 'OK 1'"; is $res->content, 'OK 1'; }; subtest 'Second time access', sub { my $res = $furl->request( method => 'GET', scheme => 'http', host => '127.0.0.1', port => $port, ); note "Then, response should be 200 OK"; is $res->status, 200; note "And, content should be 'OK 2'"; is $res->content, 'OK 2'; }; }, server => \&session_server, ); }; subtest 'With redirect', sub { test_tcp( client => sub { my $port = shift; my $furl = Furl->new( cookie_jar => HTTP::CookieJar->new() ); my $url = "http://127.0.0.1:$port"; subtest 'first time access', sub { my $res = $furl->get("${url}/login"); note "Then, response should be 200 OK"; is $res->status, 200; note "And, content should be 'ok'"; is $res->content, 'ok'; }; subtest 'Second time access', sub { my $res = $furl->get("${url}/user_name"); note "Then, response should be 200 OK"; is $res->status, 200; note "And, content should be 'Nick'"; is $res->content, 'Nick'; }; }, server => sub { my $port = shift; my %SESSION_STORE; Plack::Loader->auto( port => $port )->run(builder { enable 'ContentLength'; enable 'StackTrace'; sub { my $env = shift; my $req = Plack::Request->new($env); my $path_info = $env->{PATH_INFO}; $path_info =~ s!^//!/!; if ($path_info eq '/login') { my $res = Plack::Response->new( 302, ['Location' => $req->uri_for('/login_done')], [] ); $res->cookies->{'user_name'} = 'Nick'; return $res->finalize; } elsif ($path_info eq '/login_done') { my $res = Plack::Response->new( 200, [], ['ok'] ); return $res->finalize; } elsif ($path_info eq '/user_name') { my $res = Plack::Response->new( 200, [], [$req->cookies->{'user_name'}] ); return $res->finalize; } else { my $res = Plack::Response->new( 404, [], ['not found:' . $env->{PATH_INFO}] ); return $res->finalize; } }; }); } ); }; done_testing; sub session_server { my $port = shift; my %SESSION_STORE; Plack::Loader->auto( port => $port )->run(builder { enable 'ContentLength'; sub { my $env = shift; my $req = Plack::Request->new($env); my $session_key = $req->cookies->{session_key} || rand(); my $cnt = ++$SESSION_STORE{$session_key}; note "CNT: $cnt"; my $res = Plack::Response->new( 200, [], ["OK ${cnt}"] ); $res->cookies->{'session_key'} = $session_key; return $res->finalize; }; }); } sub Plack::Request::uri_for { my($self, $path, $args) = @_; my $uri = $self->base; $uri->path($uri->path . $path); $uri->query_form(@$args) if $args; $uri; } 99_error.t100664001751001751 125013160135067 17265 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/300_highuse strict; use warnings; use Furl; use Test::More; use File::Basename qw/basename/; my $furl = Furl->new; my $file_name = basename $0; sub test_error_message (&) { my $code = shift; local $@; eval { $code->() }; like $@, qr/$file_name/; } test_error_message { $furl->get('ttp://example.com/') }; test_error_message { $furl->head('ttp://example.com/') }; test_error_message { $furl->post('ttp://example.com/') }; test_error_message { $furl->delete('ttp://example.com/') }; test_error_message { $furl->put('ttp://example.com/') }; test_error_message { $furl->request( method => 'GET', url => 'ttp://example.com/', ); }; done_testing; 01-file.t100664001751001751 325613160135067 23706 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_components/001_response-coding#!perl use strict; use warnings; use Furl; use File::Spec; use Encode; use Cwd; use Test::Requires 'Test::Fake::HTTPD', 'URI'; use URI; use Test::More tests => 13; use Test::TCP; use Test::Fake::HTTPD; my $ua = Furl->new; my $cwd = getcwd; #BEGIN{ # package LWP::Protocol; # $^W = 0; #} my $httpd = run_http_server { my $req = shift; my $path = 't/400_components/001_response-coding' . $req->uri->path; open my $fh, '<', $path or die "$path: $!"; return [ 200, [ 'Content-Type' => 'text/html' ], $fh ]; }; note $httpd->host_port; for my $meth (qw/charset encoder encoding decoded_content/){ can_ok('Furl::Response', $meth); } my %charset = qw( UTF-8 utf-8-strict; EUC-JP EUC-JP Shift_JIS SHIFT_JIS ISO-2022-JP ISO-2022-JP ); my %filename = qw( UTF-8 t-utf-8.html EUC-JP t-euc-jp.html Shift_JIS t-shiftjis.html ISO-2022-JP t-iso-2022-jp.html ); for my $charset (sort keys %charset){ my $uri = URI->new('http://' . $httpd->host_port); $uri->path(File::Spec->catfile($filename{$charset})); my $res; { local $^W = 0; # to quiet LWP::Protocol $res = $ua->get($uri); } die unless $res->is_success; is $res->charset, $charset, "\$res->charset eq '$charset'"; my $canon = find_encoding($charset)->name; is $res->encoding, $canon, "\$res->encoding eq '$canon'"; } my $uri = URI->new('http://' . $httpd->host_port); $uri->path("t-null.html"); my $res = $ua->get($uri); die unless $res->is_success; if (defined $res->encoding){ is $res->encoding, "ascii", "res->encoding is ascii"; }else{ ok !$res->encoding, "res->encoding is undef"; } t-euc-jp.html100664001751001751 51313160135067 24647 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_components/001_response-coding Test

ʡҤ餬ʤähtml.

t-iso-2022-jp.html100664001751001751 52613160135067 25254 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_components/001_response-coding Test

$B4A;z!"%+%?%+%J!"$R$i$,$J$NF~$C$?(Bhtml.

t-null.html100664001751001751 42213160135067 24435 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_components/001_response-coding Test

The quick brown fox jumps over the black lazy dog.

t-shiftjis.html100664001751001751 51613160135067 25312 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_components/001_response-coding Test

AJ^JiAЂ炪Ȃ̓html.

t-utf-8.html100664001751001751 53213160135067 24430 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_components/001_response-coding Test

漢字、カタカナ、ひらがなの入ったhtml.

01_headers.t100664001751001751 472013160135067 21002 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_componentsuse strict; use warnings; use Test::More; use Furl::Headers; use Test::Requires qw(Plack::Request HTTP::Body), 'HTTP::Headers'; use HTTP::Headers; subtest 'total test' => sub { my $h = Furl::Headers->new([ 'x-foo' => 1, 'x-bar' => 2, 'x-foo' => 3, ]); is_deeply( +{%$h}, +{ 'x-foo' => [qw/1 3/], 'x-bar' => [2] }, 'make from arrayref' ); is( $h->header('X-Foo'), "1, 3" ); is_deeply( [$h->header('X-Foo')], [qw/1 3/] ); is( $h->header('X-Bar'), 2 ); is( $h->header('X-Bar'), 2 ); is_deeply( [$h->header('X-Foo')], [qw/1 3/] ); $h->header('X-Poo', 'san'); is( $h->header('X-Poo'), 'san' ); $h->header('X-Poo', ['san', 'winnie']); is( $h->header('X-Poo'), 'san, winnie' ); is_deeply( [$h->header('X-Poo')], ['san', 'winnie'] ); is(join(',', sort $h->keys), 'x-bar,x-foo,x-poo'); $h->remove_header('x-foo'); is(join(',', sort $h->keys), 'x-bar,x-poo'); is(join(',', sort $h->header_field_names), 'x-bar,x-poo', 'header_field_names'); is_deeply([sort split /\015\012/, $h->as_string], [sort split /\015\012/, "x-bar: 2\015\012x-poo: san\015\012x-poo: winnie\015\012"], 'as_string'); is(join(',', sort $h->flatten), '2,san,winnie,x-bar,x-poo,x-poo'); my $hh = $h->as_http_headers; is $hh->header('x-bar'), '2'; is $hh->header('x-poo'), 'san, winnie'; }; subtest 'from hashref' => sub { my $h = Furl::Headers->new({ 'x-foo' => [1, 3], 'x-bar' => [2], }); is( $h->header('X-Foo'), '1, 3', 'make from hashref' ); is_deeply( [$h->header('X-Foo')], [qw/1 3/] ); is( $h->header('X-Bar'), 2 ); is_deeply( [$h->header('X-Bar')], [2] ); }; subtest 'shorthand' => sub { my $h = Furl::Headers->new( [ 'expires' => '1111', 'last-modified' => '2222', 'if-modified-since' => '3333', 'content-type' => 'text/html', 'content-length' => '4444', ] ); is $h->expires, '1111'; is $h->last_modified, '2222'; is $h->if_modified_since, '3333'; is $h->content_type, 'text/html'; is $h->content_length, 4444; }; subtest 'clone' => sub { my $h1 = Furl::Headers->new([ expires => 1111, ]); my $h2 = $h1->clone(); is $h2->expires, '1111'; $h2->last_modified('2222'); is $h2->last_modified, '2222'; isnt $h1->last_modified, '2222'; }; # TODO make from hashref done_testing; 02_response.t100664001751001751 553713160135067 21235 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_componentsuse strict; use warnings; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), 'HTTP::Response'; use Furl::Response; my $res = Furl::Response->new( 1, 200, 'OK', +{ 'x-foo' => ['yay'], 'x-bar' => ['hoge'], 'content-length' => [9], 'content-type' => ['text/html'], 'content-encoding' => ['chunked'], }, 'hit man' ); is $res->protocol, 'HTTP/1.1'; is $res->code, 200; is $res->message, 'OK'; isa_ok $res->headers, 'Furl::Headers'; is $res->content, 'hit man'; is($res->headers->header('X-Foo'), 'yay'); ok $res->is_success; is $res->status_line, '200 OK'; is $res->content_length, 9; is $res->content_type, 'text/html'; is $res->content_encoding, 'chunked'; my $hres = $res->as_http_response; isa_ok $hres, 'HTTP::Response'; is $hres->code, 200; is $hres->message, 'OK'; isa_ok $hres->headers, 'HTTP::Headers'; is $hres->content_type, 'text/html'; is $hres->content, 'hit man'; is $hres->protocol, 'HTTP/1.1'; subtest 'as_hashref' => sub { my $dat = $res->as_hashref; my $headers = delete $dat->{headers}; is_deeply( $dat, { message => 'OK', code => 200, content => 'hit man', protocol => 'HTTP/1.1', } ); is_deeply( [sort @{$headers}], [sort qw( content-type text/html x-foo yay x-bar hoge content-length 9 content-encoding chunked )] ); }; subtest 'to_psgi' => sub { my $dat = $res->to_psgi; is(0+@$dat, 3); is($dat->[0], 200); is_deeply( [sort @{$dat->[1]}], [sort qw( content-type text/html x-foo yay x-bar hoge content-length 9 content-encoding chunked )] ); is_deeply($dat->[2], ['hit man']); }; subtest decoded_content => sub { my $res = Furl::Response->new( 1, 200, 'OK', +{ 'content-type' => ['text/plain; charset=UTF-8'], }, "\343\201\202\343\201\204\343\201\206\343\201\210\343\201\212", ); is $res->decoded_content, "\x{3042}\x{3044}\x{3046}\x{3048}\x{304a}"; }; subtest 'as_string' => sub { my $res = Furl::Response->new( 1, 200, 'OK', +{ 'x-foo' => ['yay'], 'x-bar' => ['hoge'], 'content-length' => [9], 'content-type' => ['text/html'], 'content-encoding' => ['chunked'], }, 'hit man' ); my $expected = join("\015\012", '200 OK', 'content-encoding: chunked', 'content-length: 9', 'content-type: text/html', 'x-bar: hoge', 'x-foo: yay', '', 'hit man', ); is($res->as_string, $expected); is(length($res->as_string), length($expected)); }; done_testing; 03_request.t100664001751001751 1051213160135067 21075 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/400_componentsuse strict; use warnings; use Test::More; use Test::Requires 'HTTP::Request'; use Furl::Request; subtest 'normally' => sub { my $req = Furl::Request->new( 'POST', 'http://example.com/foo?q=bar', +{ 'x-foo' => ['yay'], 'x-bar' => ['hoge'], 'content-length' => [7], 'content-type' => ['text/plain'], }, 'hit man' ); $req->protocol('HTTP/1.0'); is $req->method, 'POST'; is $req->uri, 'http://example.com/foo?q=bar'; isa_ok $req->headers, 'Furl::Headers'; is($req->header('X-Foo'), 'yay'); is $req->content, 'hit man'; is $req->protocol, 'HTTP/1.0'; is $req->request_line, 'POST /foo?q=bar HTTP/1.0'; is $req->content_length, 7; is $req->content_type, 'text/plain'; my $hreq = $req->as_http_request; isa_ok $hreq, 'HTTP::Request'; is $hreq->method, 'POST'; is $hreq->uri, 'http://example.com/foo?q=bar'; isa_ok $hreq->headers, 'HTTP::Headers'; is $hreq->content_type, 'text/plain'; is $hreq->content, 'hit man'; is $hreq->protocol, 'HTTP/1.0'; }; subtest 'parse' => sub { my $body = <<__REQ__; POST /foo?q=bar HTTP/1.1 Host: example.com X-Foo: yay X-Bar: hoge Content-Length: 7 Content-Type: text/plain hit man __REQ__ chomp $body; my $req = Furl::Request->parse($body); is $req->method, 'POST'; is $req->uri, 'http://example.com/foo?q=bar'; isa_ok $req->headers, 'Furl::Headers'; is($req->headers->header('X-Foo'), 'yay'); is $req->content, 'hit man'; is $req->protocol, 'HTTP/1.1'; is $req->request_line, 'POST /foo?q=bar HTTP/1.1'; is $req->content_length, 7; is $req->content_type, 'text/plain'; my $hreq = $req->as_http_request; isa_ok $hreq, 'HTTP::Request'; is $hreq->method, 'POST'; is $hreq->uri, 'http://example.com/foo?q=bar'; isa_ok $hreq->headers, 'HTTP::Headers'; is $hreq->content_type, 'text/plain'; is $hreq->content, 'hit man'; is $hreq->protocol, 'HTTP/1.1'; }; subtest 'as_hashref' => sub { my $req = Furl::Request->new( 'POST', 'http://example.com/foo?q=bar', +{ 'x-foo' => ['yay'], 'x-bar' => ['hoge'], 'content-length' => [7], 'content-type' => ['text/plain'], }, 'hit man' ); $req->protocol('HTTP/1.1'); my $dat = $req->as_hashref; my $headers = delete $dat->{headers}; is_deeply( $dat, { method => 'POST', uri => 'http://example.com/foo?q=bar', content => 'hit man', protocol => 'HTTP/1.1', } ); is_deeply( [sort @{$headers}], [sort qw( content-type text/plain content-length 7 x-foo yay x-bar hoge )] ); }; subtest 'as_string' => sub { subtest 'simple' => sub { my $req = Furl::Request->new( 'POST', 'http://example.com/foo?q=bar', +{ 'x-foo' => ['yay'], 'x-bar' => ['hoge'], 'content-length' => [7], 'content-type' => ['text/plain'], }, 'hit man' ); $req->protocol('HTTP/1.1'); my $expected = join("\015\012", 'POST http://example.com/foo?q=bar HTTP/1.1', 'content-length: 7', 'content-type: text/plain', 'x-bar: hoge', 'x-foo: yay', '', 'hit man', ); is($req->as_string, $expected); }; subtest 'Furl#post' => sub { my $req = Furl::Request->new( 'POST', 'http://example.com/foo?q=bar', +{ 'x-foo' => ['yay'], 'x-bar' => ['hoge'], 'content-length' => [7], 'content-type' => ['text/plain'], }, [X => 'Y'], ); # no protocol my $expected = join("\015\012", 'POST http://example.com/foo?q=bar', 'content-length: 7', 'content-type: text/plain', 'x-bar: hoge', 'x-foo: yay', '', 'X=Y', ); is($req->as_string, $expected); }; }; done_testing; 01_capture_request.t100664001751001751 40413160135067 22554 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/800_regression#!perl -Ilib use strict; use warnings; use utf8; use Test::More; use Furl; my $f=Furl->new(capture_request=>1, timeout=>5); my $r=$f->post("http://example.com.local"); is($r->captured_req_headers, undef); is($r->captured_req_content, undef); done_testing; parse_url.t100664001751001751 504213160135067 20537 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/t/999_intrenaluse strict; use warnings; use Furl::HTTP; use Test::More; sub test_parse_url { my ($uri, $expects, $desc) = @_; local $@; my @parsed = eval { Furl::HTTP->_parse_url($uri) }; unless ($@) { is_deeply \@parsed, $expects, $desc; } else { like $@, $expects; } } test_parse_url( 'http://example.com/', [ 'http', undef, undef, 'example.com', undef, '/', ], 'root', ); test_parse_url( 'http://example.com', [ 'http', undef, undef, 'example.com', undef, undef, ], 'root (omit /)', ); test_parse_url( 'http://example.com/?foo=bar', [ 'http', undef, undef, 'example.com', undef, '/?foo=bar', ], 'root with query string' ); test_parse_url( 'http://example.com?foo=bar', [ 'http', undef, undef, 'example.com', undef, '?foo=bar', ], 'root with query string (omit /)' ); test_parse_url( 'http://example.com:5000/', [ 'http', undef, undef, 'example.com', 5000, '/', ], 'with port', ); test_parse_url( 'http://example.com:5000', [ 'http', undef, undef, 'example.com', 5000, undef, ], 'with port (omit /)', ); test_parse_url( 'http://example.com:5000/?foo=bar', [ 'http', undef, undef, 'example.com', 5000, '/?foo=bar', ], 'with port and query string', ); test_parse_url( 'http://example.com:5000?foo=bar', [ 'http', undef, undef, 'example.com', 5000, '?foo=bar', ], 'with port (omit /)', ); test_parse_url( 'http://example.com:5000/hoge/fuga?foo=bar', [ 'http', undef, undef, 'example.com', 5000, '/hoge/fuga?foo=bar', ], 'popular url', ); test_parse_url( 'http://user:pass@example.com/', [ 'http', 'user', 'pass', 'example.com', undef, '/', ], 'auth url without port number', ); test_parse_url( 'http://user:pass@example.com:5000/hoge/fuga?foo=bar', [ 'http', 'user', 'pass', 'example.com', 5000, '/hoge/fuga?foo=bar', ], 'auth & popular url', ); test_parse_url( 'http://example.com:5000foobar', qr/Passed malformed URL:/, ); done_testing; HTTPServer.pm100664001751001751 2515113160135067 16457 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/tpackage t::HTTPServer; use strict; use warnings; use IO::Socket::INET; use Socket qw(IPPROTO_TCP TCP_NODELAY); use Carp (); # taken from HTTP::Status our %STATUS_CODE = ( 100 => 'Continue', 101 => 'Switching Protocols', 102 => 'Processing', # RFC 2518 (WebDAV) 200 => 'OK', 201 => 'Created', 202 => 'Accepted', 203 => 'Non-Authoritative Information', 204 => 'No Content', 205 => 'Reset Content', 206 => 'Partial Content', 207 => 'Multi-Status', # RFC 2518 (WebDAV) 300 => 'Multiple Choices', 301 => 'Moved Permanently', 302 => 'Found', 303 => 'See Other', 304 => 'Not Modified', 305 => 'Use Proxy', 307 => 'Temporary Redirect', 400 => 'Bad Request', 401 => 'Unauthorized', 402 => 'Payment Required', 403 => 'Forbidden', 404 => 'Not Found', 405 => 'Method Not Allowed', 406 => 'Not Acceptable', 407 => 'Proxy Authentication Required', 408 => 'Request Timeout', 409 => 'Conflict', 410 => 'Gone', 411 => 'Length Required', 412 => 'Precondition Failed', 413 => 'Request Entity Too Large', 414 => 'Request-URI Too Large', 415 => 'Unsupported Media Type', 416 => 'Request Range Not Satisfiable', 417 => 'Expectation Failed', 422 => 'Unprocessable Entity', # RFC 2518 (WebDAV) 423 => 'Locked', # RFC 2518 (WebDAV) 424 => 'Failed Dependency', # RFC 2518 (WebDAV) 425 => 'No code', # WebDAV Advanced Collections 426 => 'Upgrade Required', # RFC 2817 449 => 'Retry with', # unofficial Microsoft 500 => 'Internal Server Error', 501 => 'Not Implemented', 502 => 'Bad Gateway', 503 => 'Service Unavailable', 504 => 'Gateway Timeout', 505 => 'HTTP Version Not Supported', 506 => 'Variant Also Negotiates', # RFC 2295 507 => 'Insufficient Storage', # RFC 2518 (WebDAV) 509 => 'Bandwidth Limit Exceeded', # unofficial 510 => 'Not Extended', # RFC 2774 ); sub new { my $class = shift; my %args = @_ == 1 ? %{$_[0]} : @_; $args{port} || Carp::croak("missing mandatory parameter 'port'"); bless { bufsize => 10*1024, protocol => "HTTP/1.1", enable_chunked => 1, %args }, $class; } sub add_trigger { my ($self, $name, $code) = @_; push @{$self->{triggers}->{$name}}, $code; return $self; } sub call_trigger { my ($self, $name, @args) = @_; for my $code (@{ $self->{triggers}->{$name} || +[] }) { $code->($self, @args); } } sub run { my ( $self, $app ) = @_; $app = $self->fill_content_length($app); local $SIG{PIPE} = "IGNORE"; my $sock = IO::Socket::INET->new( Listen => SOMAXCONN, Proto => 'tcp', ReuseAddr => 1, LocalAddr => '127.0.0.1', LocalPort => $self->{port}, Timeout => 3, ) or die $!; $sock->autoflush(1); while ( my $csock = $sock->accept ) { $csock->setsockopt( IPPROTO_TCP, TCP_NODELAY, 1 ) or die "setsockopt(TCP_NODELAY) failed:$!"; eval { $self->handle_connection($csock => $app); }; print STDERR "# $@" if $@; } } sub make_header { my ($self, $code, $headers) = @_; my $msg = $STATUS_CODE{$code} || $code; my $ret = "$self->{protocol} $code $msg\015\012"; for (my $i=0; $i<@$headers; $i+=2) { $ret .= $headers->[$i] . ': ' . $headers->[$i+1] . "\015\012"; } return $ret; } sub handle_connection { my ($self, $csock, $app) = @_; $self->call_trigger( "BEFORE_HANDLE_CONNECTION", $csock ); HANDLE_LOOP: while (1) { $self->call_trigger( "BEFORE_HANDLE_REQUEST", $csock ); my %env; my $buf = ''; PARSE_HTTP_REQUEST: while (1) { my $nread = sysread( $csock, $buf, $self->{bufsize}, length($buf) ); $buf =~ s!^(\015\012)*!! if defined($buf); # for keep-alive if ( !defined $nread ) { die "cannot read HTTP request header: $!"; } if ( $nread == 0 ) { # unexpected EOF while reading HTTP request header last HANDLE_LOOP; } my $ret = parse_http_request( $buf, \%env ); if ( $ret == -2 ) { # incomplete. next; } elsif ( $ret == -1 ) { # request is broken die "broken HTTP header"; } else { $buf = substr( $buf, $ret ); last PARSE_HTTP_REQUEST; } } $self->call_trigger( "BEFORE_CALL_APP", $csock, \%env ); my $res = $app->( \%env ); $self->call_trigger( "AFTER_CALL_APP", $csock, \%env ); my $res_header = $self->make_header( $res->[0], $res->[1] ) . "\015\012"; $self->write_all( $csock, $res_header ); for my $body (@{$res->[2]}) { $self->write_all( $csock, $body ); } $self->call_trigger( "AFTER_HANDLE_REQUEST", $csock ); last HANDLE_LOOP unless $csock->opened; } $self->call_trigger( "AFTER_HANDLE_CONNECTION", $csock ); } sub fill_content_length { my ($self, $app) = @_; sub { my $env = shift; my $res = $app->($env); my $h = t::HTTPServer::Headers->new( $res->[1] ); if ( !t::HTTPServer::Util::status_with_no_entity_body( $res->[0] ) && !$h->exists('Content-Length') && !$h->exists('Transfer-Encoding') && defined( my $content_length = t::HTTPServer::Util::content_length( $res->[2] ) ) ) { push @{$res->[1]}, 'Content-Length' => $content_length; } return $res; } } sub write_all { my ( $self, $csock, $buf ) = @_; my $off = 0; while ( my $len = length($buf) - $off ) { my $nwrite = $csock->syswrite( $buf, $len, $off ) or die "Cannot write response: $!"; $off += $nwrite; } return $off; } sub parse_http_request { my ( $chunk, $env ) = @_; Carp::croak("second param to parse_http_request should be a hashref") unless ( ref $env || '' ) eq 'HASH'; # pre-header blank lines are allowed (RFC 2616 4.1) $chunk =~ s/^(\x0d?\x0a)+//; return -2 unless length $chunk; # double line break indicates end of header; parse it if ( $chunk =~ /^(.*?\x0d?\x0a\x0d?\x0a)/s ) { return _parse_header( $chunk, length $1, $env ); } return -2; # still waiting for unknown amount of header lines } sub _parse_header { my($chunk, $eoh, $env) = @_; my $header = substr($chunk, 0, $eoh,''); $chunk =~ s/^\x0d?\x0a\x0d?\x0a//; # parse into lines my @header = split /\x0d?\x0a/,$header; my $request = shift @header; # join folded lines my @out; for(@header) { if(/^[ \t]+/) { return -1 unless @out; $out[-1] .= $_; } else { push @out, $_; } } # parse request or response line my $obj; my ($major, $minor); my ($method,$uri,$http) = split / /,$request; return -1 unless $http and $http =~ /^HTTP\/(\d+)\.(\d+)$/i; ($major, $minor) = ($1, $2); my($path, $query) = ( $uri =~ /^([^?]*)(?:\?(.*))?$/s ); # following validations are just needed to pass t/01simple.t if ($path =~ /%(?:[0-9a-f][^0-9a-f]|[^0-9a-f][0-9a-f])/i) { # invalid char in url-encoded path return -1; } if ($path =~ /%(?:[0-9a-f])$/i) { # partially url-encoded return -1; } $env->{REQUEST_METHOD} = $method; $env->{REQUEST_URI} = $uri; $env->{SERVER_PROTOCOL} = "HTTP/$major.$minor"; $env->{PATH_INFO} = uri_unescape($path); $env->{QUERY_STRING} = $query || ''; $env->{SCRIPT_NAME} = ''; # import headers my $token = qr/[^][\x00-\x1f\x7f()<>@,;:\\"\/?={} \t]+/; my $k; for my $header (@out) { if ( $header =~ s/^($token): ?// ) { $k = $1; $k =~ s/-/_/g; $k = uc $k; if ($k !~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) { $k = "HTTP_$k"; } } elsif ( $header =~ /^\s+/) { # multiline header } else { return -1; } if (exists $env->{$k}) { $env->{$k} .= ", $header"; } else { $env->{$k} = $header; } } return $eoh; } sub uri_unescape { local $_ = shift; $_ =~ s/%([0−9A−Fa−f]{2})/chr(hex($1))/eg; $_; } package t::HTTPServer::Util; # code taken from Plack::Util. use Scalar::Util (); sub status_with_no_entity_body { my $status = shift; return $status < 200 || $status == 204 || $status == 304; } sub content_length { my $body = shift; return unless defined $body; if (ref $body eq 'ARRAY') { my $cl = 0; for my $chunk (@$body) { $cl += length $chunk; } return $cl; } elsif ( is_real_fh($body) ) { return (-s $body) - tell($body); } return; } sub is_real_fh ($) { my $fh = shift; my $reftype = Scalar::Util::reftype($fh) or return; if ( $reftype eq 'IO' or $reftype eq 'GLOB' && *{$fh}{IO} ) { # if it's a blessed glob make sure to not break encapsulation with # fileno($fh) (e.g. if you are filtering output then file descriptor # based operations might no longer be valid). # then ensure that the fileno *opcode* agrees too, that there is a # valid IO object inside $fh either directly or indirectly and that it # corresponds to a real file descriptor. my $m_fileno = $fh->fileno; return 0 unless defined $m_fileno; return 0 unless $m_fileno >= 0; my $f_fileno = fileno($fh); return 0 unless defined $f_fileno; return 0 unless $f_fileno >= 0; return 1; } else { # anything else, including GLOBS without IO (even if they are blessed) # and non GLOB objects that look like filehandle objects cannot have a # valid file descriptor in fileno($fh) context so may break. return 0; } } package t::HTTPServer::Headers; sub new { my ($class, $headers) = @_; my %h; for (my $i=0; $i<@$headers; $i++) { my ($k, $v) = ($headers->[$i], $headers->[$i+1]); push @{$h{lc $k}}, $v; } return bless \%h, $class; } sub exists { my ($self, $key) = @_; $self->{lc $key} ? 1 : 0; } sub header { my ($self, $key) = @_; my $val = $self->{lc $key}; return unless $val; return wantarray ? @$val : join(', ', @$val); } 1; Slowloris.pm100664001751001751 160213160135067 16461 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/tpackage t::Slowloris; use strict; use warnings; package Slowloris; use Test::SharedFork; our $WriteBytes = 1; our $SleepBeforeWrite = 0; our $SleepBeforeRead = 0; package Slowloris::Socket; use parent qw(IO::Socket::INET); use Time::HiRes qw(sleep); sub syswrite { my($sock, $buff, $len, $off) = @_; sleep $SleepBeforeWrite if $SleepBeforeWrite; my $w = $off; while($off < $len) { my $n = $sock->SUPER::syswrite($buff, $Slowloris::WriteBytes, $off); defined($n) or return undef; $off += $n; } return $off - $w; } sub sysread { my $sock = shift; sleep $SleepBeforeRead if $SleepBeforeRead; return $sock->SUPER::sysread(@_); } package Slowloris::Server; use parent qw(HTTP::Server::PSGI); sub setup_listener { my $self = shift; $self->SUPER::setup_listener(@_); bless $self->{listen_sock}, 'Slowloris::Socket'; } 1; Util.pm100664001751001751 373413160135067 15411 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/tpackage t::Util; use strict; use warnings; use base qw/Exporter/; use Test::More; use Furl::HTTP; use Fcntl qw(O_CREAT O_RDWR SEEK_SET); our @EXPORT = qw/online skip_if_offline/; my $orig = \&Furl::new; sub wrapped_env_proxy { my ($class, %args) = @_; $args{proxy} = $ENV{HTTP_PROXY} if ($args{url}||'') !~ /^https?:\/\/\d+/; return $orig->($class, %args); }; { no strict 'refs'; no warnings 'redefine'; *Furl::new = \&wrapped_env_proxy if $ENV{TEST_ENV_PROXY}; } # taken from LWP::Online my @RELIABLE_HTTP = ( # These are some initial trivial checks. # The regex are case-sensitive to at least # deal with the "couldn't get site.com case". 'http://google.com/' => sub { /About Google/ }, 'http://yahoo.com/' => sub { $_ =~ /Yahoo!/ }, 'http://amazon.com/' => sub { /Amazon/ and /Cart/ }, 'http://cnn.com/' => sub { /CNN/ }, ); sub online () { # return the cache if exists sysopen my $cache, '.online', O_CREAT | O_RDWR or return 0; my $online = <$cache>; if(defined $online) { return $online; # cache } my $furl = Furl::HTTP->new(timeout => 5); my $good = 0; my $bad = 0; note 'checking if online'; $online = eval { for (my $i=0; $i<@RELIABLE_HTTP; $i+=2) { my ($url, $check) = @RELIABLE_HTTP[$i, $i+1]; note "getting $url"; my ($version, $code, $msg, $headers, $content) = $furl->request(url => $url); note "$code $msg"; local $_ = $content; if ($code == 200 && $check->()) { $good++; } else { $bad++; } return 1 if $good > 1; return 0 if $bad > 2; } }; diag $@ if $@; seek $cache, 0, SEEK_SET; print $cache $online ? 1 : 0; close $cache; return $online; } sub skip_if_offline { plan skip_all => "This test requires online env" unless online(); } 1; 02_perlcritic.t100664001751001751 240313160135067 17144 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xtuse strict; use warnings; use Test::More; eval { require Perl::Critic; Perl::Critic->VERSION(1.105); require Test::Perl::Critic; Test::Perl::Critic->VERSION(1.02); Test::Perl::Critic->import( -profile => \(join q{}, ) ); }; note $@ if $@; plan skip_all => "Perl::Critic 1.105+ or Test::Perl::Critic 1.02+ is not installed." if $@; all_critic_ok('lib', 'script', 'bin'); __END__ only=1 # ------------------------------------------------------------------------- # Not important. [BuiltinFunctions::ProhibitSleepViaSelect] [BuiltinFunctions::RequireGlobFunction] [ClassHierarchies::ProhibitOneArgBless] # ------------------------------------------------------------------------- # Bug detection [InputOutput::ProhibitBarewordFileHandles] [Modules::RequireFilenameMatchesPackage] [Subroutines::ProhibitNestedSubs] [Subroutines::ProhibitReturnSort] [TestingAndDebugging::RequireUseStrict] [Variables::ProhibitConditionalDeclarations] [Variables::RequireLexicalLoopIterators] [TestingAndDebugging::ProhibitNoStrict] allow=refs # ------------------------------------------------------------------------- # Security issue detection [InputOutput::RequireEncodingWithUTF8Layer] [Modules::ProhibitEvilModules] [InputOutput::ProhibitTwoArgOpen] 04_leaktrace.t100664001751001751 113213160135067 16737 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt#!perl -w use strict; use Test::Requires qw(Plack::Request HTTP::Body), qw(Test::LeakTrace); use Test::More; use Furl; no_leaks_ok { my $furl = Furl->new(); my $res = $furl->request( method => 'GET', host => 'example.com', path => '/', ); $res->is_success or die $res->status_line; }; my $furl = Furl->new(); no_leaks_ok { for(1 .. 5) { my $res = $furl->request( method => 'GET', host => 'example.com', path => '/', ); $res->is_success or die $res->status_line; } }; done_testing; 05_valgrind.t100664001751001751 22513160135067 16575 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xtuse Test::More; eval 'use Test::Valgrind'; plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind' if $@; leaky(); 01_idn.t100664001751001751 61713160135067 17407 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt/200_onlineuse strict; use warnings; use utf8; use t::Util; use Test::More; use Furl; use Test::Requires qw(Plack::Request HTTP::Body), 'Net::IDN::Encode'; skip_if_offline(); my $url = 'http://日本語.jp/'; my $furl = Furl->new(); my $res = $furl->get($url); ok $res->is_success or $res->status_line; utf8::decode($url); $res = $furl->get($url); ok $res->is_success or $res->status_line; done_testing; 02_google.t100664001751001751 51013160135067 20102 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt/200_onlineuse strict; use warnings; use utf8; use t::Util; use Test::More; use Furl; skip_if_offline(); my $url = 'http://www.google.co.jp/'; my $furl = Furl->new(); $furl->env_proxy(); for(1 .. 2) { note "getting"; my $res = $furl->get($url); note "done"; ok $res->is_success or diag $res->status_line } done_testing; 03_yahoo_com.t100664001751001751 57213160135067 20614 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt/200_onlineuse strict; use warnings; use utf8; use t::Util; use Test::More; use Furl; plan skip_all => 'SSL cert error' if $ENV{TRAVIS}; skip_if_offline(); my $url = 'http://www.yahoo.com/'; my $furl = Furl->new(); $furl->env_proxy(); for(1 .. 2) { note "getting"; my $res = $furl->get($url); note "done"; ok $res->is_success or die $res->status_line; } done_testing; 04_ssl.t100664001751001751 75413160135067 17443 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt/200_onlineuse strict; use warnings; use utf8; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), qw(IO::Socket::SSL); use Furl; use IO::Socket::SSL; use t::Util; # this test moved to xt/ since mixi's ssl sucks. # ref. http://www.machu.jp/diary/20080918.html#p01 skip_if_offline(); my $furl = Furl->new(); $furl->env_proxy(); for my $url('https://mixi.jp/', 'https://mixi.jp') { my $res = $furl->get($url); ok $res->is_success, $url or diag $res->status_line; } done_testing; 05_connect_error.t100664001751001751 517113160135067 21523 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt/200_onlineuse strict; use warnings; use Furl::HTTP; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), qw(IO::Socket::SSL); use Time::HiRes qw(time); my $n = shift(@ARGV) || 2; # TODO add proxy tests note 'name resolution error'; { my $furl = Furl::HTTP->new(timeout => 60); my (undef, $code, $msg, $headers, $content) = $furl->request( host => 'a.', # an non-existent gTLD port => 80, path_query => '/foo', ); is $code, 500, "nameerror"; like $msg, qr/Internal Response: Cannot resolve host name: a/; is ref($headers), 'ARRAY'; ok $content, "content: $content"; } note 'refused error'; { my $furl = Furl::HTTP->new( timeout => 60, ssl_opts => { SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(), }, ); for my $scheme (qw(http https)) { for (1 .. $n) { my $start_at = time; my (undef, $code, $msg, $headers, $content) = $furl->request( host => '255.255.255.255', port => 80, scheme => $scheme, path_query => '/foo', ); my $elapsed = time - $start_at; is $code, 500, "request/$scheme/$_"; if (Furl::HTTP::WIN32) { like $msg, qr/Internal Response: (Failed to send HTTP request:|Cannot create SSL connection:)/; } else { like $msg, qr/Internal Response: (Cannot connect to 255.255.255.255:80:|Cannot create SSL connection:)/; } is ref($headers), 'ARRAY'; ok $content, "content: $content"; ok $elapsed < 0.5 unless Furl::HTTP::WIN32 && $scheme eq 'https'; } } } note 'timeout error'; # Timeout parameter of IO::Socket::SSL does not seem to be accurate, so only test http for my $scheme (qw(http)) { for my $timeout (1.5, 4, 8) { my $furl = Furl::HTTP->new(timeout => $timeout); my $start_at = time; my (undef, $code, $msg, $headers, $content) = $furl->request( host => 'google.com', port => 81, scheme => $scheme, path_query => '/foo', ); my $elapsed = time - $start_at; is $code, 500, "request/$scheme/timeout/$timeout"; like $msg, qr/Internal Response: Cannot connect to google.com:81:/; is ref($headers), 'ARRAY'; ok $content, "content: $content"; ok $timeout - 0.1 <= $elapsed && $elapsed <= $timeout + 1, "elapsed: $elapsed"; } } done_testing; 06_net-dns-lite.t100664001751001751 324213160135067 21162 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt/200_onlineuse strict; use warnings; use Furl::HTTP; use Test::More; use Test::Requires qw(Plack::Request HTTP::Body), qw(Net::DNS::Lite); use Time::HiRes qw(time sleep); my $n = shift(@ARGV) || 2; # TODO add proxy tests { my $furl = Furl::HTTP->new( inet_aton => sub { Net::DNS::Lite::inet_aton(@_) }, ); for (1 .. $n) { my $start_at = time; my (undef, $code, $msg, $headers, $content) = $furl->request( host => 'google.com', # authoritative dns does not respond port => 80, path_query => '/', ); my $elapsed = time - $start_at; is $code, 200, "request/$_"; is ref($headers), 'ARRAY'; } } note 'dns timeout'; { my $called_inet_aton = 0; my $furl = Furl::HTTP->new( timeout => 1, inet_aton => sub { # mimic timeout my ($name, $timeout) = @_; $called_inet_aton++; sleep $timeout; return undef; } ); for (1 .. $n) { my $start_at = time; my (undef, $code, $msg, $headers, $content) = $furl->request( host => 'www.google.com.', # would fail anyway, since inet_aton always returns timeout port => 80, path_query => '/foo', ); my $elapsed = time - $start_at; is $code, 500, "request/$_"; like $msg, qr/Internal Response: Cannot resolve host name: www\.google\.com/; is ref($headers), 'ARRAY'; ok $content, "content: $content"; ok 0.5 <= $elapsed && $elapsed < 1.5, "elapsed: $elapsed"; note "inet_aton calling count: $called_inet_aton"; } } done_testing; 07_ssl_shutdown.t100664001751001751 40413160135067 21371 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt/200_online#!perl use strict; use warnings; use Test::More; use Furl; use IO::Socket::SSL; my $res = Furl->new( ssl_opts => { SSL_verify_mode => SSL_VERIFY_PEER(), }, )->get('https://foursquare.com/login'); ok $res->is_success, 'SSL get'; done_testing; perlcriticrc100664001751001751 40713160135067 16710 0ustar00tokuhiromtokuhirom000000000000Furl-3.13/xt[TestingAndDebugging::ProhibitNoStrict] allow=refs [-Subroutines::ProhibitSubroutinePrototypes] [-Subroutines::ProhibitExplicitReturnUndef] [TestingAndDebugging::RequireUseStrict] equivalent_modules = perl5i::2 [-ControlStructures::ProhibitMutatingListFunctions] META.yml100664001751001751 457113160135067 15144 0ustar00tokuhiromtokuhirom000000000000Furl-3.13--- abstract: 'Lightning-fast URL fetcher' author: - 'Tokuhiro Matsuno ' build_requires: File::Temp: '0' Test::More: '0.96' Test::Requires: '0' Test::TCP: '2.11' configure_requires: Module::Build::Tiny: '0.035' dynamic_config: 0 generated_by: 'Minilla/v3.0.9, 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: Furl no_index: directory: - t - xt - inc - share - eg - examples - author - builder provides: Furl: file: lib/Furl.pm version: '3.13' Furl::ConnectionCache: file: lib/Furl/ConnectionCache.pm Furl::HTTP: file: lib/Furl/HTTP.pm version: '3.13' Furl::Headers: file: lib/Furl/Headers.pm Furl::Request: file: lib/Furl/Request.pm Furl::Response: file: lib/Furl/Response.pm Furl::ZlibStream: file: lib/Furl/ZlibStream.pm recommends: Compress::Raw::Zlib: '0' HTTP::CookieJar: '0' IO::Socket::SSL: '0' Net::IDN::Encode: '0' requires: Class::Accessor::Lite: '0' Encode: '0' HTTP::Parser::XS: '0.11' MIME::Base64: '0' Mozilla::CA: '0' Scalar::Util: '0' Socket: '0' Time::HiRes: '0' perl: '5.008001' resources: bugtracker: https://github.com/tokuhirom/Furl/issues homepage: https://github.com/tokuhirom/Furl repository: git://github.com/tokuhirom/Furl.git version: '3.13' x_contributors: - 'Keiji, Yoshimi ' - 'Fuji, Goro ' - 'lestrrat ' - 'Audrey Tang ' - 'Fuji Goro ' - 'Fuji, Goro ' - 's-aska ' - 'ikasam_a ' - 'xaicron ' - 'Neil Bowers ' - 'Toshio Ito ' - 'bayashi ' - 'Masahiro Nagano ' - 'HIROSE Masaaki ' - 'Kazuho Oku ' - 'Jari Salmela ' - 'tarao ' - 'kimoto ' - 'Breno G. de Oliveira ' - 'Jiro Nishiguchi ' - 'Yasuhiro Matsumoto ' - 'Syohei YOSHIDA ' - 'ktat ' - 'Shoichi Kaji ' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' MANIFEST100664001751001751 446713160135067 15030 0ustar00tokuhiromtokuhirom000000000000Furl-3.13Build.PL Changes LICENSE META.json README.md TODO author/benchmark/byown.pl author/benchmark/note.mkdn author/benchmark/profile.pl author/benchmark/simple.pl author/mk-chunked-response.pl cpanfile example/get.pl lib/Furl.pm lib/Furl/ConnectionCache.pm lib/Furl/HTTP.pm lib/Furl/Headers.pm lib/Furl/Request.pm lib/Furl/Response.pm lib/Furl/ZlibStream.pm t/00_compile.t t/01_version.t t/100_low/01_simple.t t/100_low/03_redirect.t t/100_low/04_chunked.t t/100_low/05_slowloris.t t/100_low/06_errors.t t/100_low/07_timeout.t t/100_low/08_proxy.t t/100_low/09_body.t t/100_low/11_write_file.t t/100_low/12_write_code.t t/100_low/13_deflate.t t/100_low/15_multiline_header.t t/100_low/16_read_callback.t t/100_low/17_keep_alive.t t/100_low/18_no_proxy.t t/100_low/19_special_headers.t t/100_low/20_header_format_none.t t/100_low/21_keep_alive_timedout.t t/100_low/22_keep_alive.t t/100_low/22_keep_alive_http10.t t/100_low/23_redirect_relative.t t/100_low/24_no_content.t t/100_low/25_signal.t t/100_low/26_headers_only.t t/100_low/27_close_on_eof.t t/100_low/28_idn.t t/100_low/29_completion_slash.t t/100_low/30_user_agent.t t/100_low/31_chunked_unexpected_eof.t t/100_low/32_proxy_auth.t t/100_low/33_basic_auth.t t/100_low/34_keep_request.t t/100_low/35_get_address.t t/100_low/36_inactivity_timeout.t t/100_low/37_bad_content_length.t t/100_low/38_continue.t t/100_low/39_httpoxy.t t/300_high/01_simple.t t/300_high/02_agent.t t/300_high/04_http_request.t t/300_high/05_suppress_dup_host_header.t t/300_high/06_keep_request.t t/300_high/07_cookie.t t/300_high/99_error.t t/400_components/001_response-coding/01-file.t t/400_components/001_response-coding/t-euc-jp.html t/400_components/001_response-coding/t-iso-2022-jp.html t/400_components/001_response-coding/t-null.html t/400_components/001_response-coding/t-shiftjis.html t/400_components/001_response-coding/t-utf-8.html t/400_components/01_headers.t t/400_components/02_response.t t/400_components/03_request.t t/800_regression/01_capture_request.t t/999_intrenal/parse_url.t t/HTTPServer.pm t/Slowloris.pm t/Util.pm xt/02_perlcritic.t xt/04_leaktrace.t xt/05_valgrind.t xt/200_online/01_idn.t xt/200_online/02_google.t xt/200_online/03_yahoo_com.t xt/200_online/04_ssl.t xt/200_online/05_connect_error.t xt/200_online/06_net-dns-lite.t xt/200_online/07_ssl_shutdown.t xt/perlcriticrc META.yml MANIFEST