Re: Accomodating Netscape-style cookies?
Gisle Aas (gisle@aas.no)
23 Mar 1998 10:38:33 +0100
I am not sure that all cases you described is covered by what I have
by now. If you have more outstanding compatibility issues I would be
nice to get a patch to the test suite as well.
These are the HTTP::Cookes modifications I now have done to my
sources:
Index: lib/HTTP/Cookies.pm
===================================================================
RCS file: /home/cvs/aas/perl/mods/libwww-perl/lib/HTTP/Cookies.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -u -r1.3 -r1.4
--- Cookies.pm 1997/09/20 12:17:03 1.3
+++ Cookies.pm 1998/03/23 09:24:29 1.4
@@ -9,7 +9,7 @@
use LWP::Debug ();
use vars qw($VERSION);
-$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
=head1 NAME
@@ -31,7 +31,7 @@
<URL:http://www.netscape.com/newsref/std/cookie_spec.html> and
<URL:http://www.cookiecentral.com/>. This module also implements the
new style cookies as described in I<draft-ietf-http-state-man-mec-03.txt>.
-The two variants of cookies can coexist happily.
+The two variants of cookies is supposed to be able to coexist happily.
Instances of the class I<HTTP::Cookies> are able to store a collection
of Set-Cookie2: and Set-Cookie:-headers and is able to use this
@@ -162,7 +162,7 @@
}
# do we need to quote the value
- if ($val =~ /\W/) {
+ if ($val =~ /\W/ && $version) {
$val =~ s/([\\\"])/\\$1/g;
$val = qq("$val");
}
@@ -281,7 +281,7 @@
# Check domain
my $domain = delete $hash{domain};
- if (defined $domain) {
+ if (defined($domain) && $domain ne $req_host) {
unless ($domain =~ /\./) {
LWP::Debug::debug("Domain $domain contains no dot");
next SET_COOKIE;
@@ -297,7 +297,7 @@
next SET_COOKIE;
}
my $hostpre = substr($req_host, 0, length($req_host) - $len);
- if ($hostpre =~ /\./) {
+ if ($hostpre =~ /\./ && !$netscape_cookies) {
LWP::Debug::debug("Host prefix contain a dot: $hostpre => $domain");
next SET_COOKIE;
}
Index: t/base/cookies.t
===================================================================
RCS file: /home/cvs/aas/perl/mods/libwww-perl/t/base/cookies.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -u -r1.2 -r1.3
--- cookies.t 1997/09/20 11:35:06 1.2
+++ cookies.t 1998/03/23 09:22:40 1.3
@@ -1,4 +1,4 @@
-print "1..28\n";
+print "1..29\n";
#use LWP::Debug '+';
@@ -434,6 +434,37 @@
print "ok 28\n";
undef($c);
unlink($file);
+
+
+#
+# Some additional Netscape cookies test
+#
+$c = HTTP::Cookies->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);
+
+print $c->as_string;
+
+$req = HTTP::Request->new(POST => "http://foo.bar.acme.com/foo");
+$c->add_cookie_header($req);
+#print $req->as_string;
+print "not " unless $req->header("Cookie") =~ /PART_NUMBER=3,4/ &&
+ $req->header("Cookie") =~ /Customer=WILE_E_COYOTE/;
+print "ok 29\n";
+
#-------------------------------------------------------------------