diff --git a/.gitignore b/.gitignore index e4d0dc1f..9bdf35df 100644 --- a/.gitignore +++ b/.gitignore @@ -1,9 +1,17 @@ -Makefile -Makefile.old -blib -pm_to_blib +/Makefile +.build +/Makefile.old +/blib/ +/pm_to_blib SSL t/CAN_TALK_TO_OURSELF t/live/ENABLED -*.tar.gz xx* +/_eumm/ +/MYMETA.* +/MANIFEST.bak +/MANIFEST.SKIP.bak +/Net-HTTP-*/ +/Net-HTTP-*.tar.gz +t/LIVE_TESTS +.tidyall.d diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000..365f9a50 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,15 @@ +language: perl +perl: + - "5.24" + - "5.22" + - "5.20" + - "5.18" + - "5.16" + - "5.14" + - "5.12" + - "5.10" +before_install: + - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers + - source ~/travis-perl-helpers/init + - build-perl + - perl -V diff --git a/Changes b/Changes index 8a064c77..bd95b5a0 100644 --- a/Changes +++ b/Changes @@ -1,76 +1,66 @@ -2014-07-23 Net-HTTP 6.07 - -Jason Fesler (1): - Opportunistically use IO::Socket::IP or IO::Socket::INET6. - Properly parse IPv6 literal addreses with optional port numbers. [RT#75618] - -_______________________________________________________________________________ -2013-03-10 Net-HTTP 6.06 - -Jesse Luehrs (1): - IO::Socket::SSL doesn't play well with select() [RT#81237] - - - -_______________________________________________________________________________ -2012-11-10 Net-HTTP 6.05 - -Gisle Aas (1): - Convert to Test::More style and disable test on Windows [RT#81090] - -Marinos Yannikos (1): - SSL broken for some servers [RT#81073] - - - -_______________________________________________________________________________ -2012-11-08 Net-HTTP 6.04 - -Gisle Aas (3): - Simpler handling of double chunked [RT#77240] - Check for timeouts before reading [RT#72676] - Fake can_read - -Dagfinn Ilmari Mannsåker (1): - Fix chunked decoding on temporary read error [RT#74431] - -Eric Wong (1): - NB: set http_bytes if read_entity_body hits EAGAIN on first read - -Jay Hannah (1): - chunked,chunked is invalid, but happens. :( Ignore all but the first. [RT#77240] - - - -_______________________________________________________________________________ -2012-02-16 Net-HTTP 6.03 - -Restore blocking override for Net::SSL [RT#72790] - -Restore perl-5.6 compatiblity. - - -_______________________________________________________________________________ -2011-11-21 Net-HTTP 6.02 - -Don't disable blocking method [RT#72580] -Don't stop on unrecognized Makefile.PL arguments [RT#68337] -Document Net:HTTPS [RT#71599] - - - -_______________________________________________________________________________ -2011-03-17 Net-HTTP 6.01 - -Don't run live test by default. Run 'perl Makefile.PL --live-tests' to enable. -More relaxed apache test; should pass even if proxies has added headers. - - - -_______________________________________________________________________________ -2011-02-27 Net-HTTP 6.00 - -Initial release of Net-HTTP as a separate distribution. There are no code -changes besides incrementing the version number since libwww-perl-5.837. - -The Net::HTTP module used to be bundled with the libwww-perl distribution. +Release history for {{$dist->name}} + +{{$NEXT}} + +6.12 2017-01-04 23:32:54-05:00 America/Toronto + - Fix prereqs + +6.11 2017-01-04 15:05:57-05:00 America/Toronto + - Updated the Changes file + - When using Net::SSL, pending data was potentially ignored GH PR#7 (Jean-Louis Martineau) + +6.10-DEV 2016-12-30 + - Added LICENSE + - Added 'use warnings' to everywhere that lacked it + - Drop all use of Test.pm + - Removed unneeded uses of 'use vars' + - Switch live tests to use Google. + - Fix RT#112313 - Hang in my_readline() when keep-alive => 1 and $response_size % 1024 == 0 + +6.09 2015-05-20 + - No changes since 6.08_002 + +6.08_002 2015-05-02 + - Fix foolish $VERSION error in 6.08_001 (Karen Etheridge) + +6.08_001 2015-05-01 + - resolve issues with SSL by reading bytes still waiting to be read after + the initial 1024 bytes [RT#104122] (Mark Overmeer) + +6.07 2014-07-23 + - Opportunistically use IO::Socket::IP or IO::Socket::INET6. (Jason Fesler) + - Properly parse IPv6 literal addresses with optional port numbers. [RT#75618] + +6.06 2013-03-10 + - IO::Socket::SSL doesn't play well with select() [RT#81237] (Jesse Luehrs) + +6.05 2012-11-10 + - Convert to Test::More style and disable test on Windows [RT#81090] (Gisle Aas) + - SSL broken for some servers [RT#81073] (Marinos Yannikos) + +6.04 2012-11-08 + - Simpler handling of double chunked [RT#77240] (Gisle Aas) + - Check for timeouts before reading [RT#72676] (Gisle Aas) + - Fake can_read (Gisle Aas) + - Fix chunked decoding on temporary read error [RT#74431] (Dagfinn Ilmari Mannsåker) + - NB: set http_bytes if read_entity_body hits EAGAIN on first read (Eric Wong) + - chunked,chunked is invalid, but happens. Ignore all but the first. [RT#77240] (Jay Hannah) + +6.03 2012-02-16 + - Restore blocking override for Net::SSL [RT#72790] + - Restore perl-5.6 compatibility. + +6.02 2011-11-21 + - Don't disable blocking method [RT#72580] + - Don't stop on unrecognized Makefile.PL arguments [RT#68337] + - Document Net:HTTPS [RT#71599] + +6.01 2011-03-17 + - Don't run live test by default; 'perl Makefile.PL --live-tests' to enable. + - More relaxed apache test; should pass even if proxies has added headers. + +6.00 2011-02-27 + - Initial release of Net-HTTP as a separate distribution. + - No code changes. + - Version bump to be ahead of old release + - The Net::HTTP module used to be bundled with the libwww-perl distribution. diff --git a/Install b/Install new file mode 100644 index 00000000..c1fb5f40 --- /dev/null +++ b/Install @@ -0,0 +1,43 @@ +This is the Perl distribution Net-HTTP. + +Installing Net-HTTP is straightforward. + +## Installation with cpanm + +If you have cpanm, you only need one line: + + % cpanm Net::HTTP + +If it does not have permission to install modules to the current perl, cpanm +will automatically set up and install to a local::lib in your home directory. +See the local::lib documentation (https://metacpan.org/pod/local::lib) for +details on enabling it in your environment. + +## Installing with the CPAN shell + +Alternatively, if your CPAN shell is set up, you should just be able to do: + + % cpan Net::HTTP + +## Manual installation + +As a last resort, you can manually install it. Download the tarball, untar it, +then build it: + + % perl Makefile.PL + % make && make test + +Then install it: + + % make install + +If your perl is system-managed, you can create a local::lib in your home +directory to install modules to. For details, see the local::lib documentation: +https://metacpan.org/pod/local::lib + +## Documentation + +Net-HTTP documentation is available as POD. +You can run perldoc from a shell to read the documentation: + + % perldoc Net::HTTP diff --git a/LICENSE b/LICENSE new file mode 100644 index 00000000..0df0e2e4 --- /dev/null +++ b/LICENSE @@ -0,0 +1,379 @@ +This software is copyright (c) 2001-2017 by Gisle Aas. + +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) 2001-2017 by Gisle Aas. + +This is free software, licensed under: + + The GNU General Public License, Version 1, February 1989 + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! + + +--- The Artistic License 1.0 --- + +This software is Copyright (c) 2001-2017 by Gisle Aas. + +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 + diff --git a/MANIFEST b/MANIFEST deleted file mode 100644 index 74d3a55b..00000000 --- a/MANIFEST +++ /dev/null @@ -1,12 +0,0 @@ -Changes -lib/Net/HTTP.pm -lib/Net/HTTP/Methods.pm -lib/Net/HTTP/NB.pm -lib/Net/HTTPS.pm -Makefile.PL -MANIFEST This list of files -README -t/http.t -t/http-nb.t -t/apache.t -t/apache-https.t diff --git a/META.json b/META.json new file mode 100644 index 00000000..33f046ca --- /dev/null +++ b/META.json @@ -0,0 +1,145 @@ +{ + "abstract" : "Low-level HTTP connection (client)", + "author" : [ + "Gisle Aas " + ], + "dynamic_config" : 0, + "generated_by" : "Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150005", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Net-HTTP", + "no_index" : { + "directory" : [ + "examples", + "t", + "xt" + ] + }, + "prereqs" : { + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + }, + "suggests" : { + "JSON::PP" : "2.27300" + } + }, + "runtime" : { + "requires" : { + "Carp" : "0", + "Compress::Raw::Zlib" : "0", + "IO::Socket::INET" : "0", + "IO::Uncompress::Gunzip" : "0", + "URI" : "0", + "base" : "0", + "perl" : "5.006002", + "strict" : "0", + "vars" : "0", + "warnings" : "0" + }, + "suggests" : { + "IO::Socket" : "0", + "IO::Socket::INET6" : "0", + "IO::Socket::IP" : "0", + "IO::Socket::SSL" : "1.38", + "Symbol" : "0" + } + }, + "test" : { + "requires" : { + "Data::Dumper" : "0", + "IO::Select" : "0", + "Socket" : "0", + "Test::More" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "https://github.com/libwww-perl/Net-HTTP/issues" + }, + "homepage" : "https://github.com/libwww-perl/Net-HTTP", + "repository" : { + "type" : "git", + "url" : "https://github.com/libwww-perl/Net-HTTP.git", + "web" : "https://github.com/libwww-perl/Net-HTTP" + }, + "x_IRC" : "irc://irc.perl.org/#lwp", + "x_MailingList" : "mailto:libwww@perl.org" + }, + "version" : "6.12", + "x_contributors" : [ + "Adam Kennedy ", + "Adam Sjogren ", + "Alexey Tourbin ", + "Alex Kapranoff ", + "amire80 ", + "Andreas J. Koenig ", + "Andy Grundman ", + "Bill Mann ", + "Bron Gondwana ", + "Chase Whitener ", + "Dagfinn Ilmari Manns\u00e5ker ", + "Daniel Hedlund ", + "David E. Wheeler ", + "DAVIDRW ", + "David Steinbrunner ", + "Eric Wong ", + "Father Chrysostomos ", + "FWILES ", + "Gavin Peters ", + "Gisle Aas ", + "Gisle Aas ", + "Gisle Aas ", + "Gisle Aas ", + "Graeme Thompson ", + "Hans-H. Froehlich ", + "Ian Kilgore ", + "Jacob J ", + "Jason A Fesler ", + "Jay Hannah ", + "Jean-Louis Martineau ", + "jefflee ", + "Jesse Luehrs ", + "john9art ", + "Karen Etheridge ", + "Lasse Makholm ", + "Marinos Yannikos ", + "Mark Overmeer ", + "Mark Stosberg ", + "Mark Stosberg ", + "Mark Stosberg ", + "Mike Schilli ", + "Mike Schilli ", + "murphy ", + "Olaf Alders ", + "Ondrej Hanak ", + "Peter Rabbitson ", + "phrstbrn ", + "Robert Stone ", + "Rolf Grossmann ", + "ruff ", + "sasao ", + "Sean M. Burke ", + "Slaven Rezic ", + "Slaven Rezic ", + "Spiros Denaxas ", + "Steve Hay ", + "Todd Lipcon ", + "Tom Hukins ", + "Tony Finch ", + "Toru Yamaguchi ", + "uid39246 ", + "Ville Skytta ", + "Yuri Karaban ", + "Zefram " + ], + "x_serialization_backend" : "Cpanel::JSON::XS version 3.0225" +} + diff --git a/Makefile.PL b/Makefile.PL index 31916246..13a33b73 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,63 +1,69 @@ -#!perl -w - -require 5.006002; +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.008. use strict; +use warnings; + +use 5.006002; + use ExtUtils::MakeMaker; -use Getopt::Long qw(GetOptions); -GetOptions(\my %opt, 'live-tests',) or warn "Usage: $0 [--live-tests]\n"; -my $flag_file = "t/LIVE_TESTS"; -if ($opt{"live-tests"}) { - open(my $fh, ">", $flag_file) || die; -} -else { - unlink($flag_file); -} +my %WriteMakefileArgs = ( + "ABSTRACT" => "Low-level HTTP connection (client)", + "AUTHOR" => "Gisle Aas ", + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => 0 + }, + "DISTNAME" => "Net-HTTP", + "LICENSE" => "perl", + "MIN_PERL_VERSION" => "5.006002", + "NAME" => "Net::HTTP", + "PREREQ_PM" => { + "Carp" => 0, + "Compress::Raw::Zlib" => 0, + "IO::Socket::INET" => 0, + "IO::Uncompress::Gunzip" => 0, + "URI" => 0, + "base" => 0, + "strict" => 0, + "vars" => 0, + "warnings" => 0 + }, + "TEST_REQUIRES" => { + "Data::Dumper" => 0, + "IO::Select" => 0, + "Socket" => 0, + "Test::More" => 0 + }, + "VERSION" => "6.12", + "test" => { + "TESTS" => "t/*.t" + } +); + -WriteMakefile( - NAME => 'Net::HTTP', - VERSION_FROM => 'lib/Net/HTTP.pm', - ABSTRACT_FROM => 'lib/Net/HTTP.pm', - AUTHOR => 'Gisle Aas ', - LICENSE => "perl", - MIN_PERL_VERSION => 5.006002, - PREREQ_PM => { - 'IO::Socket::INET' => 0, - 'IO::Select' => 0, - 'Compress::Raw::Zlib' => 0, - 'IO::Uncompress::Gunzip' => 0, - 'URI' => 0, - }, - META_MERGE => { - recommends => { - 'IO::Socket::SSL' => "1.38", - }, - resources => { - repository => 'http://github.com/libwww-perl/net-http', - MailingList => 'mailto:libwww@perl.org', - } - }, +my %FallbackPrereqs = ( + "Carp" => 0, + "Compress::Raw::Zlib" => 0, + "Data::Dumper" => 0, + "IO::Select" => 0, + "IO::Socket::INET" => 0, + "IO::Uncompress::Gunzip" => 0, + "Socket" => 0, + "Test::More" => 0, + "URI" => 0, + "base" => 0, + "strict" => 0, + "vars" => 0, + "warnings" => 0 ); -BEGIN { - # compatibility with older versions of MakeMaker - my $developer = -f ".gitignore"; - my %mm_req = ( - LICENCE => 6.31, - META_MERGE => 6.45, - META_ADD => 6.45, - MIN_PERL_VERSION => 6.48, - ); - undef(*WriteMakefile); - *WriteMakefile = sub { - my %arg = @_; - for (keys %mm_req) { - unless (eval { ExtUtils::MakeMaker->VERSION($mm_req{$_}) }) { - warn "$_ $@" if $developer; - delete $arg{$_}; - } - } - ExtUtils::MakeMaker::WriteMakefile(%arg); - }; +unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { + delete $WriteMakefileArgs{TEST_REQUIRES}; + delete $WriteMakefileArgs{BUILD_REQUIRES}; + $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } + +delete $WriteMakefileArgs{CONFIGURE_REQUIRES} + unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; + +WriteMakefile(%WriteMakefileArgs); diff --git a/README b/README deleted file mode 100644 index 6b5217d3..00000000 --- a/README +++ /dev/null @@ -1,217 +0,0 @@ -NAME - Net::HTTP - Low-level HTTP connection (client) - -SYNOPSIS - use Net::HTTP; - my $s = Net::HTTP->new(Host => "www.perl.com") || die $@; - $s->write_request(GET => "/", 'User-Agent' => "Mozilla/5.0"); - my($code, $mess, %h) = $s->read_response_headers; - - while (1) { - my $buf; - my $n = $s->read_entity_body($buf, 1024); - die "read failed: $!" unless defined $n; - last unless $n; - print $buf; - } - -DESCRIPTION - The `Net::HTTP' class is a low-level HTTP client. An instance of the - `Net::HTTP' class represents a connection to an HTTP server. The HTTP - protocol is described in RFC 2616. The `Net::HTTP' class supports - `HTTP/1.0' and `HTTP/1.1'. - - `Net::HTTP' is a sub-class of `IO::Socket::INET'. You can mix the - methods described below with reading and writing from the socket - directly. This is not necessary a good idea, unless you know what you - are doing. - - The following methods are provided (in addition to those of - `IO::Socket::INET'): - - $s = Net::HTTP->new( %options ) - The `Net::HTTP' constructor method takes the same options as - `IO::Socket::INET''s as well as these: - - Host: Initial host attribute value - KeepAlive: Initial keep_alive attribute value - SendTE: Initial send_te attribute_value - HTTPVersion: Initial http_version attribute value - PeerHTTPVersion: Initial peer_http_version attribute value - MaxLineLength: Initial max_line_length attribute value - MaxHeaderLines: Initial max_header_lines attribute value - - The `Host' option is also the default for `IO::Socket::INET''s - `PeerAddr'. The `PeerPort' defaults to 80 if not provided. - - The `Listen' option provided by `IO::Socket::INET''s constructor - method is not allowed. - - If unable to connect to the given HTTP server then the constructor - returns `undef' and $@ contains the reason. After a successful - connect, a `Net:HTTP' object is returned. - - $s->host - Get/set the default value of the `Host' header to send. The $host - must not be set to an empty string (or `undef') for HTTP/1.1. - - $s->keep_alive - Get/set the *keep-alive* value. If this value is TRUE then the - request will be sent with headers indicating that the server should - try to keep the connection open so that multiple requests can be - sent. - - The actual headers set will depend on the value of the - `http_version' and `peer_http_version' attributes. - - $s->send_te - Get/set the a value indicating if the request will be sent with a - "TE" header to indicate the transfer encodings that the server can - choose to use. The list of encodings announced as accepted by this - client depends on availability of the following modules: - `Compress::Raw::Zlib' for *deflate*, and `IO::Compress::Gunzip' for - *gzip*. - - $s->http_version - Get/set the HTTP version number that this client should announce. - This value can only be set to "1.0" or "1.1". The default is "1.1". - - $s->peer_http_version - Get/set the protocol version number of our peer. This value will - initially be "1.0", but will be updated by a successful - read_response_headers() method call. - - $s->max_line_length - Get/set a limit on the length of response line and response header - lines. The default is 8192. A value of 0 means no limit. - - $s->max_header_length - Get/set a limit on the number of header lines that a response can - have. The default is 128. A value of 0 means no limit. - - $s->format_request($method, $uri, %headers, [$content]) - Format a request message and return it as a string. If the headers - do not include a `Host' header, then a header is inserted with the - value of the `host' attribute. Headers like `Connection' and - `Keep-Alive' might also be added depending on the status of the - `keep_alive' attribute. - - If $content is given (and it is non-empty), then a `Content-Length' - header is automatically added unless it was already present. - - $s->write_request($method, $uri, %headers, [$content]) - Format and send a request message. Arguments are the same as for - format_request(). Returns true if successful. - - $s->format_chunk( $data ) - Returns the string to be written for the given chunk of data. - - $s->write_chunk($data) - Will write a new chunk of request entity body data. This method - should only be used if the `Transfer-Encoding' header with a value - of `chunked' was sent in the request. Note, writing zero-length data - is a no-op. Use the write_chunk_eof() method to signal end of entity - body data. - - Returns true if successful. - - $s->format_chunk_eof( %trailers ) - Returns the string to be written for signaling EOF when a - `Transfer-Encoding' of `chunked' is used. - - $s->write_chunk_eof( %trailers ) - Will write eof marker for chunked data and optional trailers. Note - that trailers should not really be used unless is was signaled with - a `Trailer' header. - - Returns true if successful. - - ($code, $mess, %headers) = $s->read_response_headers( %opts ) - Read response headers from server and return it. The $code is the 3 - digit HTTP status code (see HTTP::Status) and $mess is the textual - message that came with it. Headers are then returned as key/value - pairs. Since key letter casing is not normalized and the same key - can even occur multiple times, assigning these values directly to a - hash is not wise. Only the $code is returned if this method is - called in scalar context. - - As a side effect this method updates the 'peer_http_version' - attribute. - - Options might be passed in as key/value pairs. There are currently - only two options supported; `laxed' and `junk_out'. - - The `laxed' option will make read_response_headers() more forgiving - towards servers that have not learned how to speak HTTP properly. - The `laxed' option is a boolean flag, and is enabled by passing in a - TRUE value. The `junk_out' option can be used to capture bad header - lines when `laxed' is enabled. The value should be an array - reference. Bad header lines will be pushed onto the array. - - The `laxed' option must be specified in order to communicate with - pre-HTTP/1.0 servers that don't describe the response outcome or the - data they send back with a header block. For these servers - peer_http_version is set to "0.9" and this method returns (200, - "Assumed OK"). - - The method will raise an exception (die) if the server does not - speak proper HTTP or if the `max_line_length' or `max_header_length' - limits are reached. If the `laxed' option is turned on and - `max_line_length' and `max_header_length' checks are turned off, - then no exception will be raised and this method will always return - a response code. - - $n = $s->read_entity_body($buf, $size); - Reads chunks of the entity body content. Basically the same - interface as for read() and sysread(), but the buffer offset - argument is not supported yet. This method should only be called - after a successful read_response_headers() call. - - The return value will be `undef' on read errors, 0 on EOF, -1 if no - data could be returned this time, otherwise the number of bytes - assigned to $buf. The $buf is set to "" when the return value is -1. - - You normally want to retry this call if this function returns either - -1 or `undef' with `$!' as EINTR or EAGAIN (see Errno). EINTR can - happen if the application catches signals and EAGAIN can happen if - you made the socket non-blocking. - - This method will raise exceptions (die) if the server does not speak - proper HTTP. This can only happen when reading chunked data. - - %headers = $s->get_trailers - After read_entity_body() has returned 0 to indicate end of the - entity body, you might call this method to pick up any trailers. - - $s->_rbuf - Get/set the read buffer content. The read_response_headers() and - read_entity_body() methods use an internal buffer which they will - look for data before they actually sysread more from the socket - itself. If they read too much, the remaining data will be left in - this buffer. - - $s->_rbuf_length - Returns the number of bytes in the read buffer. This should always - be the same as: - - length($s->_rbuf) - - but might be more efficient. - -SUBCLASSING - The read_response_headers() and read_entity_body() will invoke the - sysread() method when they need more data. Subclasses might want to - override this method to control how reading takes place. - - The object itself is a glob. Subclasses should avoid using hash key - names prefixed with `http_' and `io_'. - -SEE ALSO - LWP, IO::Socket::INET, Net::HTTP::NB - -COPYRIGHT - Copyright 2001-2003 Gisle Aas. - - This library is free software; you can redistribute it and/or modify it - under the same terms as Perl itself. - diff --git a/README.md b/README.md new file mode 100644 index 00000000..5b7e49eb --- /dev/null +++ b/README.md @@ -0,0 +1,252 @@ +# NAME + +Net::HTTP - Low-level HTTP connection (client) + +[![Build Status](https://travis-ci.org/libwww-perl/Net-HTTP.png?branch=master)](https://travis-ci.org/libwww-perl/Net-HTTP) + +# VERSION + +version 6.12 + +# SYNOPSIS + + use Net::HTTP; + my $s = Net::HTTP->new(Host => "www.perl.com") || die $@; + $s->write_request(GET => "/", 'User-Agent' => "Mozilla/5.0"); + my($code, $mess, %h) = $s->read_response_headers; + + while (1) { + my $buf; + my $n = $s->read_entity_body($buf, 1024); + die "read failed: $!" unless defined $n; + last unless $n; + print $buf; + } + +# DESCRIPTION + +The `Net::HTTP` class is a low-level HTTP client. An instance of the +`Net::HTTP` class represents a connection to an HTTP server. The +HTTP protocol is described in RFC 2616. The `Net::HTTP` class +supports `HTTP/1.0` and `HTTP/1.1`. + +`Net::HTTP` is a sub-class of one of `IO::Socket::IP` (IPv6+IPv4), +`IO::Socket::INET6` (IPv6+IPv4), or `IO::Socket::INET` (IPv4 only). +You can mix the methods described below with reading and writing from the +socket directly. This is not necessary a good idea, unless you know what +you are doing. + +The following methods are provided (in addition to those of +`IO::Socket::INET`): + +- $s = Net::HTTP->new( %options ) + + The `Net::HTTP` constructor method takes the same options as + `IO::Socket::INET`'s as well as these: + + Host: Initial host attribute value + KeepAlive: Initial keep_alive attribute value + SendTE: Initial send_te attribute_value + HTTPVersion: Initial http_version attribute value + PeerHTTPVersion: Initial peer_http_version attribute value + MaxLineLength: Initial max_line_length attribute value + MaxHeaderLines: Initial max_header_lines attribute value + + The `Host` option is also the default for `IO::Socket::INET`'s + `PeerAddr`. The `PeerPort` defaults to 80 if not provided. + The `PeerPort` specification can also be embedded in the `PeerAddr` + by preceding it with a ":", and closing the IPv6 address on brackets "\[\]" if + necessary: "192.0.2.1:80","\[2001:db8::1\]:80","any.example.com:80". + + The `Listen` option provided by `IO::Socket::INET`'s constructor + method is not allowed. + + If unable to connect to the given HTTP server then the constructor + returns `undef` and $@ contains the reason. After a successful + connect, a `Net:HTTP` object is returned. + +- $s->host + + Get/set the default value of the `Host` header to send. The $host + must not be set to an empty string (or `undef`) for HTTP/1.1. + +- $s->keep\_alive + + Get/set the _keep-alive_ value. If this value is TRUE then the + request will be sent with headers indicating that the server should try + to keep the connection open so that multiple requests can be sent. + + The actual headers set will depend on the value of the `http_version` + and `peer_http_version` attributes. + +- $s->send\_te + + Get/set the a value indicating if the request will be sent with a "TE" + header to indicate the transfer encodings that the server can choose to + use. The list of encodings announced as accepted by this client depends + on availability of the following modules: `Compress::Raw::Zlib` for + _deflate_, and `IO::Compress::Gunzip` for _gzip_. + +- $s->http\_version + + Get/set the HTTP version number that this client should announce. + This value can only be set to "1.0" or "1.1". The default is "1.1". + +- $s->peer\_http\_version + + Get/set the protocol version number of our peer. This value will + initially be "1.0", but will be updated by a successful + read\_response\_headers() method call. + +- $s->max\_line\_length + + Get/set a limit on the length of response line and response header + lines. The default is 8192. A value of 0 means no limit. + +- $s->max\_header\_length + + Get/set a limit on the number of header lines that a response can + have. The default is 128. A value of 0 means no limit. + +- $s->format\_request($method, $uri, %headers, \[$content\]) + + Format a request message and return it as a string. If the headers do + not include a `Host` header, then a header is inserted with the value + of the `host` attribute. Headers like `Connection` and + `Keep-Alive` might also be added depending on the status of the + `keep_alive` attribute. + + If $content is given (and it is non-empty), then a `Content-Length` + header is automatically added unless it was already present. + +- $s->write\_request($method, $uri, %headers, \[$content\]) + + Format and send a request message. Arguments are the same as for + format\_request(). Returns true if successful. + +- $s->format\_chunk( $data ) + + Returns the string to be written for the given chunk of data. + +- $s->write\_chunk($data) + + Will write a new chunk of request entity body data. This method + should only be used if the `Transfer-Encoding` header with a value of + `chunked` was sent in the request. Note, writing zero-length data is + a no-op. Use the write\_chunk\_eof() method to signal end of entity + body data. + + Returns true if successful. + +- $s->format\_chunk\_eof( %trailers ) + + Returns the string to be written for signaling EOF when a + `Transfer-Encoding` of `chunked` is used. + +- $s->write\_chunk\_eof( %trailers ) + + Will write eof marker for chunked data and optional trailers. Note + that trailers should not really be used unless is was signaled + with a `Trailer` header. + + Returns true if successful. + +- ($code, $mess, %headers) = $s->read\_response\_headers( %opts ) + + Read response headers from server and return it. The $code is the 3 + digit HTTP status code (see [HTTP::Status](https://metacpan.org/pod/HTTP::Status)) and $mess is the textual + message that came with it. Headers are then returned as key/value + pairs. Since key letter casing is not normalized and the same key can + even occur multiple times, assigning these values directly to a hash + is not wise. Only the $code is returned if this method is called in + scalar context. + + As a side effect this method updates the 'peer\_http\_version' + attribute. + + Options might be passed in as key/value pairs. There are currently + only two options supported; `laxed` and `junk_out`. + + The `laxed` option will make read\_response\_headers() more forgiving + towards servers that have not learned how to speak HTTP properly. The + `laxed` option is a boolean flag, and is enabled by passing in a TRUE + value. The `junk_out` option can be used to capture bad header lines + when `laxed` is enabled. The value should be an array reference. + Bad header lines will be pushed onto the array. + + The `laxed` option must be specified in order to communicate with + pre-HTTP/1.0 servers that don't describe the response outcome or the + data they send back with a header block. For these servers + peer\_http\_version is set to "0.9" and this method returns (200, + "Assumed OK"). + + The method will raise an exception (die) if the server does not speak + proper HTTP or if the `max_line_length` or `max_header_length` + limits are reached. If the `laxed` option is turned on and + `max_line_length` and `max_header_length` checks are turned off, + then no exception will be raised and this method will always + return a response code. + +- $n = $s->read\_entity\_body($buf, $size); + + Reads chunks of the entity body content. Basically the same interface + as for read() and sysread(), but the buffer offset argument is not + supported yet. This method should only be called after a successful + read\_response\_headers() call. + + The return value will be `undef` on read errors, 0 on EOF, -1 if no data + could be returned this time, otherwise the number of bytes assigned + to $buf. The $buf is set to "" when the return value is -1. + + You normally want to retry this call if this function returns either + \-1 or `undef` with `$!` as EINTR or EAGAIN (see [Errno](https://metacpan.org/pod/Errno)). EINTR + can happen if the application catches signals and EAGAIN can happen if + you made the socket non-blocking. + + This method will raise exceptions (die) if the server does not speak + proper HTTP. This can only happen when reading chunked data. + +- %headers = $s->get\_trailers + + After read\_entity\_body() has returned 0 to indicate end of the entity + body, you might call this method to pick up any trailers. + +- $s->\_rbuf + + Get/set the read buffer content. The read\_response\_headers() and + read\_entity\_body() methods use an internal buffer which they will look + for data before they actually sysread more from the socket itself. If + they read too much, the remaining data will be left in this buffer. + +- $s->\_rbuf\_length + + Returns the number of bytes in the read buffer. This should always be + the same as: + + length($s->_rbuf) + + but might be more efficient. + +# SUBCLASSING + +The read\_response\_headers() and read\_entity\_body() will invoke the +sysread() method when they need more data. Subclasses might want to +override this method to control how reading takes place. + +The object itself is a glob. Subclasses should avoid using hash key +names prefixed with `http_` and `io_`. + +# SEE ALSO + +[LWP](https://metacpan.org/pod/LWP), [IO::Socket::INET](https://metacpan.org/pod/IO::Socket::INET), [Net::HTTP::NB](https://metacpan.org/pod/Net::HTTP::NB) + +# AUTHOR + +Gisle Aas + +# COPYRIGHT AND LICENSE + +This software is copyright (c) 2001-2017 by Gisle Aas. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. diff --git a/cpanfile b/cpanfile new file mode 100644 index 00000000..9306626e --- /dev/null +++ b/cpanfile @@ -0,0 +1,30 @@ +requires "Carp" => "0"; +requires "Compress::Raw::Zlib" => "0"; +requires "IO::Socket::INET" => "0"; +requires "IO::Uncompress::Gunzip" => "0"; +requires "URI" => "0"; +requires "base" => "0"; +requires "perl" => "5.006002"; +requires "strict" => "0"; +requires "vars" => "0"; +requires "warnings" => "0"; +suggests "IO::Socket" => "0"; +suggests "IO::Socket::INET6" => "0"; +suggests "IO::Socket::IP" => "0"; +suggests "IO::Socket::SSL" => "1.38"; +suggests "Symbol" => "0"; + +on 'test' => sub { + requires "Data::Dumper" => "0"; + requires "IO::Select" => "0"; + requires "Socket" => "0"; + requires "Test::More" => "0"; +}; + +on 'configure' => sub { + requires "ExtUtils::MakeMaker" => "0"; +}; + +on 'configure' => sub { + suggests "JSON::PP" => "2.27300"; +}; diff --git a/dist.ini b/dist.ini new file mode 100644 index 00000000..b6517a84 --- /dev/null +++ b/dist.ini @@ -0,0 +1,40 @@ +name = Net-HTTP +author = Gisle Aas +license = Perl_5 +main_module = lib/Net/HTTP.pm +copyright_holder = Gisle Aas +copyright_year = 2001-2017 +version = 6.12 + +[MetaResources] +x_IRC = irc://irc.perl.org/#lwp +x_MailingList = mailto:libwww@perl.org + +[Prereqs] +perl = 5.006002 + +[@Author::OALDERS] +-remove = AutoPrereqs +-remove = CheckChangesHasContent +-remove = MinimumPerl +-remove = PodCoverageTests +-remove = Prereqs +-remove = Test::CPAN::Changes +-remove = Test::Perl::Critic +-remove = Test::PodSpelling +-remove = Test::Synopsis +-remove = Test::TidyAll + +[AutoPrereqs] +skip = Net::SSL + +[Prereqs / RuntimeSuggests] +IO::Socket::SSL = 1.38 + +[Prereqs::Soften] +to_relationship = suggests +module = IO::Socket +module = IO::Socket::INET6 +module = IO::Socket::IP +module = IO::Socket::SSL +module = Symbol diff --git a/lib/Net/HTTP.pm b/lib/Net/HTTP.pm index 613bc959..68b1f6e1 100644 --- a/lib/Net/HTTP.pm +++ b/lib/Net/HTTP.pm @@ -1,9 +1,9 @@ package Net::HTTP; use strict; -use vars qw($VERSION @ISA $SOCKET_CLASS); +use warnings; -$VERSION = "6.07"; +use vars qw($SOCKET_CLASS); unless ($SOCKET_CLASS) { # Try several, in order of capability and preference if (eval { require IO::Socket::IP }) { @@ -20,7 +20,7 @@ unless ($SOCKET_CLASS) { require Net::HTTP::Methods; require Carp; -@ISA = ($SOCKET_CLASS, 'Net::HTTP::Methods'); +our @ISA = ($SOCKET_CLASS, 'Net::HTTP::Methods'); sub new { my $class = shift; @@ -42,9 +42,7 @@ sub http_connect { __END__ -=head1 NAME - -Net::HTTP - Low-level HTTP connection (client) +# ABSTRACT: Low-level HTTP connection (client) =head1 SYNOPSIS @@ -95,7 +93,7 @@ C's as well as these: The C option is also the default for C's C. The C defaults to 80 if not provided. The C specification can also be embedded in the C -by preceding it with a ":", and closing the IPv6 address on bracktes "[]" if +by preceding it with a ":", and closing the IPv6 address on brackets "[]" if necessary: "192.0.2.1:80","[2001:db8::1]:80","any.example.com:80". The C option provided by C's constructor @@ -239,9 +237,9 @@ could be returned this time, otherwise the number of bytes assigned to $buf. The $buf is set to "" when the return value is -1. You normally want to retry this call if this function returns either --1 or C with C<$!> as EINTR or EAGAIN (see L). EINTR -can happen if the application catches signals and EAGAIN can happen if -you made the socket non-blocking. +-1 or C with C<$!> as EINTR or EWOULDBLOCK/EAGAIN (see L). +EINTR can happen if the application catches signals and EWOULDBLOCK/EAGAIN +can happen if you made the socket non-blocking. This method will raise exceptions (die) if the server does not speak proper HTTP. This can only happen when reading chunked data. @@ -282,11 +280,4 @@ names prefixed with C and C. L, L, L -=head1 COPYRIGHT - -Copyright 2001-2003 Gisle Aas. - -This library is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - =cut diff --git a/lib/Net/HTTP/Methods.pm b/lib/Net/HTTP/Methods.pm index 649f9af1..520e5d16 100644 --- a/lib/Net/HTTP/Methods.pm +++ b/lib/Net/HTTP/Methods.pm @@ -1,13 +1,9 @@ package Net::HTTP::Methods; -require 5.005; # 4-arg substr - use strict; -use vars qw($VERSION); +use warnings; use URI; -$VERSION = "6.07"; - my $CRLF = "\015\012"; # "\r\n" is not portable *_bytes = defined(&utf8::downgrade) ? @@ -265,20 +261,36 @@ sub my_readline { if $max_line_length && length($_) > $max_line_length; # need to read more data to find a line ending + my $new_bytes = 0; + READ: - { - die "read timeout" unless $self->can_read; - my $n = $self->sysread($_, 1024, length); - unless (defined $n) { - redo READ if $!{EINTR} || $!{EAGAIN}; - # if we have already accumulated some data let's at least - # return that as a line - die "$what read failed: $!" unless length; - } - unless ($n) { - return undef unless length; - return substr($_, 0, length, ""); + { # wait until bytes start arriving + $self->can_read + or die "read timeout"; + + # consume all incoming bytes + while(1) { + my $bytes_read = $self->sysread($_, 1024, length); + if(defined $bytes_read) { + $new_bytes += $bytes_read; + last if $bytes_read < 1024; + # We got exactly 1024 bytes, so we need to select() to know if there is more data + last unless $self->can_read(0); + } + elsif($!{EINTR} || $!{EAGAIN} || $!{EWOULDBLOCK}) { + redo READ; + } + else { + # if we have already accumulated some data let's at + # least return that as a line + length or die "$what read failed: $!"; + last; + } } + + # no line-ending, no new bytes + return length($_) ? substr($_, 0, length($_), "") : undef + if $new_bytes==0; } } die "$what line too long ($pos; limit is $max_line_length)" @@ -295,6 +307,7 @@ sub can_read { my $self = shift; return 1 unless defined(fileno($self)); return 1 if $self->isa('IO::Socket::SSL') && $self->pending; + return 1 if $self->isa('Net::SSL') && $self->can('pending') && $self->pending; # With no timeout, wait forever. An explicit timeout of 0 can be # used to just check if the socket is readable without waiting. @@ -308,8 +321,8 @@ sub can_read { $before = time if $timeout; my $nfound = select($fbits, undef, undef, $timeout); if ($nfound < 0) { - if ($!{EINTR} || $!{EAGAIN}) { - # don't really think EAGAIN can happen here + if ($!{EINTR} || $!{EWOULDBLOCK} || $!{EAGAIN}) { + # don't really think EWOULDBLOCK/EAGAIN can happen here if ($timeout) { $timeout -= time - $before; $timeout = 0 if $timeout < 0; diff --git a/lib/Net/HTTP/NB.pm b/lib/Net/HTTP/NB.pm index 3c465a8c..202d8364 100644 --- a/lib/Net/HTTP/NB.pm +++ b/lib/Net/HTTP/NB.pm @@ -1,12 +1,9 @@ package Net::HTTP::NB; use strict; -use vars qw($VERSION @ISA); +use warnings; -$VERSION = "6.04"; - -require Net::HTTP; -@ISA=qw(Net::HTTP); +use base 'Net::HTTP'; sub can_read { return 1; @@ -55,9 +52,7 @@ sub read_entity_body { __END__ -=head1 NAME - -Net::HTTP::NB - Non-blocking HTTP client +#ABSTRACT: Non-blocking HTTP client =head1 SYNOPSIS @@ -99,11 +94,4 @@ the value -1 is returned. L -=head1 COPYRIGHT - -Copyright 2001 Gisle Aas. - -This library is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - =cut diff --git a/lib/Net/HTTPS.pm b/lib/Net/HTTPS.pm index 87ecf485..d5fd2b5a 100644 --- a/lib/Net/HTTPS.pm +++ b/lib/Net/HTTPS.pm @@ -1,11 +1,10 @@ package Net::HTTPS; use strict; -use vars qw($VERSION $SSL_SOCKET_CLASS @ISA); - -$VERSION = "6.04"; +use warnings; # Figure out which SSL implementation to use +use vars qw($SSL_SOCKET_CLASS); if ($SSL_SOCKET_CLASS) { # somebody already set it } @@ -42,7 +41,7 @@ else { require Net::HTTP::Methods; -@ISA=($SSL_SOCKET_CLASS, 'Net::HTTP::Methods'); +our @ISA=($SSL_SOCKET_CLASS, 'Net::HTTP::Methods'); sub configure { my($self, $cnf) = @_; @@ -80,17 +79,16 @@ if ($SSL_SOCKET_CLASS eq "Net::SSL") { } 1; +__END__ -=head1 NAME - -Net::HTTPS - Low-level HTTP over SSL/TLS connection (client) +#ABSTRACT: Low-level HTTP over SSL/TLS connection (client) =head1 DESCRIPTION The C is a low-level HTTP over SSL/TLS client. The interface is the same -as the interface for C, but the constructor method take additional parameters -as accepted by L. The C object isa C -too, which make it inherit additional methods from that base class. +as the interface for C, but the constructor takes additional parameters +as accepted by L. The C object is an C +too, which makes it inherit additional methods from that base class. For historical reasons this module also supports using C (from the Crypt-SSLeay distribution) as its SSL driver and base class. This base is diff --git a/perlcriticrc b/perlcriticrc new file mode 100644 index 00000000..7819a28c --- /dev/null +++ b/perlcriticrc @@ -0,0 +1,86 @@ +severity = 3 +verbose = 11 + +theme = core + pbp + bugs + maintenance + cosmetic + complexity + security + tests + moose + +exclude = Subroutines::ProhibitCallsToUndeclaredSubs + +[BuiltinFunctions::ProhibitStringySplit] +severity = 3 + +[CodeLayout::RequireTrailingCommas] +severity = 3 + +[ControlStructures::ProhibitCStyleForLoops] +severity = 3 + +[InputOutput::RequireCheckedSyscalls] +functions = :builtins +exclude_functions = sleep +severity = 3 + +[Moose::RequireCleanNamespace] +modules = Moose Moose::Role MooseX::Role::Parameterized Moose::Util::TypeConstraints +cleaners = namespace::autoclean + +[NamingConventions::Capitalization] +package_exemptions = [A-Z]\w+|minFraud +file_lexical_variables = [A-Z]\w+|[^A-Z]+ +global_variables = :starts_with_upper +scoped_lexical_variables = [A-Z]\w+|[^A-Z]+ +severity = 3 + +# Given our code base, leaving this at 5 would be a huge pain +[Subroutines::ProhibitManyArgs] +max_arguments = 10 + +[RegularExpressions::ProhibitComplexRegexes] +max_characters = 200 + +[RegularExpressions::ProhibitUnusualDelimiters] +severity = 3 + +[Subroutines::ProhibitUnusedPrivateSubroutines] +private_name_regex = _(?!build)\w+ +skip_when_using = Moo::Role Moose::Role MooseX::Role::Parameterized Role::Tiny Test::Class::Moose::Role + +[TestingAndDebugging::ProhibitNoWarnings] +allow = redefine + +[ValuesAndExpressions::ProhibitEmptyQuotes] +severity = 3 + +[ValuesAndExpressions::ProhibitInterpolationOfLiterals] +severity = 3 + +[ValuesAndExpressions::RequireUpperCaseHeredocTerminator] +severity = 3 + +[Variables::ProhibitPackageVars] +add_packages = Test::Builder + +[TestingAndDebugging::RequireUseStrict] + +[TestingAndDebugging::RequireUseWarnings] + +[-ControlStructures::ProhibitCascadingIfElse] + +[-ErrorHandling::RequireCarping] +[-InputOutput::RequireBriefOpen] + +[-ValuesAndExpressions::ProhibitConstantPragma] + +# No need for /xsm everywhere +[-RegularExpressions::RequireDotMatchAnything] +[-RegularExpressions::RequireExtendedFormatting] +[-RegularExpressions::RequireLineBoundaryMatching] + +[-Subroutines::ProhibitExplicitReturnUndef] + +# http://stackoverflow.com/questions/2275317/why-does-perlcritic-dislike-using-shift-to-populate-subroutine-variables +[-Subroutines::RequireArgUnpacking] + +[-Subroutines::RequireFinalReturn] + +# "use v5.14" is more readable than "use 5.014" +[-ValuesAndExpressions::ProhibitVersionStrings] diff --git a/perltidyrc b/perltidyrc new file mode 100644 index 00000000..b7ed6247 --- /dev/null +++ b/perltidyrc @@ -0,0 +1,12 @@ +--blank-lines-before-packages=0 +--iterations=2 +--no-outdent-long-comments +-b +-bar +-boc +-ci=4 +-i=4 +-l=78 +-nolq +-se +-wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" diff --git a/t/apache-https.t b/t/apache-https.t deleted file mode 100644 index d7e54fd0..00000000 --- a/t/apache-https.t +++ /dev/null @@ -1,73 +0,0 @@ -#!perl -w - -BEGIN { - unless (-f "t/LIVE_TESTS" || -f "LIVE_TESTS") { - print "1..0 # SKIP Live tests disabled; pass --live-tests to Makefile.PL to enable\n"; - exit; - } - eval { - require IO::Socket::INET; - my $s = IO::Socket::INET->new( - PeerHost => "www.apache.org:443", - Timeout => 5, - ); - die "Can't connect: $@" unless $s; - }; - if ($@) { - print "1..0 # SKIP Can't connect to www.apache.org\n"; - print $@; - exit; - } - - unless (eval { require IO::Socket::SSL} || eval { require Net::SSL }) { - print "1..0 # SKIP IO::Socket::SSL or Net::SSL not available\n"; - print $@; - exit; - } -} - -use strict; -use Test; -plan tests => 8; - -use Net::HTTPS; - - -my $s = Net::HTTPS->new(Host => "www.apache.org", - KeepAlive => 1, - Timeout => 15, - PeerHTTPVersion => "1.1", - MaxLineLength => 512) || die "$@"; - -for (1..2) { - $s->write_request(TRACE => "/libwww-perl", - 'User-Agent' => 'Mozilla/5.0', - 'Accept-Language' => 'no,en', - Accept => '*/*'); - - my($code, $mess, %h) = $s->read_response_headers; - print "# ----------------------------\n"; - print "# $code $mess\n"; - for (sort keys %h) { - print "# $_: $h{$_}\n"; - } - print "#\n"; - - my $buf; - while (1) { - my $tmp; - my $n = $s->read_entity_body($tmp, 20); - last unless $n; - $buf .= $tmp; - } - $buf =~ s/\r//g; - (my $out = $buf) =~ s/^/# /gm; - print $out; - - ok($code, "200"); - ok($h{'Content-Type'}, "message/http"); - - ok($buf, qr/^TRACE \/libwww-perl HTTP\/1/); - ok($buf, qr/^User-Agent: Mozilla\/5.0$/m); -} - diff --git a/t/apache.t b/t/apache.t deleted file mode 100644 index 83f9faff..00000000 --- a/t/apache.t +++ /dev/null @@ -1,67 +0,0 @@ -#!perl -w - -BEGIN { - unless (-f "t/LIVE_TESTS" || -f "LIVE_TESTS") { - print "1..0 # SKIP Live tests disabled; pass --live-tests to Makefile.PL to enable\n"; - exit; - } - eval { - require IO::Socket::INET; - my $s = IO::Socket::INET->new( - PeerHost => "www.apache.org:80", - Timeout => 5, - ); - die "Can't connect: $@" unless $s; - }; - if ($@) { - print "1..0 # SKIP Can't connect to www.apache.org\n"; - print $@; - exit; - } -} - -use strict; -use Test; -plan tests => 8; - -use Net::HTTP; - - -my $s = Net::HTTP->new(Host => "www.apache.org", - KeepAlive => 1, - Timeout => 15, - PeerHTTPVersion => "1.1", - MaxLineLength => 512) || die "$@"; - -for (1..2) { - $s->write_request(TRACE => "/libwww-perl", - 'User-Agent' => 'Mozilla/5.0', - 'Accept-Language' => 'no,en', - Accept => '*/*'); - - my($code, $mess, %h) = $s->read_response_headers; - print "# ----------------------------\n"; - print "# $code $mess\n"; - for (sort keys %h) { - print "# $_: $h{$_}\n"; - } - print "#\n"; - - my $buf; - while (1) { - my $tmp; - my $n = $s->read_entity_body($tmp, 20); - last unless $n; - $buf .= $tmp; - } - $buf =~ s/\r//g; - (my $out = $buf) =~ s/^/# /gm; - print $out; - - ok($code, "200"); - ok($h{'Content-Type'}, "message/http"); - - ok($buf, qr/^TRACE \/libwww-perl HTTP\/1/); - ok($buf, qr/^User-Agent: Mozilla\/5.0$/m); -} - diff --git a/t/http-nb.t b/t/http-nb.t index d5c0341c..0c7b187c 100644 --- a/t/http-nb.t +++ b/t/http-nb.t @@ -1,6 +1,5 @@ -#!perl -w - use strict; +use warnings; use Test::More; plan skip_all => "This test doesn't work on Windows" if $^O eq "MSWin32"; diff --git a/t/http.t b/t/http.t index cc2e1d3b..358f15d5 100644 --- a/t/http.t +++ b/t/http.t @@ -1,7 +1,6 @@ -#!perl -w - use strict; -use Test; +use warnings; +use Test::More; plan tests => 37; #use Data::Dump (); @@ -11,9 +10,7 @@ my $LF = "\012"; { package HTTP; - use vars qw(@ISA); - require Net::HTTP::Methods; - @ISA=qw(Net::HTTP::Methods); + use base 'Net::HTTP::Methods'; my %servers = ( a => { "/" => "HTTP/1.0 200 OK${CRLF}Content-Type: text/plain${CRLF}Content-Length: 6${CRLF}${CRLF}Hello\n", @@ -121,84 +118,84 @@ $res = $h->request(GET => "/"); #Data::Dump::dump($res); -ok($res->{code}, 200); -ok($res->{content}, "Hello\n"); +is($res->{code}, 200); +is($res->{content}, "Hello\n"); $res = $h->request(GET => "/404"); -ok($res->{code}, 404); +is($res->{code}, 404); $res = $h->request(TRACE => "/foo"); -ok($res->{code}, 200); -ok($res->{content}, "TRACE /foo HTTP/1.1${CRLF}Keep-Alive: 300${CRLF}Connection: Keep-Alive${CRLF}Host: a${CRLF}${CRLF}"); +is($res->{code}, 200); +is($res->{content}, "TRACE /foo HTTP/1.1${CRLF}Keep-Alive: 300${CRLF}Connection: Keep-Alive${CRLF}Host: a${CRLF}${CRLF}"); # try to turn off keep alive $h->keep_alive(0); $res = $h->request(TRACE => "/foo"); -ok($res->{code}, "200"); -ok($res->{content}, "TRACE /foo HTTP/1.1${CRLF}Connection: close${CRLF}Host: a${CRLF}${CRLF}"); +is($res->{code}, "200"); +is($res->{content}, "TRACE /foo HTTP/1.1${CRLF}Connection: close${CRLF}Host: a${CRLF}${CRLF}"); # try a bad one # It's bad because 2nd 'HTTP/1.0 200' is illegal. But passes anyway if laxed => 1. $res = $h->request(GET => "/bad1", [], {laxed => 1}); -ok($res->{code}, "200"); -ok($res->{message}, "OK"); -ok("@{$res->{headers}}", "Server foo Content-type text/foo"); -ok($res->{content}, "abc\n"); +is($res->{code}, "200"); +is($res->{message}, "OK"); +is("@{$res->{headers}}", "Server foo Content-type text/foo"); +is($res->{content}, "abc\n"); $res = $h->request(GET => "/bad1"); -ok($res->{error} =~ /Bad header/); +like($res->{error}, qr/Bad header/); ok(!$res->{code}); $h = undef; # it is in a bad state now $h = HTTP->new("a") || die; # reconnect $res = $h->request(GET => "/09", [], {laxed => 1}); -ok($res->{code}, "200"); -ok($res->{message}, "Assumed OK"); -ok($res->{content}, "Hello${CRLF}World!${CRLF}"); -ok($h->peer_http_version, "0.9"); +is($res->{code}, "200"); +is($res->{message}, "Assumed OK"); +is($res->{content}, "Hello${CRLF}World!${CRLF}"); +is($h->peer_http_version, "0.9"); $res = $h->request(GET => "/09"); -ok($res->{error} =~ /^Bad response status line: 'Hello'/); +like($res->{error}, qr/^Bad response status line: 'Hello'/); $h = undef; # it's in a bad state again $h = HTTP->new(Host => "a", KeepAlive => 1, ReadChunkSize => 1) || die; # reconnect $res = $h->request(GET => "/chunked"); -ok($res->{code}, 200); -ok($res->{content}, "Hello"); -ok("@{$res->{headers}}", "Transfer-Encoding chunked Content-MD5 xxx"); +is($res->{code}, 200); +is($res->{content}, "Hello"); +is("@{$res->{headers}}", "Transfer-Encoding chunked Content-MD5 xxx"); # once more $res = $h->request(GET => "/chunked"); -ok($res->{code}, "200"); -ok($res->{content}, "Hello"); -ok("@{$res->{headers}}", "Transfer-Encoding chunked Content-MD5 xxx"); +is($res->{code}, "200"); +is($res->{content}, "Hello"); +is("@{$res->{headers}}", "Transfer-Encoding chunked Content-MD5 xxx"); # Test bogus headers. Chunked appearing twice is illegal, but happens anyway sometimes. [RT#77240] $res = $h->request(GET => "/chunked,chunked"); -ok($res->{code}, "200"); -ok($res->{content}, "Hello"); -ok("@{$res->{headers}}", "Transfer-Encoding chunked Transfer-Encoding chunked Content-MD5 xxx"); +is($res->{code}, "200"); +is($res->{content}, "Hello"); +is("@{$res->{headers}}", "Transfer-Encoding chunked Transfer-Encoding chunked Content-MD5 xxx"); # test head $res = $h->request(HEAD => "/head"); -ok($res->{code}, "200"); -ok($res->{content}, ""); -ok("@{$res->{headers}}", "Content-Length 16 Content-Type text/plain"); +is($res->{code}, "200"); +is($res->{content}, ""); +is("@{$res->{headers}}", "Content-Length 16 Content-Type text/plain"); $res = $h->request(GET => "/"); -ok($res->{code}, "200"); -ok($res->{content}, "Hello\n"); +is($res->{code}, "200"); +is($res->{content}, "Hello\n"); $h = HTTP->new(Host => undef, PeerAddr => "a", ); $h->http_version("1.0"); ok(!defined $h->host); $res = $h->request(TRACE => "/"); -ok($res->{code}, "200"); -ok($res->{content}, "TRACE / HTTP/1.0\r\n\r\n"); +is($res->{code}, "200"); +is($res->{content}, "TRACE / HTTP/1.0\r\n\r\n"); # check that headers with colons at the start of values don't break $res = $h->request(GET => '/colon-header'); -ok("@{$res->{headers}}", "Content-Type text/plain Content-Length 6 Bad-Header :foo"); +is("@{$res->{headers}}", "Content-Type text/plain Content-Length 6 Bad-Header :foo"); require Net::HTTP; eval { diff --git a/t/live-https.t b/t/live-https.t new file mode 100644 index 00000000..3482bbf4 --- /dev/null +++ b/t/live-https.t @@ -0,0 +1,74 @@ +BEGIN { + unless ( -f "t/LIVE_TESTS" || -f "LIVE_TESTS" ) { + print "1..0 # SKIP Live tests disabled; pass --live-tests to Makefile.PL to enable\n"; + exit; + } + eval { + require IO::Socket::INET; + my $s = IO::Socket::INET->new( + PeerHost => "www.google.com:443", + Timeout => 5, + ); + die "Can't connect: $@" unless $s; + }; + if ($@) { + print "1..0 # SKIP Can't connect to www.google.com:443\n"; + print $@; + exit; + } + + unless ( eval { require IO::Socket::SSL } || eval { require Net::SSL } ) { + print "1..0 # SKIP IO::Socket::SSL or Net::SSL not available\n"; + print $@; + exit; + } +} + +use strict; +use warnings; +use Test::More; +plan tests => 6; + +use Net::HTTPS; + +my $s = Net::HTTPS->new( + Host => "www.google.com", + KeepAlive => 1, + Timeout => 15, + PeerHTTPVersion => "1.1", + MaxLineLength => 512 +) || die "$@"; + +for ( 1 .. 2 ) { + $s->write_request( + GET => "/", + 'User-Agent' => 'Mozilla/5.0', + 'Accept-Language' => 'no,en', + Accept => '*/*' + ); + + my ( $code, $mess, %h ) = $s->read_response_headers; + print "# ----------------------------\n"; + print "# $code $mess\n"; + for ( sort keys %h ) { + print "# $_: $h{$_}\n"; + } + print "#\n"; + + my $buf; + while (1) { + my $tmp; + my $n = $s->read_entity_body( $tmp, 20 ); + last unless $n; + $buf .= $tmp; + } + $buf =~ s/\r//g; + + # ( my $out = $buf ) =~ s/^/# /gm; + # print $out; + + is( $code, "200" ); + like( $h{'Content-Type'}, qr{text/html} ); + like( $buf, qr{} ); +} + diff --git a/t/live.t b/t/live.t new file mode 100644 index 00000000..747515a9 --- /dev/null +++ b/t/live.t @@ -0,0 +1,68 @@ +BEGIN { + unless ( -f "t/LIVE_TESTS" || -f "LIVE_TESTS" ) { + print "1..0 # SKIP Live tests disabled; pass --live-tests to Makefile.PL to enable\n"; + exit; + } + eval { + require IO::Socket::INET; + my $s = IO::Socket::INET->new( + PeerHost => "www.google.com:80", + Timeout => 5, + ); + die "Can't connect: $@" unless $s; + }; + if ($@) { + print "1..0 # SKIP Can't connect to www.google.com\n"; + print $@; + exit; + } +} + +use strict; +use warnings; +use Test::More; +plan tests => 6; + +use Net::HTTP; + +my $s = Net::HTTP->new( + Host => "www.google.com", + KeepAlive => 1, + Timeout => 15, + PeerHTTPVersion => "1.1", + MaxLineLength => 512 +) || die "$@"; + +for ( 1 .. 2 ) { + $s->write_request( + GET => "/", + 'User-Agent' => 'Mozilla/5.0', + 'Accept-Language' => 'no,en', + Accept => '*/*' + ); + + my ( $code, $mess, %h ) = $s->read_response_headers; + print "# ----------------------------\n"; + print "# $code $mess\n"; + for ( sort keys %h ) { + print "# $_: $h{$_}\n"; + } + print "#\n"; + + my $buf; + while (1) { + my $tmp; + my $n = $s->read_entity_body( $tmp, 20 ); + last unless $n; + $buf .= $tmp; + } + $buf =~ s/\r//g; + + # ( my $out = $buf ) =~ s/^/# /gm; + # print $out; + + is( $code, "200" ); + like( $h{'Content-Type'}, qr{text/html} ); + like( $buf, qr{} ); +} + diff --git a/t/rt-112313.t b/t/rt-112313.t new file mode 100644 index 00000000..365d4988 --- /dev/null +++ b/t/rt-112313.t @@ -0,0 +1,95 @@ +use strict; +use warnings; +use Test::More; +use Net::HTTP; + +# Attempt to verify that RT#112313 (Hang in my_readline() when keep-alive => 1 and $reponse_size % 1024 == 0) is fixed + +# To do that, we need responses (headers + body) that are even multiples of 1024 bytes. So we +# iterate over the same URL, trying to grow the response size incrementally... + +# There's a chance this test won't work if, for example, the response body grows by one byte while +# the Content-Length also rolls over to one more digit, thus increasing the total response by two +# bytes. + +# So, we check that the reponse growth is only one byte after each iteration and also test multiple +# times across the 1024, 2048 and 3072 boundaries... + +unless (-f "t/LIVE_TESTS" || -f "LIVE_TESTS") +{ + print "1..0 # SKIP Live tests disabled; pass --live-tests to Makefile.PL to enable\n"; + exit; +} + +sub try +{ + my $n = shift; + + # Need a new socket every time because we're testing with Keep-Alive... + my $s = Net::HTTP->new( + Host => "httpbin.org", + KeepAlive => 1, + PeerHTTPVersion => "1.1", + ) or die "$@"; + + $s->write_request(GET => '/headers', + 'User-Agent' => "Net::HTTP - $0", + 'X-Foo' => ('x' x $n), + ); + + # Wait until all data is probably available on the socket... + sleep 1; + + my ($code, $mess, @headers) = $s->read_response_headers(); + + my $body = ''; + while ($s->read_entity_body(my $buf, 1024)) + { + $body .= $buf; + } + + # Compute what is probably the total response length... + my $total_len = length(join "\r\n", 'HTTP/1.1', "$code $mess", @headers, '', $body) - 1; + + # diag("$n - $code $mess => $total_len"); + # diag(join "\r\n", 'HTTP/1.1', "$code $mess", @headers, '', $body); + + $code == 200 + or die "$code $mess"; + + return $total_len; +} + +my $timeout = 15; +my $wiggle_room = 3; + +local $SIG{ALRM} = sub { die 'timeout' }; + +my $base_len = try(1); +ok($base_len < 1024, "base response length is less than 1024: $base_len"); + +for my $kb (1024, 2048, 3072) +{ + my $last; + + # Calculate range that will take us across the 1024 boundary... + for my $n (($kb - $base_len - $wiggle_room) .. ($kb - $base_len + $wiggle_room)) + { + my $len = -1; + + eval { + alarm $timeout; + $len = try($n); + }; + + ok(!$@, "ok for n $n -> response length $len") + or diag("error: $@"); + + # Verify that response length only increased by one since the whole test rests on that assumption... + is($len - $last, 1, 'reponse length increased by 1') if $last; + + $last = $len; + } +} + +done_testing(); diff --git a/tidyall.ini b/tidyall.ini new file mode 100644 index 00000000..67ea245d --- /dev/null +++ b/tidyall.ini @@ -0,0 +1,19 @@ +[PerlTidy] +select = **/*.{pl,pm,t,psgi} +ignore = t/00-* +ignore = t/author-* +ignore = t/release-* +ignore = blib/**/* +ignore = .build/**/* +ignore = Net-HTTP-*/**/* +argv = --profile=$ROOT/perltidyrc + +[PerlCritic] +select = **/*.{pl,pm,t,psgi} +ignore = t/00-* +ignore = t/author-* +ignore = t/release-* +ignore = blib/**/* +ignore = .build/**/* +ignore = Net-HTTP-*/**/* +argv = --profile $ROOT/perlcriticrc --program-extensions .pl --program-extensions .t --program-extensions .psgi