Subject: | HTTP::Cookies not add ".domain" cookies to "domain" requests |
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.
Subject: | cookies.t.patch |
diff --git a/t/base/cookies.t b/t/base/cookies.t
index db1af86..71b6f68 100644
--- a/t/base/cookies.t
+++ b/t/base/cookies.t
@@ -1,7 +1,7 @@
#!perl -w
use Test;
-plan tests => 62;
+plan tests => 68;
use HTTP::Cookies;
use HTTP::Request;
@@ -644,6 +644,32 @@ $c->add_cookie_header($req);
#print $req->as_string;
ok($req->header("Cookie"), "foo=\"bar\"");
+# Test Set-Cookie for ".domain" and add_cookie_header for "domain"
+$req = HTTP::Request->new('GET', 'http://pass.moikrug.ru/');
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+$res->push_header("Set-Cookie" => qq(domain=1; path=/; domain=moikrug.ru));
+$res->push_header("Set-Cookie" => qq(dotdomain=1; path=/; domain=.moikrug.ru));
+$res->push_header("Set-Cookie" => qq(subdomain=1; path=/; domain=pass.moikrug.ru));
+$c = HTTP::Cookies->new; # clear jar
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new('GET', 'http://moikrug.ru/');
+$req->header("Host", "moikrug.ru");
+$c->add_cookie_header($req);
+$h = $req->header("Cookie") || '';
+ok($h =~ /domain=1/);
+ok($h =~ /dotdomain=1/);
+ok($h !~ /subdomain=1/);
+
+$req = HTTP::Request->new('GET', 'http://pass.moikrug.ru/');
+$req->header("Host", "pass.moikrug.ru");
+$c->add_cookie_header($req);
+$h = $req->header("Cookie");
+ok($h =~ /domain=1/);
+ok($h =~ /dotdomain=1/);
+ok($h =~ /subdomain=1/);
+
#-------------------------------------------------------------------
sub interact