HTTP-CookieJar-0.012/000755 000766 000024 00000000000 14062342657 014403 5ustar00davidstaff000000 000000 HTTP-CookieJar-0.012/LICENSE000644 000766 000024 00000026354 14062342657 015422 0ustar00davidstaff000000 000000 This software is Copyright (c) 2013 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. HTTP-CookieJar-0.012/cpanfile000644 000766 000024 00000003366 14062342657 016117 0ustar00davidstaff000000 000000 # This file is generated by Dist::Zilla::Plugin::CPANFile v6.020 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "0"; requires "HTTP::Date" => "0"; requires "Time::Local" => "1.1901"; requires "parent" => "0"; requires "perl" => "5.008001"; requires "strict" => "0"; requires "warnings" => "0"; recommends "Mozilla::PublicSuffix" => "0"; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "Test::Deep" => "0"; requires "Test::More" => "0.96"; requires "Test::Requires" => "0"; requires "Time::Local" => "1.1901"; requires "URI" => "0"; requires "lib" => "0"; requires "perl" => "5.008001"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "6.17"; requires "perl" => "5.008001"; }; on 'develop' => sub { requires "Dist::Zilla" => "5"; requires "Dist::Zilla::Plugin::Prereqs" => "0"; requires "Dist::Zilla::Plugin::ReleaseStatus::FromVersion" => "0"; requires "Dist::Zilla::Plugin::RemovePrereqs" => "0"; requires "Dist::Zilla::PluginBundle::DAGOLDEN" => "0.072"; requires "File::Spec" => "0"; requires "File::Temp" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Pod::Coverage::TrustPod" => "0"; requires "Pod::Wordlist" => "0"; requires "Software::License::Apache_2_0" => "0"; requires "Test::CPAN::Meta" => "0"; requires "Test::MinimumVersion" => "0"; requires "Test::More" => "0"; requires "Test::Perl::Critic" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; requires "Test::Portability::Files" => "0"; requires "Test::Spelling" => "0.12"; requires "Test::Version" => "1"; }; HTTP-CookieJar-0.012/Changes000644 000766 000024 00000003436 14062342657 015704 0ustar00davidstaff000000 000000 Revision history for HTTP-CookieJar 0.012 2021-06-16 05:34:31-04:00 America/New_York - No changes from 0.011 0.011 2021-06-15 19:29:51-04:00 America/New_York (TRIAL RELEASE) [FIXED] - Pushed test cookie expiration dates from 2021 to 2041. If I'm still maintaining this module in 2041, I'll bump them again then. 0.010 2020-09-20 11:28:49-04:00 America/New_York - No changes from 0.009 0.009 2020-09-17 22:39:16-04:00 America/New_York (TRIAL RELEASE) [FIXED] - Fixed handling of edge case where Max-Age == 0 0.008 2015-11-06 22:48:19-05:00 America/New_York [PREREQS] - Dropped minimum Perl requirement to 5.8.1 0.007 2015-08-21 13:57:31-04:00 America/New_York [PREREQS] - Dropped Time::Mock dependency to allow building on Windows [META] - Modernized repo layout for newest DAGOLDEN Dist::Zilla bundle 0.006 2014-02-19 19:52:00-05:00 America/New_York [FIXED] - Fixed file encoding of test files [CHANGED] - Updated distribution repo URL and other meta files - Tidied test files 0.005 2013-08-03 21:41:10 America/New_York [FIXED] - Fixed test failure under hash randomization 0.004 2013-04-23 22:24:25 America/New_York [REMOVED] - Removed test dependency on HTTP::Request/Response; The LWP adapter test will only be run if they are already available 0.003 2013-03-07 17:49:40 America/New_York [FIXED] - Another attempt to avoid test failures on older, 32-bit Perls 0.002 2013-03-07 06:12:04 America/New_York [FIXED] - Won't warn about undefined value for length on empty cookie on old Perls - Requires Time::Local 1.1901 to fix Y2038 bug on old Perls 0.001 2013-02-13 16:41:24 America/New_York - First release HTTP-CookieJar-0.012/MANIFEST000644 000766 000024 00000001135 14062342657 015534 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.020. CONTRIBUTING.mkdn Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile dist.ini lib/HTTP/CookieJar.pm lib/HTTP/CookieJar/LWP.pm perlcritic.rc t/00-report-prereqs.dd t/00-report-prereqs.t t/add.t t/examples.t t/lib/MockTime.pm t/parse.t t/publicsuffix.t t/save.t t/sort.t t/zzz-lwp.t tidyall.ini xt/author/00-compile.t xt/author/critic.t xt/author/distmeta.t xt/author/minimum-version.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/portability.t xt/author/test-version.t HTTP-CookieJar-0.012/perlcritic.rc000644 000766 000024 00000001166 14062342657 017075 0ustar00davidstaff000000 000000 severity = 5 verbose = 8 [Variables::ProhibitPunctuationVars] allow = $@ $! [TestingAndDebugging::ProhibitNoStrict] allow = refs [Variables::ProhibitEvilVariables] variables = $DB::single # Turn these off [-BuiltinFunctions::ProhibitStringyEval] [-ControlStructures::ProhibitPostfixControls] [-ControlStructures::ProhibitUnlessBlocks] [-Documentation::RequirePodSections] [-InputOutput::ProhibitInteractiveTest] [-References::ProhibitDoubleSigils] [-RegularExpressions::RequireExtendedFormatting] [-InputOutput::ProhibitTwoArgOpen] [-Modules::ProhibitEvilModules] # Turn this on [Lax::ProhibitStringyEval::ExceptForRequire] HTTP-CookieJar-0.012/CONTRIBUTING.mkdn000644 000766 000024 00000006604 14062342657 017173 0ustar00davidstaff000000 000000 ## HOW TO CONTRIBUTE Thank you for considering contributing to this distribution. This file contains instructions that will help you work with the source code. The distribution is managed with Dist::Zilla. This means that many of the usual files you might expect are not in the repository, but are generated at release time, as is much of the documentation. Some generated files are kept in the repository as a convenience (e.g. Makefile.PL or cpanfile). Generally, **you do not need Dist::Zilla to contribute patches**. You do need Dist::Zilla to create a tarball. See below for guidance. ### Getting dependencies If you have App::cpanminus 1.6 or later installed, you can use `cpanm` to satisfy dependencies like this: $ cpanm --installdeps . Otherwise, look for either a `Makefile.PL` or `cpanfile` file for a list of dependencies to satisfy. ### Running tests You can run tests directly using the `prove` tool: $ prove -l $ prove -lv t/some_test_file.t For most of my distributions, `prove` is entirely sufficient for you to test any patches you have. I use `prove` for 99% of my testing during development. ### Code style and tidying Please try to match any existing coding style. If there is a `.perltidyrc` file, please install Perl::Tidy and use perltidy before submitting patches. If there is a `tidyall.ini` file, you can also install Code::TidyAll and run `tidyall` on a file or `tidyall -a` to tidy all files. ### Patching documentation Much of the documentation Pod is generated at release time. Some is generated boilerplate; other documentation is built from pseudo-POD directives in the source like C<=method> or C<=func>. If you would like to submit a documentation edit, please limit yourself to the documentation you see. If you see typos or documentation issues in the generated docs, please email or open a bug ticket instead of patching. ### Where to send patches and pull requests If you found this distribution on Github, sending a pull-request is the best way to contribute. If a pull-request isn't possible, a bug ticket with a patch file is the next best option. As a last resort, an email to the author(s) is acceptable. ## Installing and using Dist::Zilla Dist::Zilla is not required for contributing, but if you'd like to learn more, this section will get you up to speed. Dist::Zilla is a very powerful authoring tool, optimized for maintaining a large number of distributions with a high degree of automation, but it has a large dependency chain, a bit of a learning curve and requires a number of author-specific plugins. To install it from CPAN, I recommend one of the following approaches for the quickest installation: # using CPAN.pm, but bypassing non-functional pod tests $ cpan TAP::Harness::Restricted $ PERL_MM_USE_DEFAULT=1 HARNESS_CLASS=TAP::Harness::Restricted cpan Dist::Zilla # using cpanm, bypassing *all* tests $ cpanm -n Dist::Zilla In either case, it's probably going to take about 10 minutes. Go for a walk, go get a cup of your favorite beverage, take a bathroom break, or whatever. When you get back, Dist::Zilla should be ready for you. Then you need to install any plugins specific to this distribution: $ cpan `dzil authordeps` $ dzil authordeps | cpanm Once installed, here are some dzil commands you might try: $ dzil build $ dzil test $ dzil xtest You can learn more about Dist::Zilla at http://dzil.org/ HTTP-CookieJar-0.012/t/000755 000766 000024 00000000000 14062342657 014646 5ustar00davidstaff000000 000000 HTTP-CookieJar-0.012/xt/000755 000766 000024 00000000000 14062342657 015036 5ustar00davidstaff000000 000000 HTTP-CookieJar-0.012/README000644 000766 000024 00000014633 14062342657 015272 0ustar00davidstaff000000 000000 NAME HTTP::CookieJar - A minimalist HTTP user agent cookie jar VERSION version 0.012 SYNOPSIS use HTTP::CookieJar; my $jar = HTTP::CookieJar->new; # add cookie received from a request $jar->add( "http://www.example.com/", "CUSTOMER=WILE_E_COYOTE; Path=/; Domain=example.com" ); # extract cookie header for a given request my $cookie = $jar->cookie_header( "http://www.example.com/" ); DESCRIPTION This module implements a minimalist HTTP user agent cookie jar in conformance with RFC 6265 . Unlike the commonly used HTTP::Cookies module, this module does not require use of HTTP::Request and HTTP::Response objects. An LWP-compatible adapter is available as HTTP::CookieJar::LWP. CONSTRUCTORS new my $jar = HTTP::CookieJar->new; Return a new, empty cookie jar METHODS add $jar->add( "http://www.example.com/", "lang=en-US; Path=/; Domain=example.com" ); Given a request URL and a "Set-Cookie" header string, attempts to adds the cookie to the jar. If the cookie is expired, instead it deletes any matching cookie from the jar. A "Max-Age" attribute will be converted to an absolute "Expires" attribute. It will throw an exception if the request URL is missing or invalid. Returns true if successful cookie processing or undef/empty-list on failure. clear $jar->clear Empties the cookie jar. cookies_for my @cookies = $jar->cookies_for("http://www.example.com/foo/bar"); Given a request URL, returns a list of hash references representing cookies that should be sent. The hash references are copies -- changing values will not change the cookies in the jar. Cookies set "secure" will only be returned if the request scheme is "https". Expired cookies will not be returned. Keys of a cookie hash reference might include: * name -- the name of the cookie * value -- the value of the cookie * domain -- the domain name to which the cookie applies * path -- the path to which the cookie applies * expires -- if present, when the cookie expires in epoch seconds * secure -- if present, the cookie was set "Secure" * httponly -- if present, the cookie was set "HttpOnly" * hostonly -- if present, the cookie may only be used with the domain as a host * creation_time -- epoch seconds since the cookie was first stored * last_access_time -- epoch seconds since the cookie was last stored Keep in mind that "httponly" means it should only be used in requests and not made available via Javascript, etc. This is pretty meaningless for Perl user agents. Generally, user agents should use the "cookie_header" method instead. It will throw an exception if the request URL is missing or invalid. cookie_header my $header = $jar->cookie_header("http://www.example.com/foo/bar"); Given a request URL, returns a correctly-formatted string with all relevant cookies for the request. This string is ready to be used in a "Cookie" header in an HTTP request. E.g.: SID=31d4d96e407aad42; lang=en-US It follows the same exclusion rules as "cookies_for". If the request is invalid or no cookies apply, it will return an empty string. dump_cookies my @list = $jar->dump_cookies; my @list = $jar->dump_cookies( { persistent => 1 } ); Returns a list of raw cookies in string form. The strings resemble what would be received from "Set-Cookie" headers, but with additional internal fields. The list is only intended for use with "load_cookies" to allow cookie jar persistence. If a hash reference with a true "persistent" key is given as an argument, cookies without an "Expires" time (i.e. "session cookies") will be omitted. Here is a trivial example of saving a cookie jar file with Path::Tiny: path("jar.txt")->spew( join "\n", $jar->dump_cookies ); load_cookies $jar->load_cookies( @cookies ); Given a list of cookie strings from "dump_cookies", it adds them to the cookie jar. Cookies added in this way will supersede any existing cookies with similar domain, path and name. It returns the jar object for convenience when loading a new object: my $jar = HTTP::CookieJar->new->load_cookies( @cookies ); Here is a trivial example of loading a cookie jar file with Path::Tiny: my $jar = HTTP::CookieJar->new->load_cookies( path("jar.txt")->lines ); LIMITATIONS AND CAVEATS RFC 6265 vs prior standards This modules adheres as closely as possible to the user-agent rules of RFC 6265. Therefore, it does not handle nor generate "Set-Cookie2" and "Cookie2" headers, implement ".local" suffixes, or do path/domain matching in accord with prior RFC's. Internationalized domain names Internationalized domain names given in requests must be properly encoded in ASCII form. Public suffixes If Mozilla::PublicSuffix is installed, cookie domains will be checked against the public suffix list. Public suffix cookies are only allowed as host-only cookies. Third-party cookies According to RFC 6265, a cookie may be accepted only if has no "Domain" attribute (in which case it is "host-only") or if the "Domain" attribute is a suffix of the request URL. This effectively prohibits Site A from setting a cookie for unrelated Site B, which is one potential third-party cookie vector. SEE ALSO * HTTP::Cookies * Mojo::UserAgent::CookieJar SUPPORT Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at . You will be notified automatically of any progress on your issue. Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. git clone https://github.com/dagolden/HTTP-CookieJar.git AUTHOR David Golden CONTRIBUTORS * Dan Book * David Golden * jvolkening COPYRIGHT AND LICENSE This software is Copyright (c) 2013 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 HTTP-CookieJar-0.012/META.yml000644 000766 000024 00000002676 14062342657 015667 0ustar00davidstaff000000 000000 --- abstract: 'A minimalist HTTP user agent cookie jar' author: - 'David Golden ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' Test::Deep: '0' Test::More: '0.96' Test::Requires: '0' Time::Local: '1.1901' URI: '0' lib: '0' perl: '5.008001' configure_requires: ExtUtils::MakeMaker: '6.17' perl: '5.008001' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.020, CPAN::Meta::Converter version 2.150010' license: apache meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: HTTP-CookieJar no_index: directory: - corpus - examples - t - xt package: - DB provides: HTTP::CookieJar: file: lib/HTTP/CookieJar.pm version: '0.012' HTTP::CookieJar::LWP: file: lib/HTTP/CookieJar/LWP.pm version: '0.012' recommends: Mozilla::PublicSuffix: '0' requires: Carp: '0' HTTP::Date: '0' Time::Local: '1.1901' parent: '0' perl: '5.008001' strict: '0' warnings: '0' resources: bugtracker: https://github.com/dagolden/HTTP-CookieJar/issues homepage: https://github.com/dagolden/HTTP-CookieJar repository: https://github.com/dagolden/HTTP-CookieJar.git version: '0.012' x_authority: cpan:DAGOLDEN x_contributors: - 'Dan Book ' - 'David Golden ' - 'jvolkening ' x_generated_by_perl: v5.34.0 x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: Apache-2.0 HTTP-CookieJar-0.012/tidyall.ini000644 000766 000024 00000000240 14062342657 016542 0ustar00davidstaff000000 000000 ; Install Code::TidyAll ; run "tidyall -a" to tidy all files ; run "tidyall -g" to tidy only files modified from git [PerlTidy] select = {lib,t}/**/*.{pl,pm,t} HTTP-CookieJar-0.012/lib/000755 000766 000024 00000000000 14062342657 015151 5ustar00davidstaff000000 000000 HTTP-CookieJar-0.012/Makefile.PL000644 000766 000024 00000003042 14062342657 016354 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.020. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker 6.17; my %WriteMakefileArgs = ( "ABSTRACT" => "A minimalist HTTP user agent cookie jar", "AUTHOR" => "David Golden ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.17" }, "DISTNAME" => "HTTP-CookieJar", "LICENSE" => "apache", "MIN_PERL_VERSION" => "5.008001", "NAME" => "HTTP::CookieJar", "PREREQ_PM" => { "Carp" => 0, "HTTP::Date" => 0, "Time::Local" => "1.1901", "parent" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Test::Deep" => 0, "Test::More" => "0.96", "Test::Requires" => 0, "Time::Local" => "1.1901", "URI" => 0, "lib" => 0 }, "VERSION" => "0.012", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "HTTP::Date" => 0, "Test::Deep" => 0, "Test::More" => "0.96", "Test::Requires" => 0, "Time::Local" => "1.1901", "URI" => 0, "lib" => 0, "parent" => 0, "strict" => 0, "warnings" => 0 ); 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); HTTP-CookieJar-0.012/META.json000644 000766 000024 00000006633 14062342657 016034 0ustar00davidstaff000000 000000 { "abstract" : "A minimalist HTTP user agent cookie jar", "author" : [ "David Golden " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.020, CPAN::Meta::Converter version 2.150010", "license" : [ "apache_2_0" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "HTTP-CookieJar", "no_index" : { "directory" : [ "corpus", "examples", "t", "xt" ], "package" : [ "DB" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17", "perl" : "5.008001" } }, "develop" : { "requires" : { "Dist::Zilla" : "5", "Dist::Zilla::Plugin::Prereqs" : "0", "Dist::Zilla::Plugin::ReleaseStatus::FromVersion" : "0", "Dist::Zilla::Plugin::RemovePrereqs" : "0", "Dist::Zilla::PluginBundle::DAGOLDEN" : "0.072", "File::Spec" : "0", "File::Temp" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Pod::Coverage::TrustPod" : "0", "Pod::Wordlist" : "0", "Software::License::Apache_2_0" : "0", "Test::CPAN::Meta" : "0", "Test::MinimumVersion" : "0", "Test::More" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Portability::Files" : "0", "Test::Spelling" : "0.12", "Test::Version" : "1" } }, "runtime" : { "recommends" : { "Mozilla::PublicSuffix" : "0" }, "requires" : { "Carp" : "0", "HTTP::Date" : "0", "Time::Local" : "1.1901", "parent" : "0", "perl" : "5.008001", "strict" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "Test::Deep" : "0", "Test::More" : "0.96", "Test::Requires" : "0", "Time::Local" : "1.1901", "URI" : "0", "lib" : "0", "perl" : "5.008001" } } }, "provides" : { "HTTP::CookieJar" : { "file" : "lib/HTTP/CookieJar.pm", "version" : "0.012" }, "HTTP::CookieJar::LWP" : { "file" : "lib/HTTP/CookieJar/LWP.pm", "version" : "0.012" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/dagolden/HTTP-CookieJar/issues" }, "homepage" : "https://github.com/dagolden/HTTP-CookieJar", "repository" : { "type" : "git", "url" : "https://github.com/dagolden/HTTP-CookieJar.git", "web" : "https://github.com/dagolden/HTTP-CookieJar" } }, "version" : "0.012", "x_authority" : "cpan:DAGOLDEN", "x_contributors" : [ "Dan Book ", "David Golden ", "jvolkening " ], "x_generated_by_perl" : "v5.34.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.26", "x_spdx_expression" : "Apache-2.0" } HTTP-CookieJar-0.012/dist.ini000644 000766 000024 00000000737 14062342657 016056 0ustar00davidstaff000000 000000 name = HTTP-CookieJar author = David Golden license = Apache_2_0 copyright_holder = David Golden copyright_year = 2013 [@DAGOLDEN] :version = 0.072 stopwords = Javascript stopwords = RFC's stopwords = hostonly stopwords = httponly [ReleaseStatus::FromVersion] testing = third_decimal_odd [Prereqs] ; fixes Y2038 bug on older Perls Time::Local = 1.1901 [RemovePrereqs] remove = Mozilla::PublicSuffix [Prereqs / Recommends] Mozilla::PublicSuffix = 0 HTTP-CookieJar-0.012/lib/HTTP/000755 000766 000024 00000000000 14062342657 015730 5ustar00davidstaff000000 000000 HTTP-CookieJar-0.012/lib/HTTP/CookieJar/000755 000766 000024 00000000000 14062342657 017576 5ustar00davidstaff000000 000000 HTTP-CookieJar-0.012/lib/HTTP/CookieJar.pm000644 000766 000024 00000045201 14062342657 020136 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; package HTTP::CookieJar; # ABSTRACT: A minimalist HTTP user agent cookie jar our $VERSION = '0.012'; use Carp (); use HTTP::Date (); my $HAS_MPS = eval { require Mozilla::PublicSuffix; 1 }; #pod =construct new #pod #pod my $jar = HTTP::CookieJar->new; #pod #pod Return a new, empty cookie jar #pod #pod =cut sub new { my ($class) = @_; bless { store => {} }, $class; } #pod =method add #pod #pod $jar->add( #pod "http://www.example.com/", "lang=en-US; Path=/; Domain=example.com" #pod ); #pod #pod Given a request URL and a C header string, attempts to adds the #pod cookie to the jar. If the cookie is expired, instead it deletes any matching #pod cookie from the jar. A C attribute will be converted to an absolute #pod C attribute. #pod #pod It will throw an exception if the request URL is missing or invalid. Returns true if #pod successful cookie processing or undef/empty-list on failure. #pod #pod =cut sub add { my ( $self, $request, $cookie ) = @_; return unless defined $cookie and length $cookie; my ( $scheme, $host, $port, $request_path ) = eval { _split_url($request) }; Carp::croak($@) if $@; return unless my $parse = _parse_cookie($cookie); my $name = $parse->{name}; # check and normalize domain if ( exists $parse->{domain} ) { _normalize_domain( $host, $parse ) or return; } else { $parse->{domain} = $host; $parse->{hostonly} = 1; } my $domain = $parse->{domain}; # normalize path if ( !exists $parse->{path} || substr( $parse->{path}, 0, 1 ) ne "/" ) { $parse->{path} = _default_path($request_path); } my $path = $parse->{path}; # set timestamps and normalize expires my $now = $parse->{creation_time} = $parse->{last_access_time} = time; if ( exists $parse->{'max-age'} ) { # "If delta-seconds is less than or equal to zero (0), let expiry-time # be the earliest representable date and time." $parse->{expires} = $parse->{'max-age'} <= 0 ? 0 : $now + $parse->{'max-age'}; delete $parse->{'max-age'}; } # update creation time from old cookie, if exists if ( my $old = $self->{store}{$domain}{$path}{$name} ) { $parse->{creation_time} = $old->{creation_time}; } # if cookie has expired, purge any old matching cookie, too if ( defined $parse->{expires} && $parse->{expires} < $now ) { delete $self->{store}{$domain}{$path}{$name}; } else { $self->{store}{$domain}{$path}{$name} = $parse; } return 1; } #pod =method clear #pod #pod $jar->clear #pod #pod Empties the cookie jar. #pod #pod =cut sub clear { my ($self) = @_; $self->{store} = {}; return 1; } #pod =method cookies_for #pod #pod my @cookies = $jar->cookies_for("http://www.example.com/foo/bar"); #pod #pod Given a request URL, returns a list of hash references representing cookies #pod that should be sent. The hash references are copies -- changing values #pod will not change the cookies in the jar. #pod #pod Cookies set C will only be returned if the request scheme is C. #pod Expired cookies will not be returned. #pod #pod Keys of a cookie hash reference might include: #pod #pod =for :list #pod * name -- the name of the cookie #pod * value -- the value of the cookie #pod * domain -- the domain name to which the cookie applies #pod * path -- the path to which the cookie applies #pod * expires -- if present, when the cookie expires in epoch seconds #pod * secure -- if present, the cookie was set C #pod * httponly -- if present, the cookie was set C #pod * hostonly -- if present, the cookie may only be used with the domain as a host #pod * creation_time -- epoch seconds since the cookie was first stored #pod * last_access_time -- epoch seconds since the cookie was last stored #pod #pod Keep in mind that C means it should only be used in requests and not #pod made available via Javascript, etc. This is pretty meaningless for Perl user #pod agents. #pod #pod Generally, user agents should use the C method instead. #pod #pod It will throw an exception if the request URL is missing or invalid. #pod #pod =cut sub cookies_for { my ( $self, $request ) = @_; my ( $scheme, $host, $port, $request_path ) = eval { _split_url($request) }; Carp::croak($@) if $@; my @found; my $now = time; for my $cookie ( $self->_all_cookies ) { next if $cookie->{hostonly} && $host ne $cookie->{domain}; next if $cookie->{secure} && $scheme ne 'https'; next if defined( $cookie->{expires} ) && $cookie->{expires} < $now; next unless _domain_match( $host, $cookie->{domain} ); next unless _path_match( $request_path, $cookie->{path} ); push @found, $cookie; } @found = sort { length( $b->{path} ) <=> length( $a->{path} ) || $a->{creation_time} <=> $b->{creation_time} } @found; return @found; } #pod =method cookie_header #pod #pod my $header = $jar->cookie_header("http://www.example.com/foo/bar"); #pod #pod Given a request URL, returns a correctly-formatted string with all relevant #pod cookies for the request. This string is ready to be used in a C header #pod in an HTTP request. E.g.: #pod #pod SID=31d4d96e407aad42; lang=en-US #pod #pod It follows the same exclusion rules as C. #pod #pod If the request is invalid or no cookies apply, it will return an empty string. #pod #pod =cut sub cookie_header { my ( $self, $req ) = @_; return join( "; ", map { "$_->{name}=$_->{value}" } $self->cookies_for($req) ); } #pod =method dump_cookies #pod #pod my @list = $jar->dump_cookies; #pod my @list = $jar->dump_cookies( { persistent => 1 } ); #pod #pod Returns a list of raw cookies in string form. The strings resemble what #pod would be received from C headers, but with additional internal #pod fields. The list is only intended for use with C to allow #pod cookie jar persistence. #pod #pod If a hash reference with a true C key is given as an argument, #pod cookies without an C time (i.e. "session cookies") will be omitted. #pod #pod Here is a trivial example of saving a cookie jar file with L: #pod #pod path("jar.txt")->spew( join "\n", $jar->dump_cookies ); #pod #pod =cut sub dump_cookies { my ( $self, $args ) = @_; my @list; for my $c ( $self->_all_cookies ) { my @parts = "$c->{name}=$c->{value}"; if ( defined $c->{expires} ) { push @parts, 'Expires=' . HTTP::Date::time2str( $c->{expires} ); } else { next if $args->{persistent}; } for my $attr (qw/Domain Path Creation_Time Last_Access_Time/) { push @parts, "$attr=$c->{lc $attr}" if defined $c->{ lc $attr }; } for my $attr (qw/Secure HttpOnly HostOnly/) { push @parts, $attr if $c->{ lc $attr }; } push @list, join( "; ", @parts ); } return @list; } #pod =method load_cookies #pod #pod $jar->load_cookies( @cookies ); #pod #pod Given a list of cookie strings from C, it adds them to #pod the cookie jar. Cookies added in this way will supersede any existing #pod cookies with similar domain, path and name. #pod #pod It returns the jar object for convenience when loading a new object: #pod #pod my $jar = HTTP::CookieJar->new->load_cookies( @cookies ); #pod #pod Here is a trivial example of loading a cookie jar file with L: #pod #pod my $jar = HTTP::CookieJar->new->load_cookies( #pod path("jar.txt")->lines #pod ); #pod #pod =cut sub load_cookies { my ( $self, @cookies ) = @_; for my $cookie (@cookies) { my $p = _parse_cookie( $cookie, 1 ); next unless exists $p->{domain} && exists $p->{path}; $p->{$_} = time for grep { !defined $p->{$_} } qw/creation_time last_access_time/; $self->{store}{ $p->{domain} }{ $p->{path} }{ $p->{name} } = $p; } return $self; } #--------------------------------------------------------------------------# # private methods #--------------------------------------------------------------------------# # return a copy of all cookies sub _all_cookies { return map { { %$_ } } map { values %$_ } map { values %$_ } values %{ $_[0]->{store} }; } #--------------------------------------------------------------------------# # Helper subroutines #--------------------------------------------------------------------------# my $pub_re = qr/(?:domain|path|expires|max-age|httponly|secure)/; my $pvt_re = qr/(?:$pub_re|creation_time|last_access_time|hostonly)/; sub _parse_cookie { my ( $cookie, $private ) = @_; $cookie = '' unless defined $cookie; my ( $kvp, @attrs ) = split /;/, $cookie; $kvp = '' unless defined $kvp; my ( $name, $value ) = map { s/^\s*//; s/\s*$//; $_ } split( /=/, $kvp, 2 ); ## no critic return unless defined $name and length $name; $value = '' unless defined $value; my $parse = { name => $name, value => $value }; for my $s (@attrs) { next unless defined $s && $s =~ /\S/; my ( $k, $v ) = map { s/^\s*//; s/\s*$//; $_ } split( /=/, $s, 2 ); ## no critic $k = lc $k; next unless $private ? ( $k =~ m/^$pvt_re$/ ) : ( $k =~ m/^$pub_re$/ ); $v = 1 if $k =~ m/^(?:httponly|secure|hostonly)$/; # boolean flag if present $v = HTTP::Date::str2time($v) || 0 if $k eq 'expires'; # convert to epoch next unless length $v; $v =~ s{^\.}{} if $k eq 'domain'; # strip leading dot $v =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if $k eq 'path'; # unescape $parse->{$k} = $v; } return $parse; } sub _domain_match { my ( $string, $dom_string ) = @_; return 1 if $dom_string eq $string; return unless $string =~ /[a-z]/i; # non-numeric if ( $string =~ s{\Q$dom_string\E$}{} ) { return substr( $string, -1, 1 ) eq '.'; # "foo." } return; } sub _normalize_domain { my ( $host, $parse ) = @_; if ($HAS_MPS) { my $host_pub_suff = eval { Mozilla::PublicSuffix::public_suffix($host) }; $host_pub_suff = '' unless defined $host_pub_suff; if ( _domain_match( $host_pub_suff, $parse->{domain} ) ) { if ( $parse->{domain} eq $host ) { return $parse->{hostonly} = 1; } else { return; } } } if ( $parse->{domain} !~ m{\.} && $parse->{domain} eq $host ) { return $parse->{hostonly} = 1; } return _domain_match( $host, $parse->{domain} ); } sub _default_path { my ($path) = @_; return "/" if !length $path || substr( $path, 0, 1 ) ne "/"; my ($default) = $path =~ m{^(.*)/}; # greedy to last / return length($default) ? $default : "/"; } sub _path_match { my ( $req_path, $cookie_path ) = @_; return 1 if $req_path eq $cookie_path; if ( $req_path =~ m{^\Q$cookie_path\E(.*)} ) { my $rest = $1; return 1 if substr( $cookie_path, -1, 1 ) eq '/'; return 1 if substr( $rest, 0, 1 ) eq '/'; } return; } sub _split_url { my $url = shift; die(qq/No URL provided\n/) unless defined $url and length $url; # URI regex adapted from the URI module # XXX path_query here really chops at ? or # to get just the path and not the query my ( $scheme, $authority, $path_query ) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#?]*)> or die(qq/Cannot parse URL: '$url'\n/); $scheme = lc $scheme; $path_query = "/$path_query" unless $path_query =~ m<\A/>; $path_query =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; my $host = ( length($authority) ) ? lc $authority : 'localhost'; $host =~ s/\A[^@]*@//; # userinfo my $port = do { $host =~ s/:([0-9]*)\z// && length $1 ? $1 : ( $scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef ); }; return ( $scheme, $host, $port, $path_query ); } 1; # vim: ts=4 sts=4 sw=4 et: __END__ =pod =encoding UTF-8 =head1 NAME HTTP::CookieJar - A minimalist HTTP user agent cookie jar =head1 VERSION version 0.012 =head1 SYNOPSIS use HTTP::CookieJar; my $jar = HTTP::CookieJar->new; # add cookie received from a request $jar->add( "http://www.example.com/", "CUSTOMER=WILE_E_COYOTE; Path=/; Domain=example.com" ); # extract cookie header for a given request my $cookie = $jar->cookie_header( "http://www.example.com/" ); =head1 DESCRIPTION This module implements a minimalist HTTP user agent cookie jar in conformance with L. Unlike the commonly used L module, this module does not require use of L and L objects. An LWP-compatible adapter is available as L. =head1 CONSTRUCTORS =head2 new my $jar = HTTP::CookieJar->new; Return a new, empty cookie jar =head1 METHODS =head2 add $jar->add( "http://www.example.com/", "lang=en-US; Path=/; Domain=example.com" ); Given a request URL and a C header string, attempts to adds the cookie to the jar. If the cookie is expired, instead it deletes any matching cookie from the jar. A C attribute will be converted to an absolute C attribute. It will throw an exception if the request URL is missing or invalid. Returns true if successful cookie processing or undef/empty-list on failure. =head2 clear $jar->clear Empties the cookie jar. =head2 cookies_for my @cookies = $jar->cookies_for("http://www.example.com/foo/bar"); Given a request URL, returns a list of hash references representing cookies that should be sent. The hash references are copies -- changing values will not change the cookies in the jar. Cookies set C will only be returned if the request scheme is C. Expired cookies will not be returned. Keys of a cookie hash reference might include: =over 4 =item * name -- the name of the cookie =item * value -- the value of the cookie =item * domain -- the domain name to which the cookie applies =item * path -- the path to which the cookie applies =item * expires -- if present, when the cookie expires in epoch seconds =item * secure -- if present, the cookie was set C =item * httponly -- if present, the cookie was set C =item * hostonly -- if present, the cookie may only be used with the domain as a host =item * creation_time -- epoch seconds since the cookie was first stored =item * last_access_time -- epoch seconds since the cookie was last stored =back Keep in mind that C means it should only be used in requests and not made available via Javascript, etc. This is pretty meaningless for Perl user agents. Generally, user agents should use the C method instead. It will throw an exception if the request URL is missing or invalid. =head2 cookie_header my $header = $jar->cookie_header("http://www.example.com/foo/bar"); Given a request URL, returns a correctly-formatted string with all relevant cookies for the request. This string is ready to be used in a C header in an HTTP request. E.g.: SID=31d4d96e407aad42; lang=en-US It follows the same exclusion rules as C. If the request is invalid or no cookies apply, it will return an empty string. =head2 dump_cookies my @list = $jar->dump_cookies; my @list = $jar->dump_cookies( { persistent => 1 } ); Returns a list of raw cookies in string form. The strings resemble what would be received from C headers, but with additional internal fields. The list is only intended for use with C to allow cookie jar persistence. If a hash reference with a true C key is given as an argument, cookies without an C time (i.e. "session cookies") will be omitted. Here is a trivial example of saving a cookie jar file with L: path("jar.txt")->spew( join "\n", $jar->dump_cookies ); =head2 load_cookies $jar->load_cookies( @cookies ); Given a list of cookie strings from C, it adds them to the cookie jar. Cookies added in this way will supersede any existing cookies with similar domain, path and name. It returns the jar object for convenience when loading a new object: my $jar = HTTP::CookieJar->new->load_cookies( @cookies ); Here is a trivial example of loading a cookie jar file with L: my $jar = HTTP::CookieJar->new->load_cookies( path("jar.txt")->lines ); =for Pod::Coverage method_names_here =head1 LIMITATIONS AND CAVEATS =head2 RFC 6265 vs prior standards This modules adheres as closely as possible to the user-agent rules of RFC 6265. Therefore, it does not handle nor generate C and C headers, implement C<.local> suffixes, or do path/domain matching in accord with prior RFC's. =head2 Internationalized domain names Internationalized domain names given in requests must be properly encoded in ASCII form. =head2 Public suffixes If L is installed, cookie domains will be checked against the public suffix list. Public suffix cookies are only allowed as host-only cookies. =head2 Third-party cookies According to RFC 6265, a cookie may be accepted only if has no C attribute (in which case it is "host-only") or if the C attribute is a suffix of the request URL. This effectively prohibits Site A from setting a cookie for unrelated Site B, which is one potential third-party cookie vector. =head1 SEE ALSO =over 4 =item * L =item * L =back =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. L git clone https://github.com/dagolden/HTTP-CookieJar.git =head1 AUTHOR David Golden =head1 CONTRIBUTORS =for stopwords Dan Book David Golden jvolkening =over 4 =item * Dan Book =item * David Golden =item * jvolkening =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2013 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut HTTP-CookieJar-0.012/lib/HTTP/CookieJar/LWP.pm000644 000766 000024 00000005053 14062342657 020601 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; package HTTP::CookieJar::LWP; # ABSTRACT: LWP adapter for HTTP::CookieJar our $VERSION = '0.012'; use parent 'HTTP::CookieJar'; sub add_cookie_header { my ( $self, $request ) = @_; my $url = _get_url( $request, $request->uri ); return unless ( $url->scheme =~ /^https?\z/ ); my $header = $self->cookie_header($url); $request->header( Cookie => $header ); return $request; } sub extract_cookies { my ( $self, $response ) = @_; my $request = $response->request or return; my $url = _get_url( $request, $request->uri ); $self->add( $url, $_ ) for $response->_header("Set-Cookie"); return $response; } #--------------------------------------------------------------------------# # helper subroutines #--------------------------------------------------------------------------# sub _get_url { my ( $request, $url ) = @_; my $new_url = $url->clone; if ( my $h = $request->header("Host") ) { $h =~ s/:\d+$//; # might have a port as well $new_url->host($h); } return $new_url; } sub _url_path { my $url = shift; my $path; if ( $url->can('epath') ) { $path = $url->epath; # URI::URL method } else { $path = $url->path; # URI::_generic method } $path = "/" unless length $path; $path; } sub _normalize_path # so that plain string compare can be used { my $x; $_[0] =~ s/%([0-9a-fA-F][0-9a-fA-F])/ $x = uc($1); $x eq "2F" || $x eq "25" ? "%$x" : pack("C", hex($x)); /eg; $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg; } 1; # vim: ts=4 sts=4 sw=4 et: __END__ =pod =encoding UTF-8 =head1 NAME HTTP::CookieJar::LWP - LWP adapter for HTTP::CookieJar =head1 VERSION version 0.012 =head1 SYNOPSIS use LWP::UserAgent; use HTTP::CookieJar::LWP; my $ua = LWP::UserAgent->new( cookie_jar => HTTP::CookieJar::LWP->new ); =head1 DESCRIPTION This module is an experimental adapter to make L work with L. It implements the two methods that C calls from L. It is not a general-purpose drop-in replacement for C in any other way. =for Pod::Coverage method_names_here add_cookie_header extract_cookies =head1 AUTHOR David Golden =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2013 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut HTTP-CookieJar-0.012/xt/author/000755 000766 000024 00000000000 14062342657 016340 5ustar00davidstaff000000 000000 HTTP-CookieJar-0.012/xt/author/critic.t000644 000766 000024 00000000201 14062342657 017773 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; use Test::Perl::Critic (-profile => "perlcritic.rc") x!! -e "perlcritic.rc"; all_critic_ok(); HTTP-CookieJar-0.012/xt/author/minimum-version.t000644 000766 000024 00000000152 14062342657 021661 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; use Test::MinimumVersion; all_minimum_version_ok( qq{5.010} ); HTTP-CookieJar-0.012/xt/author/test-version.t000644 000766 000024 00000000637 14062342657 021175 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 0, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; HTTP-CookieJar-0.012/xt/author/00-compile.t000644 000766 000024 00000002720 14062342657 020373 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More; plan tests => 3; my @module_files = ( 'HTTP/CookieJar.pm', 'HTTP/CookieJar/LWP.pm' ); # fake home for cpan-testers use File::Temp; local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ); HTTP-CookieJar-0.012/xt/author/pod-syntax.t000644 000766 000024 00000000252 14062342657 020632 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); HTTP-CookieJar-0.012/xt/author/portability.t000644 000766 000024 00000000322 14062342657 021064 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; eval 'use Test::Portability::Files'; plan skip_all => 'Test::Portability::Files required for testing portability' if $@; options(test_one_dot => 0); run_tests(); HTTP-CookieJar-0.012/xt/author/distmeta.t000644 000766 000024 00000000172 14062342657 020337 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::MetaTests. use Test::CPAN::Meta; meta_yaml_ok(); HTTP-CookieJar-0.012/xt/author/pod-spell.t000644 000766 000024 00000000527 14062342657 020430 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007005 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ Book CookieJar Dan David Golden HTTP Javascript LWP RFC's dagolden grinnz hostonly httponly jdv jvolkening lib xdg HTTP-CookieJar-0.012/xt/author/pod-coverage.t000644 000766 000024 00000000334 14062342657 021100 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); HTTP-CookieJar-0.012/t/save.t000644 000766 000024 00000004171 14062342657 015774 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::Deep '!blessed'; use HTTP::CookieJar; my $jar = HTTP::CookieJar->new; my $jar2; my @cookies = ( 'SID=31d4d96e407aad42; Path=/; Secure; HttpOnly', ); my @persistent = ( 'lang=en_US; Path=/; Domain=example.com; Secure; HttpOnly; Max-Age = 3600', ); subtest "empty cookie jar" => sub { my $jar = HTTP::CookieJar->new; my @list = $jar->dump_cookies; is( scalar @list, 0, "dumped zero cookies" ); ok( my $jar2 = HTTP::CookieJar->new->load_cookies(@list), "load new cookie jar" ); is( scalar $jar2->dump_cookies, 0, "second jar is empty" ); }; subtest "roundtrip" => sub { my $jar = HTTP::CookieJar->new; $jar->add( "http://www.example.com/", $_ ) for @cookies, @persistent; my @list = $jar->dump_cookies; is( scalar @list, @cookies + @persistent, "dumped correct number of cookies" ); ok( my $jar2 = HTTP::CookieJar->new->load_cookies(@list), "load new cookie jar" ); is( scalar $jar2->dump_cookies, @cookies + @persistent, "second jar has correct count" ); cmp_deeply( $jar, $jar2, "old and new jars are the same" ) or diag explain [ $jar, $jar2 ]; }; subtest "persistent" => sub { my $jar = HTTP::CookieJar->new; $jar->add( "http://www.example.com/", $_ ) for @cookies, @persistent; my @list = $jar->dump_cookies( { persistent => 1 } ); is( scalar @list, @cookies, "dumped correct number of cookies" ); ok( my $jar2 = HTTP::CookieJar->new->load_cookies(@list), "load new cookie jar" ); is( scalar $jar2->dump_cookies, @cookies, "second jar has correct count" ); }; # can load raw cookies with both path and domain subtest "liberal load" => sub { my $jar = HTTP::CookieJar->new; ok( $jar->load_cookies( @persistent, @cookies ), "load_cookies with raw cookies" ); is( scalar $jar->dump_cookies, @persistent, "jar has correct count" ); }; done_testing; # # This file is part of HTTP-CookieJar # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # # vim: ts=4 sts=4 sw=4 et: HTTP-CookieJar-0.012/t/add.t000644 000766 000024 00000021162 14062342657 015565 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::Deep '!blessed'; use HTTP::CookieJar; my @cases = ( { label => "no cookies", request => "http://example.com/", cookies => [], store => {}, }, { label => "simple key=value", request => "http://example.com/", cookies => ["SID=31d4d96e407aad42"], store => { 'example.com' => { '/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "example.com", hostonly => 1, path => "/", } } }, }, }, { label => "invalid cookie not stored", request => "http://example.com/", cookies => [";"], store => {}, }, { label => "localhost treated as host only", request => "http://localhost/", cookies => ["SID=31d4d96e407aad42; Domain=localhost"], store => { 'localhost' => { '/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "localhost", hostonly => 1, path => "/", } } }, }, }, { label => "single domain level treated as host only", request => "http://foobar/", cookies => ["SID=31d4d96e407aad42; Domain=foobar"], store => { 'foobar' => { '/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "foobar", hostonly => 1, path => "/", } } }, }, }, { label => "different domain not stored", request => "http://example.com/", cookies => ["SID=31d4d96e407aad42; Domain=example.org"], store => {}, }, { label => "subdomain not stored", request => "http://example.com/", cookies => ["SID=31d4d96e407aad42; Domain=www.example.com"], store => {}, }, { label => "superdomain stored", request => "http://www.example.com/", cookies => ["SID=31d4d96e407aad42; Domain=example.com"], store => { 'example.com' => { '/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "example.com", path => "/", } } }, }, }, { label => "path prefix /foo/ stored", request => "http://www.example.com/foo/bar", cookies => ["SID=31d4d96e407aad42; Path=/foo/"], store => { 'www.example.com' => { '/foo/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "www.example.com", hostonly => 1, path => "/foo/", } } }, }, }, { label => "path prefix /foo stored", request => "http://www.example.com/foo/bar", cookies => ["SID=31d4d96e407aad42; Path=/foo"], store => { 'www.example.com' => { '/foo' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "www.example.com", hostonly => 1, path => "/foo", } } }, }, }, { label => "last cookie wins", request => "http://example.com/", cookies => [ "SID=31d4d96e407aad42", "SID=0000000000000000", ], store => { 'example.com' => { '/' => { SID => { name => "SID", value => "0000000000000000", creation_time => ignore(), last_access_time => ignore(), domain => "example.com", hostonly => 1, path => "/", } } }, }, }, { label => "expired supercedes prior", request => "http://example.com/", cookies => [ "SID=31d4d96e407aad42", "SID=0000000000000000; Max-Age=-60", ], store => { 'example.com' => { '/' => {}, }, }, }, { label => "separated by path", request => "http://example.com/foo/bar", cookies => [ "SID=31d4d96e407aad42; Path=/", "SID=0000000000000000", ], store => { 'example.com' => { '/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "example.com", hostonly => 1, path => "/", } }, '/foo' => { SID => { name => "SID", value => "0000000000000000", creation_time => ignore(), last_access_time => ignore(), domain => "example.com", hostonly => 1, path => "/foo", } } }, }, }, # check that Max-Age supercedes Expires and that Max-Age <= 0 forces # expiration { label => "max-age supercedes expires", request => "http://example.com/", cookies => [ "lang=en-us; Max-Age=100; Expires=Thu, 1 Jan 1970 00:00:00 GMT", "SID=0000000000000000; Expires=Thu, 3 Jan 4841 00:00:00 GMT", "SID=31d4d96e407aad42; Max-Age=0; Expires=Thu, 3 Jan 4841 00:00:00 GMT", "FOO=0000000000000000; Max-Age=-100; Expires=Thu, 3 Jan 4841 00:00:00 GMT", ], store => { 'example.com' => { '/' => { lang => { name => "lang", value => "en-us", expires => ignore(), creation_time => ignore(), last_access_time => ignore(), domain => "example.com", hostonly => 1, path => "/", }, }, }, }, }, ); for my $c (@cases) { my $jar = HTTP::CookieJar->new; for my $cookie ( @{ $c->{cookies} } ) { $jar->add( $c->{request}, $cookie ); } cmp_deeply $jar->{store}, $c->{store}, $c->{label} or diag explain $jar->{store}; } done_testing; # # This file is part of HTTP-CookieJar # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # HTTP-CookieJar-0.012/t/parse.t000644 000766 000024 00000005216 14062342657 016151 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::Deep '!blessed'; use HTTP::CookieJar; my @cases = ( { cookie => "", parse => undef, }, { cookie => "SID=", parse => { name => "SID", value => "", } }, { cookie => "=31d4d96e407aad42", parse => undef, }, { cookie => "; Max-Age: 1360343635", parse => undef, }, { cookie => "SID=31d4d96e407aad42", parse => { name => "SID", value => "31d4d96e407aad42", } }, { cookie => "SID=ID=31d4d96e407aad42", parse => { name => "SID", value => "ID=31d4d96e407aad42", } }, { cookie => "SID=31d4d96e407aad42 ; ; ; ", parse => { name => "SID", value => "31d4d96e407aad42", } }, { cookie => "SID=31d4d96e407aad42; Path=/; Secure; HttpOnly", parse => { name => "SID", value => "31d4d96e407aad42", path => "/", secure => 1, httponly => 1, } }, { cookie => "SID=31d4d96e407aad42; Domain=.example.com", parse => { name => "SID", value => "31d4d96e407aad42", domain => "example.com", } }, { cookie => "SID=31d4d96e407aad42; Path=/; Domain=example.com", parse => { name => "SID", value => "31d4d96e407aad42", path => "/", domain => "example.com", } }, { cookie => "SID=31d4d96e407aad42; Path=/; Domain=", parse => { name => "SID", value => "31d4d96e407aad42", path => "/", } }, { cookie => "lang=en-US; Expires = Sun, 09 Jun 2041 10:18:14 GMT", parse => { name => "lang", value => "en-US", expires => 2254385894, } }, { cookie => "lang=en-US; Expires = Sun, 09 Jun 2041 10:18:14 GMT; Max-Age=3600", parse => { name => "lang", value => "en-US", expires => 2254385894, 'max-age' => 3600, } }, ); for my $c (@cases) { my $got = HTTP::CookieJar::_parse_cookie( $c->{cookie} ); cmp_deeply $got, $c->{parse}, $c->{cookie} || q{''}; } done_testing; # # This file is part of HTTP-CookieJar # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # HTTP-CookieJar-0.012/t/00-report-prereqs.t000644 000766 000024 00000013452 14062342657 020247 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.028 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass('Reported prereqs'); # vim: ts=4 sts=4 sw=4 et: HTTP-CookieJar-0.012/t/lib/000755 000766 000024 00000000000 14062342657 015414 5ustar00davidstaff000000 000000 HTTP-CookieJar-0.012/t/00-report-prereqs.dd000644 000766 000024 00000006336 14062342657 020376 0ustar00davidstaff000000 000000 do { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '6.17', 'perl' => '5.008001' } }, 'develop' => { 'requires' => { 'Dist::Zilla' => '5', 'Dist::Zilla::Plugin::Prereqs' => '0', 'Dist::Zilla::Plugin::ReleaseStatus::FromVersion' => '0', 'Dist::Zilla::Plugin::RemovePrereqs' => '0', 'Dist::Zilla::PluginBundle::DAGOLDEN' => '0.072', 'File::Spec' => '0', 'File::Temp' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Pod::Coverage::TrustPod' => '0', 'Pod::Wordlist' => '0', 'Software::License::Apache_2_0' => '0', 'Test::CPAN::Meta' => '0', 'Test::MinimumVersion' => '0', 'Test::More' => '0', 'Test::Perl::Critic' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Portability::Files' => '0', 'Test::Spelling' => '0.12', 'Test::Version' => '1' } }, 'runtime' => { 'recommends' => { 'Mozilla::PublicSuffix' => '0' }, 'requires' => { 'Carp' => '0', 'HTTP::Date' => '0', 'Time::Local' => '1.1901', 'parent' => '0', 'perl' => '5.008001', 'strict' => '0', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'Test::Deep' => '0', 'Test::More' => '0.96', 'Test::Requires' => '0', 'Time::Local' => '1.1901', 'URI' => '0', 'lib' => '0', 'perl' => '5.008001' } } }; $x; }HTTP-CookieJar-0.012/t/sort.t000644 000766 000024 00000002744 14062342657 016031 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::Deep '!blessed'; use lib 't/lib'; use MockTime; use HTTP::CookieJar; my @cases = ( { label => "path length", request => "http://example.com/foo/bar/", cookies => [ [ "http://example.com/foo/bar/", "SID=2; Path=/" ], [ "http://example.com/foo/bar/", "SID=1; Path=/foo" ], [ "http://example.com/foo/bar/", "SID=0; Path=/foo/bar" ], ], }, { label => "creation time", request => "http://foo.bar.baz.example.com/", cookies => [ [ "http://foo.bar.baz.example.com/", "SID=0; Path=/; Domain=bar.baz.example.com" ], [ "http://foo.bar.baz.example.com/", "SID=1; Path=/; Domain=baz.example.com" ], [ "http://foo.bar.baz.example.com/", "SID=2; Path=/; Domain=example.com" ], ], }, ); for my $c (@cases) { my $jar = HTTP::CookieJar->new; my $offset = 0; for my $cookie ( @{ $c->{cookies} } ) { MockTime->offset($offset); $jar->add(@$cookie); $offset += 10; } my @cookies = $jar->cookies_for( $c->{request} ); my @vals = map { $_->{value} } @cookies; cmp_deeply \@vals, [ 0 .. $#vals ], $c->{label} or diag explain \@cookies; } done_testing; # # This file is part of HTTP-CookieJar # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # HTTP-CookieJar-0.012/t/examples.t000644 000766 000024 00000002737 14062342657 016662 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use HTTP::CookieJar; my $req = "http://www.example.com/foo/bar"; my $sreq = "https://www.example.com/foo/bar"; my $jar = new_ok("HTTP::CookieJar"); subtest "just key & value" => sub { $jar->clear; $jar->add( $req, "SID=31d4d96e407aad42" ); is( $jar->cookie_header($req), "SID=31d4d96e407aad42" ); }; subtest "secure" => sub { $jar->clear; $jar->add( $req, "SID=31d4d96e407aad42; Secure" ); $jar->add( $req, "lang=en-US; Path=/; Domain=example.com" ); is( $jar->cookie_header($sreq), "SID=31d4d96e407aad42; lang=en-US" ); is( $jar->cookie_header($req), "lang=en-US" ); }; subtest "not a subdomain" => sub { $jar->clear; $jar->add( $req, "SID=31d4d96e407aad42" ); is( $jar->cookie_header("http://wwww.example.com/foo/baz"), "" ); }; subtest "wrong path" => sub { $jar->clear; $jar->add( $req, "SID=31d4d96e407aad42" ); is( $jar->cookie_header("http://www.example.com/"), "" ); }; subtest "expiration" => sub { $jar->clear; $jar->add( $req, "lang=en-US; Expires=Sun, 09 Jun 2041 10:18:14 GMT" ); is( $jar->cookie_header($req), "lang=en-US" ); $jar->add( $req, "lang=; Expires=Sun, 06 Nov 1994 08:49:37 GMT" ); is( $jar->cookie_header($req), "" ); }; done_testing; # # This file is part of HTTP-CookieJar # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # HTTP-CookieJar-0.012/t/zzz-lwp.t000644 000766 000024 00000053450 14062342657 016477 0ustar00davidstaff000000 000000 use 5.008001; use warnings; use Test::More 0.96; use Time::Local; use HTTP::CookieJar::LWP; use Test::Requires qw( HTTP::Request HTTP::Response ); #------------------------------------------------------------------- # First we check that it works for the original example at # http://curl.haxx.se/rfc/cookie_spec.html # Client requests a document, and receives in the response: # # Set-Cookie: CUSTOMER=WILE_E_COYOTE; path=/; expires=Wednesday, 09-Nov-99 23:12:40 GMT # # When client requests a URL in path "/" on this server, it sends: # # Cookie: CUSTOMER=WILE_E_COYOTE # # Client requests a document, and receives in the response: # # Set-Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001; path=/ # # When client requests a URL in path "/" on this server, it sends: # # Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001 # # Client receives: # # Set-Cookie: SHIPPING=FEDEX; path=/fo # # When client requests a URL in path "/" on this server, it sends: # # Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001 # # When client requests a URL in path "/foo" on this server, it sends: # # Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001; SHIPPING=FEDEX # # The last Cookie is buggy, because both specifications says that the # most specific cookie must be sent first. SHIPPING=FEDEX is the # most specific and should thus be first. my $year_plus_one = (localtime)[5] + 1900 + 1; $c = HTTP::CookieJar::LWP->new; $req = HTTP::Request->new( GET => "http://1.1.1.1/" ); $req->header( "Host", "www.acme.com:80" ); $res = HTTP::Response->new( 200, "OK" ); $res->request($req); $res->header( "Set-Cookie" => "CUSTOMER=WILE_E_COYOTE; path=/ ; expires=Wednesday, 09-Nov-$year_plus_one 23:12:40 GMT" ); #; $c->extract_cookies($res); $req = HTTP::Request->new( GET => "http://www.acme.com/" ); $c->add_cookie_header($req); is( $req->header("Cookie"), "CUSTOMER=WILE_E_COYOTE" ) or diag explain $c; $res->request($req); $res->header( "Set-Cookie" => "PART_NUMBER=ROCKET_LAUNCHER_0001; path=/" ); $c->extract_cookies($res); $req = HTTP::Request->new( GET => "http://www.acme.com/foo/bar" ); $c->add_cookie_header($req); $h = $req->header("Cookie"); ok( $h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/ ); ok( $h =~ /CUSTOMER=WILE_E_COYOTE/ ); $res->request($req); $res->header( "Set-Cookie", "SHIPPING=FEDEX; path=/foo" ); $c->extract_cookies($res); $req = HTTP::Request->new( GET => "http://www.acme.com/" ); $c->add_cookie_header($req); $h = $req->header("Cookie"); ok( $h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/ ); ok( $h =~ /CUSTOMER=WILE_E_COYOTE/ ); ok( $h !~ /SHIPPING=FEDEX/ ); $req = HTTP::Request->new( GET => "http://www.acme.com/foo/" ); $c->add_cookie_header($req); $h = $req->header("Cookie"); ok( $h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/ ); ok( $h =~ /CUSTOMER=WILE_E_COYOTE/ ); ok( $h =~ /^SHIPPING=FEDEX;/ ); # Second Example transaction sequence: # # Assume all mappings from above have been cleared. # # Client receives: # # Set-Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001; path=/ # # When client requests a URL in path "/" on this server, it sends: # # Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001 # # Client receives: # # Set-Cookie: PART_NUMBER=RIDING_ROCKET_0023; path=/ammo # # When client requests a URL in path "/ammo" on this server, it sends: # # Cookie: PART_NUMBER=RIDING_ROCKET_0023; PART_NUMBER=ROCKET_LAUNCHER_0001 # # NOTE: There are two name/value pairs named "PART_NUMBER" due to # the inheritance of the "/" mapping in addition to the "/ammo" mapping. $c = HTTP::CookieJar::LWP->new; # clear it $req = HTTP::Request->new( GET => "http://www.acme.com/" ); $res = HTTP::Response->new( 200, "OK" ); $res->request($req); $res->header( "Set-Cookie", "PART_NUMBER=ROCKET_LAUNCHER_0001; path=/" ); $c->extract_cookies($res); $req = HTTP::Request->new( GET => "http://www.acme.com/" ); $c->add_cookie_header($req); is( $req->header("Cookie"), "PART_NUMBER=ROCKET_LAUNCHER_0001" ); $res->request($req); $res->header( "Set-Cookie", "PART_NUMBER=RIDING_ROCKET_0023; path=/ammo" ); $c->extract_cookies($res); $req = HTTP::Request->new( GET => "http://www.acme.com/ammo" ); $c->add_cookie_header($req); ok( $req->header("Cookie") =~ /^PART_NUMBER=RIDING_ROCKET_0023;\s*PART_NUMBER=ROCKET_LAUNCHER_0001/ ); undef($c); #------------------------------------------------------------------- # When there are no "Set-Cookie" header, then even responses # without any request URLs connected should be allowed. $c = HTTP::CookieJar::LWP->new; $c->extract_cookies( HTTP::Response->new( "200", "OK" ) ); is( count_cookies($c), 0 ); #------------------------------------------------------------------- # Then we test with the examples from RFC 2965. # # 5. EXAMPLES # XXX BUT CONVERT THEM FROM COOKIE2 TO REGULAR COOKIE --xdg $c = HTTP::CookieJar::LWP->new; # # 5.1 Example 1 # # Most detail of request and response headers has been omitted. Assume # the user agent has no stored cookies. # # 1. User Agent -> Server # # POST /acme/login HTTP/1.1 # [form data] # # User identifies self via a form. # # 2. Server -> User Agent # # HTTP/1.1 200 OK # Set-Cookie2: Customer="WILE_E_COYOTE"; Version="1"; Path="/acme" # # Cookie reflects user's identity. $cookie = interact( $c, 'http://www.acme.com/acme/login', 'Customer=WILE_E_COYOTE; Path=/acme' ); ok( !$cookie ); # # 3. User Agent -> Server # # POST /acme/pickitem HTTP/1.1 # Cookie: $Version="1"; Customer="WILE_E_COYOTE"; $Path="/acme" # [form data] # # User selects an item for ``shopping basket.'' # # 4. Server -> User Agent # # HTTP/1.1 200 OK # Set-Cookie2: Part_Number="Rocket_Launcher_0001"; Version="1"; # Path="/acme" # # Shopping basket contains an item. $cookie = interact( $c, 'http://www.acme.com/acme/pickitem', 'Part_Number=Rocket_Launcher_0001; Path=/acme' ); is( $cookie, "Customer=WILE_E_COYOTE" ); # # 5. User Agent -> Server # # POST /acme/shipping HTTP/1.1 # Cookie: $Version="1"; # Customer="WILE_E_COYOTE"; $Path="/acme"; # Part_Number="Rocket_Launcher_0001"; $Path="/acme" # [form data] # # User selects shipping method from form. # # 6. Server -> User Agent # # HTTP/1.1 200 OK # Set-Cookie2: Shipping="FedEx"; Version="1"; Path="/acme" # # New cookie reflects shipping method. $cookie = interact( $c, "http://www.acme.com/acme/shipping", 'Shipping=FedEx; Path=/acme' ); like( $cookie, qr/Part_Number=Rocket_Launcher_0001/ ); like( $cookie, qr/Customer=WILE_E_COYOTE/ ); # # 7. User Agent -> Server # # POST /acme/process HTTP/1.1 # Cookie: $Version="1"; # Customer="WILE_E_COYOTE"; $Path="/acme"; # Part_Number="Rocket_Launcher_0001"; $Path="/acme"; # Shipping="FedEx"; $Path="/acme" # [form data] # # User chooses to process order. # # 8. Server -> User Agent # # HTTP/1.1 200 OK # # Transaction is complete. $cookie = interact( $c, "http://www.acme.com/acme/process" ); like( $cookie, qr/Shipping=FedEx/ ); like( $cookie, qr/WILE_E_COYOTE/ ); # # The user agent makes a series of requests on the origin server, after # each of which it receives a new cookie. All the cookies have the same # Path attribute and (default) domain. Because the request URLs all have # /acme as a prefix, and that matches the Path attribute, each request # contains all the cookies received so far. ##; # 5.2 Example 2 # # This example illustrates the effect of the Path attribute. All detail # of request and response headers has been omitted. Assume the user agent # has no stored cookies. $c = HTTP::CookieJar::LWP->new; # Imagine the user agent has received, in response to earlier requests, # the response headers # # Set-Cookie2: Part_Number="Rocket_Launcher_0001"; Version="1"; # Path="/acme" # # and # # Set-Cookie2: Part_Number="Riding_Rocket_0023"; Version="1"; # Path="/acme/ammo" interact( $c, "http://www.acme.com/acme/ammo/specific", 'Part_Number=Rocket_Launcher_0001; Path=/acme', 'Part_Number=Riding_Rocket_0023; Path=/acme/ammo' ); # A subsequent request by the user agent to the (same) server for URLs of # the form /acme/ammo/... would include the following request header: # # Cookie: $Version="1"; # Part_Number="Riding_Rocket_0023"; $Path="/acme/ammo"; # Part_Number="Rocket_Launcher_0001"; $Path="/acme" # # Note that the NAME=VALUE pair for the cookie with the more specific Path # attribute, /acme/ammo, comes before the one with the less specific Path # attribute, /acme. Further note that the same cookie name appears more # than once. $cookie = interact( $c, "http://www.acme.com/acme/ammo/..." ); like( $cookie, qr/Riding_Rocket_0023.*Rocket_Launcher_0001/ ); # A subsequent request by the user agent to the (same) server for a URL of # the form /acme/parts/ would include the following request header: # # Cookie: $Version="1"; Part_Number="Rocket_Launcher_0001"; $Path="/acme" # # Here, the second cookie's Path attribute /acme/ammo is not a prefix of # the request URL, /acme/parts/, so the cookie does not get forwarded to # the server. $cookie = interact( $c, "http://www.acme.com/acme/parts/" ); ok( $cookie =~ /Rocket_Launcher_0001/ ); ok( $cookie !~ /Riding_Rocket_0023/ ); ##; #----------------------------------------------------------------------- # Test rejection of Set-Cookie2 responses based on domain, path or port $c = HTTP::CookieJar::LWP->new; # XXX RFC 6265 says strip leading dots and embedded dots in prefix are OK ### illegal domain (no embedded dots) ##$cookie = interact($c, "http://www.acme.com", 'foo=bar; domain=.com'); ##is(count_cookies($c), 0); # legal domain $cookie = interact( $c, "http://www.acme.com", 'foo=bar; domain=acme.com' ); is( count_cookies($c), 1 ); # illegal domain (host prefix "www.a" contains a dot) $cookie = interact( $c, "http://www.a.acme.com", 'foo=bar; domain=acme.com' ); is( count_cookies($c), 1 ); # legal domain $cookie = interact( $c, "http://www.a.acme.com", 'foo=bar; domain=.a.acme.com' ); is( count_cookies($c), 2 ); # can't use a IP-address as domain $cookie = interact( $c, "http://125.125.125.125", 'foo=bar; domain=125.125.125' ); is( count_cookies($c), 2 ); # XXX RFC 6265 doesn't prohibit this; path matching happens on cookie header generation ### illegal path (must be prefix of request path) ##$cookie = interact($c, "http://www.sol.no", 'foo=bar; domain=.sol.no; path=/foo'); ##is(count_cookies($c), 2); # legal path $cookie = interact( $c, "http://www.sol.no/foo/bar", 'foo=bar; domain=.sol.no; path=/foo' ); is( count_cookies($c), 3 ); # XXX ports not part of RFC 6265 standard ### illegal port (request-port not in list) ##$cookie = interact($c, "http://www.sol.no", 'foo=bar; domain=.sol.no; port=90,100'); ##is(count_cookies($c), 3); # legal port $cookie = interact( $c, "http://www.sol.no", 'foo=bar; domain=.sol.no; port=90,100, 80,8080; max-age=100; Comment = "Just kidding! (\"|\\\\) "' ); is( count_cookies($c), 4 ); # port attribute without any value (current port) $cookie = interact( $c, "http://www.sol.no", 'foo9=bar; domain=.sol.no; port; max-age=100;' ); is( count_cookies($c), 5 ) or diag explain $c; # encoded path $cookie = interact( $c, "http://www.sol.no/foo/", 'foo8=bar; path=/%66oo' ); is( count_cookies($c), 6 ); # XXX not doing save/load ##my $file = "lwp-cookies-$$.txt"; ##$c->save($file); ##$old = $c->as_string; ##undef($c); ##$c = HTTP::CookieJar::LWP->new; ##$c->load($file); ##unlink($file) || warn "Can't unlink $file: $!"; ## ##is($old, $c->as_string); ## ##undef($c); # # Try some URL encodings of the PATHs # $c = HTTP::CookieJar::LWP->new; interact( $c, "http://www.acme.com/foo%2f%25/%40%40%0Anew%E5/%E5", 'foo = bar' ); ##; $cookie = interact( $c, "http://www.acme.com/foo%2f%25/@@%0anewå/æøå", "bar=baz; path=/foo/" ); ok( $cookie =~ /foo=bar/ ); $cookie = interact( $c, "http://www.acme.com/foo/%25/@@%0anewå/æøå" ); ok($cookie); undef($c); # ### Try to use the Netscape cookie file format for saving ### ##$file = "cookies-$$.txt"; ##$c = HTTP::CookieJar::LWP->new(file => $file); ##interact($c, "http://www.acme.com/", "foo1=bar; max-age=100"); ##interact($c, "http://www.acme.com/", "foo2=bar; port=\"80\"; max-age=100; Discard; Version=1"); ##interact($c, "http://www.acme.com/", "foo3=bar; secure; Version=1"); ##$c->save; ##undef($c); ## ##$c = HTTP::CookieJar::LWP->new(file => $file); ##is(count_cookies($c), 1); # 2 of them discarded on save ## ##ok($c->as_string =~ /foo1=bar/); ##undef($c); ##unlink($file); # # Some additional Netscape cookies test # $c = HTTP::CookieJar::LWP->new; $req = HTTP::Request->new( POST => "http://foo.bar.acme.com/foo" ); # Netscape allows a host part that contains dots $res = HTTP::Response->new( 200, "OK" ); $res->header( set_cookie => 'Customer=WILE_E_COYOTE; domain=.acme.com' ); $res->request($req); $c->extract_cookies($res); # and that the domain is the same as the host without adding a leading # dot to the domain. Should not quote even if strange chars are used # in the cookie value. $res = HTTP::Response->new( 200, "OK" ); $res->header( set_cookie => 'PART_NUMBER=3,4; domain=foo.bar.acme.com' ); $res->request($req); $c->extract_cookies($res); ##; require URI; $req = HTTP::Request->new( POST => URI->new("http://foo.bar.acme.com/foo") ); $c->add_cookie_header($req); #; ok( $req->header("Cookie") =~ /PART_NUMBER=3,4/ ); ok( $req->header("Cookie") =~ /Customer=WILE_E_COYOTE/ ); # XXX the .local mechanism is not in RFC 6265 # Test handling of local intranet hostnames without a dot ##$c->clear; ##print "---\n"; ## ##interact($c, "http://example/", "foo1=bar; PORT; Discard;"); ##$cookie=interact($c, "http://example/", 'foo2=bar; domain=".local"'); ##like($cookie, qr/foo1=bar/); ## ##$cookie=interact($c, "http://example/", 'foo3=bar'); ##$cookie=interact($c, "http://example/"); ##like($cookie, qr/foo2=bar/); ##is(count_cookies($c), 3); # Test for empty path # Broken web-server ORION/1.3.38 returns to the client response like # # Set-Cookie: JSESSIONID=ABCDERANDOM123; Path= # # e.g. with Path set to nothing. # In this case routine extract_cookies() must set cookie to / (root) $c = HTTP::CookieJar::LWP->new; # clear it $req = HTTP::Request->new( GET => "http://www.ants.com/" ); $res = HTTP::Response->new( 200, "OK" ); $res->request($req); $res->header( "Set-Cookie" => "JSESSIONID=ABCDERANDOM123; Path=" ); $c->extract_cookies($res); $req = HTTP::Request->new( GET => "http://www.ants.com/" ); $c->add_cookie_header($req); is( $req->header("Cookie"), "JSESSIONID=ABCDERANDOM123" ); # missing path in the request URI $req = HTTP::Request->new( GET => URI->new("http://www.ants.com:8080") ); $c->add_cookie_header($req); is( $req->header("Cookie"), "JSESSIONID=ABCDERANDOM123" ); # XXX we don't support Cookie2 ### test mixing of Set-Cookie and Set-Cookie2 headers. ### Example from http://www.trip.com/trs/trip/flighttracker/flight_tracker_home.xsl ### which gives up these headers: ### ### HTTP/1.1 200 OK ### Connection: close ### Date: Fri, 20 Jul 2001 19:54:58 GMT ### Server: Apache/1.3.19 (Unix) ApacheJServ/1.1.2 ### Content-Type: text/html ### Content-Type: text/html; charset=iso-8859-1 ### Link: ; rel="stylesheet"; type="text/css" ### Servlet-Engine: Tomcat Web Server/3.2.1 (JSP 1.1; Servlet 2.2; Java 1.3.0; SunOS 5.8 sparc; java.vendor=Sun Microsystems Inc.) ### Set-Cookie: trip.appServer=1111-0000-x-024;Domain=.trip.com;Path=/ ### Set-Cookie: JSESSIONID=fkumjm7nt1.JS24;Path=/trs ### Set-Cookie2: JSESSIONID=fkumjm7nt1.JS24;Version=1;Discard;Path="/trs" ### Title: TRIP.com Travel - FlightTRACKER ### X-Meta-Description: Trip.com privacy policy ### X-Meta-Keywords: privacy policy ## ##$req = HTTP::Request->new('GET', 'http://www.trip.com/trs/trip/flighttracker/flight_tracker_home.xsl'); ##$res = HTTP::Response->new(200, "OK"); ##$res->request($req); ##$res->push_header("Set-Cookie" => qq(trip.appServer=1111-0000-x-024;Domain=.trip.com;Path=/)); ##$res->push_header("Set-Cookie" => qq(JSESSIONID=fkumjm7nt1.JS24;Path=/trs)); ##$res->push_header("Set-Cookie2" => qq(JSESSIONID=fkumjm7nt1.JS24;Version=1;Discard;Path="/trs")); ###; ## ##$c = HTTP::CookieJar::LWP->new; # clear it ##$c->extract_cookies($res); ##; ##is($c->as_string, <<'EOT'); ##Set-Cookie3: trip.appServer=1111-0000-x-024; path="/"; domain=.trip.com; path_spec; discard; version=0 ##Set-Cookie3: JSESSIONID=fkumjm7nt1.JS24; path="/trs"; domain=www.trip.com; path_spec; discard; version=1 ##EOT # XXX not implemented yet -- xdg, 2013-02-11 ###------------------------------------------------------------------- ### Test if temporary cookies are deleted properly with ### $jar->clear_temporary_cookies() ## ##$req = HTTP::Request->new('GET', 'http://www.perlmeister.com/scripts'); ##$res = HTTP::Response->new(200, "OK"); ##$res->request($req); ## # Set session/perm cookies and mark their values as "session" vs. "perm" ## # to recognize them later ##$res->push_header("Set-Cookie" => qq(s1=session;Path=/scripts)); ##$res->push_header("Set-Cookie" => qq(p1=perm; Domain=.perlmeister.com;Path=/;expires=Fri, 02-Feb-$year_plus_one 23:24:20 GMT)); ##$res->push_header("Set-Cookie" => qq(p2=perm;Path=/;expires=Fri, 02-Feb-$year_plus_one 23:24:20 GMT)); ##$res->push_header("Set-Cookie" => qq(s2=session;Path=/scripts;Domain=.perlmeister.com)); ##$res->push_header("Set-Cookie2" => qq(s3=session;Version=1;Discard;Path="/")); ## ##$c = HTTP::CookieJar::LWP->new; # clear jar ##$c->extract_cookies($res); ### How many session/permanent cookies do we have? ##my %counter = ("session_after" => 0); ##$c->scan( sub { $counter{"${_[2]}_before"}++ } ); ##$c->clear_temporary_cookies(); ### How many now? ##$c->scan( sub { $counter{"${_[2]}_after"}++ } ); ##is($counter{"perm_after"}, $counter{"perm_before"}); # a permanent cookie got lost accidently ##is($counter{"session_after"}, 0); # a session cookie hasn't been cleared ##is($counter{"session_before"}, 3); # we didn't have session cookies in the first place ###; # Test handling of 'secure ' attribute for classic cookies $c = HTTP::CookieJar::LWP->new; $req = HTTP::Request->new( GET => "https://1.1.1.1/" ); $req->header( "Host", "www.acme.com:80" ); $res = HTTP::Response->new( 200, "OK" ); $res->request($req); $res->header( "Set-Cookie" => "CUSTOMER=WILE_E_COYOTE ; secure ; path=/" ); #; $c->extract_cookies($res); $req = HTTP::Request->new( GET => "http://www.acme.com/" ); $c->add_cookie_header($req); ok( !$req->header("Cookie") ); $req->uri->scheme("https"); $c->add_cookie_header($req); is( $req->header("Cookie"), "CUSTOMER=WILE_E_COYOTE" ); $req = HTTP::Request->new( GET => "ftp://ftp.activestate.com/" ); $c->add_cookie_header($req); ok( !$req->header("Cookie") ); $req = HTTP::Request->new( GET => "file:/etc/motd" ); $c->add_cookie_header($req); ok( !$req->header("Cookie") ); $req = HTTP::Request->new( GET => "mailto:gisle\@aas.no" ); $c->add_cookie_header($req); ok( !$req->header("Cookie") ); # Test cookie called 'expires' $c = HTTP::CookieJar::LWP->new; $cookie = interact( $c, "http://example.com/", 'Expires=10101' ); $cookie = interact( $c, "http://example.com/" ); is( $cookie, 'Expires=10101' ) or diag explain $c; # Test empty cookie header [RT#29401] $c = HTTP::CookieJar::LWP->new; $cookie = interact( $c, "http://example.com/", "CUSTOMER=WILE_E_COYOTE; path=/;", "" ); is( count_cookies($c), 1, "empty cookie not set" ); # Test empty cookie part [RT#38480] $c = HTTP::CookieJar::LWP->new; $cookie = interact( $c, "http://example.com/", "CUSTOMER=WILE_E_COYOTE;;path=/;" ); $cookie = interact( $c, "http://example.com/" ); like( $cookie, qr/CUSTOMER=WILE_E_COYOTE/, "empty attribute ignored" ); # Test Set-Cookie with version set $c = HTTP::CookieJar::LWP->new; $cookie = interact( $c, "http://example.com/", "foo=\"bar\";version=1" ); $cookie = interact( $c, "http://example.com/" ); is( $cookie, "foo=\"bar\"", "version ignored" ); # Test cookies that expire far into the future [RT#50147] ( or past ? ) # if we can't do far future, use 2037 my $future = eval { timegm( 1, 2, 3, 4, 5, 2039 ) } ? 2211 : 2037; $c = HTTP::CookieJar::LWP->new; interact( $c, "http://example.com/foo", "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL; expires=Mon, 03-Oct-$future 15:18:10 GMT; path=/; domain=.example.com", "expired1=1; expires=Mon, 03-Oct-2001 15:18:10 GMT; path=/; domain=.example.com", "expired2=1; expires=Fri Jan 1 00:00:00 GMT 1970; path=/; domain=.example.com", "expired3=1; expires=Fri Jan 1 00:00:01 GMT 1970; path=/; domain=.example.com", "expired4=1; expires=Thu Dec 31 23:59:59 GMT 1969; path=/; domain=.example.com", "expired5=1; expires=Fri Feb 2 00:00:00 GMT 1950; path=/; domain=.example.com", ); $cookie = interact( $c, "http://example.com/foo" ); is( $cookie, "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL", "far future and past" ) or diag explain $c; # Test merging of cookies $c = HTTP::CookieJar::LWP->new; interact( $c, "http://example.com/foo/bar", "foo=1" ); interact( $c, "http://example.com/foo", "foo=2; path=/" ); $cookie = interact( $c, "http://example.com/foo/bar" ); is( $cookie, "foo=1; foo=2", "merging cookies" ); #------------------------------------------------------------------- sub interact { my $c = shift; my $url = shift; my $req = HTTP::Request->new( POST => $url ); $c->add_cookie_header($req); my $cookie = $req->header("Cookie"); my $res = HTTP::Response->new( 200, "OK" ); $res->request($req); for (@_) { $res->push_header( "Set-Cookie" => $_ ) } $c->extract_cookies($res); return $cookie; } sub count_cookies { my $c = shift; return scalar $c->_all_cookies; } done_testing; # # This file is part of HTTP-CookieJar # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # HTTP-CookieJar-0.012/t/publicsuffix.t000644 000766 000024 00000006036 14062342657 017543 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::Deep '!blessed'; use Test::Requires 'Mozilla::PublicSuffix'; use HTTP::CookieJar; my @cases = ( { label => "host is public suffix", request => "http://com.au/", cookies => ["SID=31d4d96e407aad42; Domain=com.au"], store => { 'com.au' => { '/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "com.au", hostonly => 1, path => "/", } } }, }, }, { label => "host is suffix of public suffix", request => "http://au/", cookies => ["SID=31d4d96e407aad42; Domain=au"], store => { 'au' => { '/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "au", hostonly => 1, path => "/", } } }, }, }, { label => "host is unrecognized single level", request => "http://localhost/", cookies => ["SID=31d4d96e407aad42; Domain=localhost"], store => { 'localhost' => { '/' => { SID => { name => "SID", value => "31d4d96e407aad42", creation_time => ignore(), last_access_time => ignore(), domain => "localhost", hostonly => 1, path => "/", } } }, }, }, { label => "cookie is public suffix", request => "http://example.com.au/", cookies => ["SID=31d4d96e407aad42; Domain=com.au"], store => {}, }, { label => "cookie is suffix of public suffix", request => "http://example.com.au/", cookies => ["SID=31d4d96e407aad42; Domain=au"], store => {}, }, ); for my $c (@cases) { my $jar = HTTP::CookieJar->new; for my $cookie ( @{ $c->{cookies} } ) { $jar->add( $c->{request}, $cookie ); } cmp_deeply $jar->{store}, $c->{store}, $c->{label} or diag explain $jar->{store}; } done_testing; # # This file is part of HTTP-CookieJar # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # HTTP-CookieJar-0.012/t/lib/MockTime.pm000644 000766 000024 00000000473 14062342657 017466 0ustar00davidstaff000000 000000 use strict; use warnings; package MockTime; my ( $_original_time, $_offset ); sub time () { return $_original_time + $_offset; } sub offset { my ( $class, $offset ) = @_; $_offset = $offset; } BEGIN { ( $_original_time, $_offset ) = ( CORE::time(), 0 ); *CORE::GLOBAL::time = \&time; } 1;