fixed RFC 6265 compliance bug in Mojo::UserAgent::CookieJar

mojolicious · Sep 9, 2013 · 8e18958 · 8e18958
1 parent 3588dd3
commit 8e18958
Show file tree

Hide file tree

Showing 4 changed files with 18 additions and 5 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,7 @@
 
 4.35  2013-09-09
+  - Added origin attribute to Mojo::Cookie::Response.
+  - Fixed RFC 6265 compliance bug in Mojo::UserAgent::CookieJar.
 
 4.34  2013-09-08
   - Fixed portability bug in SO_REUSEPORT tests.

diff --git a/lib/Mojo/Cookie/Response.pm b/lib/Mojo/Cookie/Response.pm
@@ -4,7 +4,7 @@ use Mojo::Base 'Mojo::Cookie';
 use Mojo::Date;
 use Mojo::Util qw(quote split_header);
 
-has [qw(domain httponly max_age path secure)];
+has [qw(domain httponly max_age origin path secure)];
 
 sub expires {
   my $self = shift;
@@ -130,6 +130,13 @@ cookie.
 
 Max age for cookie.
 
+=head2 origin
+
+  my $origin = $cookie->origin;
+  $cookie    = $cookie->origin('mojolicio.us');
+
+Origin of the cookie.
+
 =head2 path
 
   my $path = $cookie->path;

diff --git a/lib/Mojo/UserAgent/CookieJar.pm b/lib/Mojo/UserAgent/CookieJar.pm
@@ -19,7 +19,7 @@ sub add {
     next if length($cookie->value // '') > $size;
 
     # Replace cookie
-    my $domain = $cookie->domain;
+    my $domain = lc($cookie->domain // $cookie->origin);
     $domain =~ s/^\.//;
     my $path = $cookie->path;
     my $name = $cookie->name;
@@ -44,11 +44,10 @@ sub extract {
 
     # Validate domain
     my $host = $url->ihost;
-    my $domain = lc($cookie->domain // $host);
+    my $domain = lc($cookie->domain // $cookie->origin($host)->origin);
     $domain =~ s/^\.//;
     next
       if $host ne $domain && ($host !~ /\Q.$domain\E$/ || $host =~ /\.\d+$/);
-    $cookie->domain($domain);
 
     # Validate path
     my $path = $cookie->path // $url->path->to_dir->to_abs_string;
@@ -61,7 +60,7 @@ sub extract {
 sub find {
   my ($self, $url) = @_;
 
-  return unless my $domain = $url->ihost;
+  return unless my $domain = my $host = $url->ihost;
   my $path = $url->path->to_abs_string;
   my @found;
   while ($domain =~ /[^.]+\.[^.]+|localhost$/) {
@@ -70,6 +69,7 @@ sub find {
     # Grab cookies
     my $new = $self->{jar}{$domain} = [];
     for my $cookie (@$old) {
+      if (my $origin = $cookie->origin) { next unless $host eq $origin }
 
       # Check if cookie has expired
       my $expires = $cookie->expires;

diff --git a/t/mojo/cookiejar.t b/t/mojo/cookiejar.t
@@ -313,6 +313,10 @@ $jar->inject($tx);
 is $tx->req->cookie('foo')->name,  'foo',     'right name';
 is $tx->req->cookie('foo')->value, 'without', 'right value';
 $tx = Mojo::Transaction::HTTP->new;
+$tx->req->url->parse('http://www.mojolicio.us/perldoc');
+$jar->inject($tx);
+is $tx->req->cookie('foo'), undef, 'no cookie';
+$tx = Mojo::Transaction::HTTP->new;
 $tx->req->url->parse('http://mojolicio.us/whatever');
 $jar->inject($tx);
 is $tx->req->cookie('foo'), undef, 'no cookie';