HTTP::Cookies don't add ".domain" cookies to "domain" requests [rt.cpan.org #49898]

[oalders]

Migrated from rt.cpan.org#49898 (status was 'open')

Requestors:

• HSW@cpan.org

Attachments:

• cookies.t.patch

From hsw@cpan.org on 2009-09-22 05:18:09:

Cookie:
Set-Cookie: dotdomain=1; path=/; domain=.moikrug.ru

not passed to request:
GET http://moikrug.ru/

Additional tests for t/base/cookies.t included.

From dma_k@mail.ru on 2010-08-08 20:23:44:

I confirm the problem. RFC 2965 does not have concrete example of
matching "domain.com" against ".domain.com".

The current workaround is to specify "host" header separately:

my $ua = LWP::UserAgent->new();
my $cookie = HTTP::Cookies->new(
    file => '/tmp/cookies.txt',
    autosave => 1
);
my $r = HTTP::Request::Common::GET('http://host.com', host =>
'www.host.com');
$ua->prepare_request($r);
$cookie->add_cookie_header($r);
print Data::Dumper->Dump([\$r], ["r"]);

Sergey, if you have a patch for Cookies.pm, you are welcome to attach it.

From ether@cpan.org on 2017-01-25 21:39:08:

migrated queues: libwww-perl -> HTTP-Cookies

[jackdeguest]

Simple solution to this problem is simply to add the following line in the sub add_cookie_header right after the line:
$domain = "$domain.local" unless $domain =~ /./;
you add:
$domain = ".$domain" unless( $domain =~ /^./ );
and problem solved.

[grr]

Any chance this 16 year-old bug can be finally fixed? I just spent an hour tracing through LWP and HTTP::Cookies to track this down since it's not even documented as a caveat. My normal browser has 273 / 508 cookie domains with leading dots, so it's not like this is an uncommon case.

[jackdeguest]

Any chance this 16 year-old bug can be finally fixed? I just spent an hour tracing through LWP and HTTP::Cookies to track this down since it's not even documented as a caveat. My normal browser has 273 / 508 cookie domains with leading dots, so it's not like this is an uncommon case.

You can always use the module Cookie::Jar which is a drop-in replacement 😉

[grr]

Any chance this 16 year-old bug can be finally fixed? I just spent an hour tracing through LWP and HTTP::Cookies to track this down since it's not even documented as a caveat. My normal browser has 273 / 508 cookie domains with leading dots, so it's not like this is an uncommon case.

You can always use the module Cookie::Jar which is a drop-in replacement 😉

I need 5.10 support and your module states it requires 5.16, but looking through the large dependencies, it requires at least 5.28.

[oalders]

Any chance this 16 year-old bug can be finally fixed?

We are extremely low on humans to do this. If someone can provide a fix with appropriate tests we can get it merged.

[oalders]

Barring that you could look at keeping your cookies in https://metacpan.org/pod/HTTP::CookieJar

[grr]

Barring that you could look at keeping your cookies in https://metacpan.org/pod/HTTP::CookieJar

One of the main reasons users prefer HTTP::Cookies over HTTP::CookieJar is the subclasses that load cookies from the various desktop browsers. The latter has no equivalent nor is there an adapter module like HTTP::CookieJar::LWP that goes the other way (::Cookies -> ::CookieJar).

[oalders]

Makes sense. I'm happy to merge PRs. 😄

[grr]

hope a patch will suffice:

diff --git a/lib/HTTP/Cookies.pm b/lib/HTTP/Cookies.pm
index cc51e10..7237aea 100644
--- a/lib/HTTP/Cookies.pm
+++ b/lib/HTTP/Cookies.pm
@@ -42,7 +42,11 @@ sub add_cookie_header
    }

    my $domain = _host($request, $url);
-    $domain = "$domain.local" unless $domain =~ /\./;
+    # The request hostname can have a trailing, but not leading, dot.
+    if ((index $domain, '.', 1) == -1) {
+        $domain = ".$domain.local";
+    }
+    else { $domain = ".$domain" }
    my $secure_request = ($scheme eq "https");
    my $req_path = _url_path($url);
    my $req_port = $url->port;
@@ -52,6 +56,7 @@ sub add_cookie_header
    my @cval;    # cookie values for the "Cookie" header
    my $set_ver;
    my $netscape_only = 0; # An exact domain match applies to any cookie
+    my $domain_part;

    while ($domain =~ /\./) {
        # Checking $domain for cookies"
@@ -148,7 +153,7 @@ sub add_cookie_header
        # .c.net	Any cookie

        if ($domain =~ s/^\.+//) {
-	    $netscape_only = 1;
+	    $netscape_only = 1 if $domain_part++;
        }
        else {
            $domain =~ s/[^.]*//;
diff --git a/t/issue29.t b/t/issue29.t
new file mode 100644
index 0000000..1251b5f
--- /dev/null
+++ b/t/issue29.t
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+use Test::More;
+
+use HTTP::Cookies ();
+use HTTP::Request ();
+
+my $c = HTTP::Cookies->new;
+$c->set_cookie(0, qw(key val / .example.com));
+like $c->as_string, qr/domain=\.example\.com/;
+
+my $req = HTTP::Request->new(GET => "http://example.com");
+$c->add_cookie_header($req);
+is $req->header("Cookie"), 'key=val', 'root domain';
+
+$req = HTTP::Request->new(GET => "http://www.example.com");
+$c->add_cookie_header($req);
+is $req->header("Cookie"), 'key=val', 'subdomain';
+
+done_testing;

[oalders]

Thanks! I'm guessing we will look at this at the Perl Toolchain Summit in a few weeks.

[simbabque]

Thank you for the patch @grr. I've applied it by hand because I couldn't get it to work with git apply. I cannot work out what it was based against.

When I'm running your tests after making these changes to the current master, there are several test failures. Please could you tell me what version you were basing this on? Thanks.

t/00-report-prereqs.t .. # 
# Versions for all modules listed in MYMETA.json (including optional ones):
# 
# === Configure Requires ===
# 
#     Module              Want Have
#     ------------------- ---- ----
#     ExtUtils::MakeMaker  any 7.74
# 
# === Build Requires ===
# 
#     Module              Want Have
#     ------------------- ---- ----
#     ExtUtils::MakeMaker  any 7.74
# 
# === Test Requires ===
# 
#     Module              Want     Have
#     ------------------- ---- --------
#     ExtUtils::MakeMaker  any     7.74
#     File::Spec           any     3.78
#     HTTP::Response       any     7.00
#     Test::More           any 1.302211
#     URI                  any     5.31
#     warnings             any     1.47
# 
# === Test Recommends ===
# 
#     Module         Want     Have
#     ---------- -------- --------
#     CPAN::Meta 2.120900 2.150010
# 
# === Runtime Requires ===
# 
#     Module                  Want     Have
#     ------------------- -------- --------
#     Carp                     any     1.50
#     HTTP::Date                 6     6.06
#     HTTP::Headers::Util        6     7.00
#     HTTP::Request            any     7.00
#     locale                   any     1.09
#     perl                5.008001 5.032001
#     strict                   any     1.11
# 
# === Develop Requires ===
# 
#     Module                   Want     Have
#     ------------------------ ---- --------
#     Pod::Coverage::TrustPod   any 0.100006
#     Test::CPAN::Changes      0.19 0.500005
#     Test::EOL                 any     2.02
#     Test::Mojibake            any      1.3
#     Test::More               0.96 1.302211
#     Test::Pod                1.41     1.52
#     Test::Pod::Coverage      1.08     1.10
#     Test::Portability::Files  any     0.10
#     Test::Version               1     2.09
#     warnings                  any     1.47
# 
t/00-report-prereqs.t .. ok   
t/10-original_spec.t ... ok     
t/11-rfc_2965.t ........ 1/13 
#   Failed test '1.3-4: req: contains header'
#   at t/11-rfc_2965.t line 54.
#                   undef
#     doesn't match '(?^:Customer="?WILE_E_COYOTE"?)'

#   Failed test '1.5-6: req: contains cust'
#   at t/11-rfc_2965.t line 75.
#                   undef
#     doesn't match '(?^:Customer="?WILE_E_COYOTE"?)'

#   Failed test '1.5-6: req: contains part'
#   at t/11-rfc_2965.t line 76.
#                   undef
#     doesn't match '(?^:Part_Number="?Rocket_Launcher_0001"?)'

#   Failed test '1.7-8: req: contains cust'
#   at t/11-rfc_2965.t line 97.
#                   undef
#     doesn't match '(?^:Customer="?WILE_E_COYOTE"?)'

#   Failed test '1.7-8: req: contains part'
#   at t/11-rfc_2965.t line 98.
#                   undef
#     doesn't match '(?^:Part_Number="?Rocket_Launcher_0001"?)'

#   Failed test '1.7-8: req: contains shipping'
#   at t/11-rfc_2965.t line 99.
#                   undef
#     doesn't match '(?^:Shipping="?FedEx"?)'
# Looks like you failed 6 tests of 13.
t/11-rfc_2965.t ........ Dubious, test returned 6 (wstat 1536, 0x600)
Failed 6/13 subtests 
t/cookies.t ............ 1/79 
#   Failed test at t/cookies.t line 210.
#                   undef
#     doesn't match '(?^:^\$Version="?1"?; Customer="?WILE_E_COYOTE"?; \$Path="/acme"$)'

#   Failed test at t/cookies.t line 233.
#                   undef
#     doesn't match '(?^:^\$Version="?1"?;)'

#   Failed test at t/cookies.t line 234.
#                   undef
#     doesn't match '(?^:Part_Number="?Rocket_Launcher_0001"?;\s*\$Path="/acme")'

#   Failed test at t/cookies.t line 235.
#                   undef
#     doesn't match '(?^:Customer="?WILE_E_COYOTE"?;\s*\$Path="/acme")'
Use of uninitialized value $cookie in concatenation (.) or string at t/cookies.t line 256.

#   Failed test at t/cookies.t line 257.
#                   undef
#     doesn't match '(?^:Shipping="?FedEx"?;\s*\$Path="/acme")'

#   Failed test at t/cookies.t line 258.
#                   undef
#     doesn't match '(?^:WILE_E_COYOTE)'

#   Failed test at t/cookies.t line 306.
#                   undef
#     doesn't match '(?^:Riding_Rocket_0023.*Rocket_Launcher_0001)'

#   Failed test at t/cookies.t line 318.
#                   undef
#     doesn't match '(?^:Rocket_Launcher_0001)'

#   Failed test at t/cookies.t line 394.
#                   undef
#     doesn't match '(?^:foo=bar)'

#   Failed test at t/cookies.t line 395.
#                   undef
#     doesn't match '(?^i:^\$version=\"?1\"?)'

#   Failed test at t/cookies.t line 460.
#                   undef
#     doesn't match '(?^:foo1=bar)'
# Looks like you failed 11 tests of 79.
t/cookies.t ............ Dubious, test returned 11 (wstat 2816, 0xb00)
Failed 11/79 subtests 
t/issue26.t ............ ok   
t/issue32.t ............ ok   
t/publicsuffix.t ....... ok   

[grr]

I just did a git clone and got the master branch. Given that your output starts with t/00-report-prereqs.t, which isn't in the repo, might this be a Dist::Zilla issue? I also did cpanm --with-develop --installdeps . to pull in the develop phase dependencies, but all tests still pass for me.

[simbabque]

That's odd. I have a fresh master as well, and have everything installed. Yes, the output above was from dzil test, but if I run the tests directly with prove -lv t I get the same failures. It's possible I did your patch wrong. If you have the changes and a git checkout, could you send a PR please? Maybe something went wrong when I applied your patch. Thank you.

[haarg]

I've pushed the patch to a branch (https://github.com/libwww-perl/HTTP-Cookies/tree/haarg/issue-29) and it appears to be passing the tests fine.